--- a/Smalltalk.st Tue May 08 11:09:26 2018 +0200
+++ b/Smalltalk.st Tue May 08 11:10:11 2018 +0200
@@ -236,19 +236,19 @@
right after startup, usually immediately followed by Smalltalk>>start.
Notice:
- this is NOT called when an image is restarted; in this
- case the show starts in Smalltalk>>restart."
+ this is NOT called when an image is restarted; in this
+ case the show starts in Smalltalk>>restart."
OrderedCollection initialize.
-
+
Smalltalk at:#Compiler put: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.
- "
- Smalltalk at:#Compiler put: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.
+ "
+ Smalltalk at:#Compiler put:Parser
].
"/
@@ -287,7 +287,7 @@
"/ in case, someone needs the objectFileLoader early
"/
ObjectFileLoader notNil ifTrue:[
- ObjectFileLoader initialize.
+ ObjectFileLoader initialize.
].
"/
@@ -304,7 +304,7 @@
"/ flush them here, so they are reread in any case.
"/ required for some apps, for example to show the menu correctly (see launcher's help menu)
ApplicationModel notNil ifTrue:[
- ApplicationModel flushAllClassResources.
+ ApplicationModel flushAllClassResources.
].
"/
@@ -325,20 +325,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.
@@ -346,41 +346,41 @@
"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 notEmptyOrNil ifTrue:[
- i := envString indexOf:$@.
- (i ~~ 0) ifTrue:[
- LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- envString := envString copyTo:(i - 1).
- ] ifFalse:[
- LanguageModifier := nil.
- ].
- i := envString indexOf:$..
- (i ~~ 0) ifTrue:[
- LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol.
- envString := envString copyTo:(i - 1).
- ] 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)
- ].
- langString := langString asLowercase.
- terrString := terrString asLowercase.
- (langString = 'c' or:[terrString = 'c']) ifTrue:[
- ('Smalltalk [info]: ignoring wrong LANG setting (',langString,'_',terrString,') - using english') infoPrintCR.
- ] ifFalse:[
- Language := langString asSymbol.
- LanguageTerritory := terrString asSymbol
- ]
+ i := envString indexOf:$@.
+ (i ~~ 0) ifTrue:[
+ LanguageModifier := (envString copyFrom:(i + 1)) asLowercase asSymbol.
+ envString := envString copyTo:(i - 1).
+ ] ifFalse:[
+ LanguageModifier := nil.
+ ].
+ i := envString indexOf:$..
+ (i ~~ 0) ifTrue:[
+ LanguageCodeset := (envString copyFrom:(i + 1)) asLowercase asSymbol.
+ envString := envString copyTo:(i - 1).
+ ] 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)
+ ].
+ langString := langString asLowercase.
+ terrString := terrString asLowercase.
+ (langString = 'c' or:[terrString = 'c']) ifTrue:[
+ ('Smalltalk [info]: ignoring wrong LANG setting (',langString,'_',terrString,') - using english') infoPrintCR.
+ ] ifFalse:[
+ Language := langString asSymbol.
+ LanguageTerritory := terrString asSymbol
+ ]
].
"
@@ -463,66 +463,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 isEmptyOrNil ifTrue:[
- SystemPath := OperatingSystem defaultSystemPath.
- self flushPathCaches
+ SystemPath := OperatingSystem defaultSystemPath.
+ self flushPathCaches
].
PackagePath isEmptyOrNil ifTrue:[
- PackagePath := OperatingSystem defaultPackagePath.
+ PackagePath := OperatingSystem defaultPackagePath.
].
self addWorkspaceDirectoryToPackagePath.
self addIdeTopDirectoryToPackagePath.
@@ -554,19 +554,19 @@
"sent from VM via #initializeModules"
Error handle:[:ex |
- ObjectMemory printStackBacktrace.
- ClassesFailedToInitialize isNil ifTrue:[
- ClassesFailedToInitialize := IdentitySet new.
- ].
- ClassesFailedToInitialize add:aClass.
- ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
- ex suspendedContext fullPrintAll.
- '------------------------------------------------' errorPrintCR.
- (Debugging == true) ifTrue:[
- ex reject
- ].
+ ObjectMemory printStackBacktrace.
+ ClassesFailedToInitialize isNil ifTrue:[
+ ClassesFailedToInitialize := IdentitySet new.
+ ].
+ ClassesFailedToInitialize add:aClass.
+ ('Smalltalk [warning]: error during initialize of ' , aClass name,': ', ex description printString) errorPrintCR.
+ ex suspendedContext fullPrintAll.
+ '------------------------------------------------' errorPrintCR.
+ (Debugging == true) ifTrue:[
+ ex reject
+ ].
] do:[
- aClass initialize
+ aClass initialize
].
"Modified: / 11-09-2011 / 17:01:32 / cg"
@@ -618,10 +618,10 @@
Here, a few specific initializations are done, then the actual initialization is
done inside an error handler in basicInitializeSystem.
Notice:
- this is called by the VM's main entry. You will not find senders from Smalltalk.
+ this is called by the VM's main entry. You will not find senders from Smalltalk.
Also Notice:
- this is NOT called when an image is restarted;
- in this case the show starts in Smalltalk>>restart."
+ this is NOT called when an image is restarted;
+ in this case the show starts in Smalltalk>>restart."
|idx shellArgs|
@@ -631,7 +631,7 @@
AbstractOperatingSystem initializeConcreteClass.
CommandLineArguments isEmptyOrNil ifTrue:[
- CommandLineArguments := #('stx') asOrderedCollection.
+ CommandLineArguments := #('stx') asOrderedCollection.
].
CommandLine := CommandLineArguments copy.
CommandLineArguments := CommandLineArguments asOrderedCollection.
@@ -649,38 +649,38 @@
"/ These allow for args like "--quick --infoPrint" to be automatically prepended
idx := CommandLineArguments indexOfAny:#('--noShellArgs' '--noshellargs').
(idx ~~ 0) ifTrue:[
- CommandLineArguments removeIndex:idx.
- ] ifFalse:[
- CommandLineArguments isEmpty ifTrue:[
- shellArgs := OperatingSystem getEnvironment:'STX_DEFAULT_ARGS'.
- shellArgs notEmptyOrNil ifTrue:[
- shellArgs := shellArgs asCollectionOfWords.
- CommandLineArguments addAll:shellArgs.
- ].
- ] ifFalse:[
- "/ prepend shell environment args from "STX_ARGS"
- shellArgs := OperatingSystem getEnvironment:'STX_MORE_ARGS'.
- shellArgs notEmptyOrNil ifTrue:[
- shellArgs := shellArgs asCollectionOfWords.
- CommandLineArguments addAllFirst:shellArgs.
- ].
- ].
- ].
-
- self initializeVerboseFlags.
+ CommandLineArguments removeIndex:idx.
+ ] ifFalse:[
+ CommandLineArguments isEmpty ifTrue:[
+ shellArgs := OperatingSystem getEnvironment:'STX_DEFAULT_ARGS'.
+ shellArgs notEmptyOrNil ifTrue:[
+ shellArgs := shellArgs asCollectionOfWords.
+ CommandLineArguments addAll:shellArgs.
+ ].
+ ] ifFalse:[
+ "/ prepend shell environment args from "STX_ARGS"
+ shellArgs := OperatingSystem getEnvironment:'STX_MORE_ARGS'.
+ shellArgs notEmptyOrNil ifTrue:[
+ shellArgs := shellArgs asCollectionOfWords.
+ CommandLineArguments addAllFirst:shellArgs.
+ ].
+ ].
+ ].
+
+ self initializeVerboseFlags.
Error handle:[:ex |
- StandAlone ifTrue:[
- DebuggingStandAlone ifFalse:[
- 'Startup Error - use "--debug" command line argument for more info' errorPrintCR.
- Smalltalk exit:1.
- ].
- 'Smalltalk [error]: Error during early initialization:' errorPrintCR.
- thisContext fullPrintAll.
- ].
- ex reject.
+ StandAlone ifTrue:[
+ DebuggingStandAlone ifFalse:[
+ 'Startup Error - use "--debug" command line argument for more info' errorPrintCR.
+ Smalltalk exit:1.
+ ].
+ 'Smalltalk [error]: Error during early initialization:' errorPrintCR.
+ thisContext fullPrintAll.
+ ].
+ ex reject.
] do:[
- self basicInitializeSystem
+ self basicInitializeSystem
].
"Modified: / 12-10-2010 / 11:27:47 / cg"
@@ -690,99 +690,99 @@
|idx|
StandAlone ifTrue:[
- InfoPrinting := false.
- ObjectMemory infoPrinting:false.
- IgnoreAssertions := true.
+ InfoPrinting := false.
+ ObjectMemory infoPrinting:false.
+ IgnoreAssertions := true.
] ifFalse:[
- IgnoreAssertions := false.
- ].
-
+ IgnoreAssertions := false.
+ ].
+
(idx := CommandLineArguments indexOf:'--ignoreHalt') ~~ 0 ifTrue:[
- IgnoreHalt := true.
- CommandLineArguments removeIndex:idx
+ IgnoreHalt := true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--noIgnoreHalt') ~~ 0 ifTrue:[
- IgnoreHalt := false.
- CommandLineArguments removeIndex:idx
+ IgnoreHalt := false.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--ignoreAssert') ~~ 0 ifTrue:[
- IgnoreAssertions := true.
- CommandLineArguments removeIndex:idx
+ IgnoreAssertions := true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--noIgnoreAssert') ~~ 0 ifTrue:[
- IgnoreAssertions := false.
- CommandLineArguments removeIndex:idx
+ IgnoreAssertions := false.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--assert') ~~ 0 ifTrue:[
- IgnoreAssertions := false.
- CommandLineArguments removeIndex:idx
+ IgnoreAssertions := false.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--silentStartup') ~~ 0 ifTrue:[
- SilentLoading := true.
- CommandLineArguments removeIndex:idx
+ SilentLoading := true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--verboseLoading') ~~ 0 ifTrue:[
- VerboseLoading := true.
- CommandLineArguments removeIndex:idx
+ VerboseLoading := true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--verboseStartup') ~~ 0 ifTrue:[
- VerboseLoading := true.
- VerboseStartup := true.
- CommandLineArguments removeIndex:idx
+ VerboseLoading := true.
+ VerboseStartup := true.
+ CommandLineArguments removeIndex:idx
].
"/ reinterpret those, in case given after the VM options.
(idx := CommandLineArguments indexOf:'--debugPrint') ~~ 0 ifTrue:[
- ObjectMemory debugPrinting:true.
- CommandLineArguments removeIndex:idx
+ ObjectMemory debugPrinting:true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--infoPrint') ~~ 0 ifTrue:[
- ObjectMemory infoPrinting:true.
- CommandLineArguments removeIndex:idx
+ ObjectMemory infoPrinting:true.
+ CommandLineArguments removeIndex:idx
].
(idx := CommandLineArguments indexOf:'--verbose') ~~ 0 ifTrue:[
- Object infoPrinting:true.
- Verbose := true.
- VerboseLoading := true.
- VerboseStartup := true.
- Logger notNil ifTrue:[
- Logger loggingThreshold: Logger severityALL.
- ].
- CommandLineArguments removeIndex:idx.
+ Object infoPrinting:true.
+ Verbose := true.
+ VerboseLoading := true.
+ VerboseStartup := true.
+ Logger notNil ifTrue:[
+ Logger loggingThreshold: Logger severityALL.
+ ].
+ CommandLineArguments removeIndex:idx.
].
Silent := false.
(idx := CommandLineArguments indexOf:'--silent') ~~ 0 ifTrue:[
- CommandLineArguments removeIndex:idx.
- Silent := SilentLoading := true.
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- ObjectMemory debugPrinting:false.
- Verbose := VerboseLoading := VerboseStartup := false.
- Logger notNil ifTrue:[
- Logger loggingThreshold: Logger severityNONE
- ].
+ CommandLineArguments removeIndex:idx.
+ Silent := SilentLoading := true.
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ ObjectMemory debugPrinting:false.
+ Verbose := VerboseLoading := VerboseStartup := false.
+ Logger notNil ifTrue:[
+ Logger loggingThreshold: Logger severityNONE
+ ].
].
idx := CommandLineArguments indexOf:'--debug'.
Debugging := (idx ~~ 0).
StandAlone ifTrue:[
- DebuggingStandAlone := Debugging.
- DebuggingStandAlone ifTrue:[
- Inspector := MiniInspector.
- Debugger := MiniDebugger.
- IgnoreAssertions := false.
- ].
+ DebuggingStandAlone := Debugging.
+ DebuggingStandAlone ifTrue:[
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+ IgnoreAssertions := false.
+ ].
] 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.
].
"Modified: / 12-10-2017 / 17:48:11 / cg"
@@ -1062,8 +1062,8 @@
from exceptionBlock, if no such key is present.
Since ST/X's Smalltalk as no real dictionary, this is simulated here.
Warning: this is a compatibility interface only, with a different semantic as
- the original ST80 implementation. The returned assoc is created on the fly,
- and not the one stored in the receiver (there are not assocs there)"
+ the original ST80 implementation. The returned assoc is created on the fly,
+ and not the one stored in the receiver (there are not assocs there)"
|val|
@@ -1105,7 +1105,7 @@
val := self at:aKey.
(val notNil or:[self includesKey:aKey]) ifTrue:[
- ^ val
+ ^ val
].
^ aBlock value
@@ -1135,7 +1135,7 @@
val := self at:aKey.
(val notNil or:[self includesKey:aKey]) ifTrue:[
- ^ aBlock value:val.
+ ^ aBlock value:val.
].
^ nil
@@ -1210,10 +1210,10 @@
"return the symbol under which anObject is stored - or nil.
This is a slow access, since the receiver is searched sequentially.
NOTICE:
- The value is searched using identity compare"
+ The value is searched using identity compare"
self keysDo:[:aKey |
- (self at:aKey) == anObject ifTrue:[^ aKey]
+ (self at:aKey) == anObject ifTrue:[^ aKey]
].
^ nil
@@ -1226,10 +1226,10 @@
"return the symbol under which anObject is stored - or the value from exceptionValue.
This is a slow access, since the receiver is searched sequentially.
NOTICE:
- The value is searched using identity compare"
+ The value is searched using identity compare"
self keysDo:[:aKey |
- (self at:aKey) == anObject ifTrue:[^ aKey]
+ (self at:aKey) == anObject ifTrue:[^ aKey]
].
^ exceptionValue value
@@ -1428,26 +1428,26 @@
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.
].
self at:sym put:nil. "nil it out for compiled accesses"
@@ -1456,25 +1456,25 @@
"/ see comment in removeKey: on why we don't 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 := aClass globalKeyForClassVar:name.
- self at:cSym asSymbol put:nil.
-
- "/
- "/ see comment in removeKey: on why we dont remove it here
- "/
- "/ self removeKey:cSym
+ cSym := aClass globalKeyForClassVar:name.
+ self at:cSym asSymbol put:nil.
+
+ "/
+ "/ see comment in removeKey: on why we dont remove it here
+ "/
+ "/ self removeKey:cSym
].
@@ -1506,16 +1506,16 @@
Class flushSubclassInfoFor:aClass.
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.
+ ].
].
"Modified: / 18-11-2006 / 17:16:31 / cg"
@@ -1576,24 +1576,24 @@
oldNameSym := aClass name asSymbol.
ns := aClass nameSpace.
aClass topOwningClass notNil ifTrue:[
- ons := aClass topOwningClass nameSpace
+ ons := aClass topOwningClass nameSpace
].
self basicRemoveClass:aClass.
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
+ ].
].
!
@@ -1606,40 +1606,40 @@
|tuples|
tuples := aCollectionOfClasses collect:[:eachClass|
- Array
- with:eachClass name asSymbol
- with:eachClass nameSpace
- with:(
- eachClass topOwningClass notNil ifTrue:[
- eachClass topOwningClass nameSpace
- ] ifFalse:[nil])
- ].
+ Array
+ with:eachClass name asSymbol
+ with:eachClass nameSpace
+ with:(
+ eachClass topOwningClass notNil ifTrue:[
+ eachClass topOwningClass nameSpace
+ ] ifFalse:[nil])
+ ].
aCollectionOfClasses do:[:eachClass|
- self basicRemoveClass:eachClass.
+ self basicRemoveClass:eachClass.
].
tuples do:[:eachClssymNsOnsTuple|
- |oldNameSym ns ons|
-
- oldNameSym := eachClssymNsOnsTuple at:1.
- ns := eachClssymNsOnsTuple at:2.
- ons := eachClssymNsOnsTuple at:3.
-
- 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
- ].
- ]
+ |oldNameSym ns ons|
+
+ oldNameSym := eachClssymNsOnsTuple at:1.
+ ns := eachClssymNsOnsTuple at:2.
+ ons := eachClssymNsOnsTuple at:3.
+
+ 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
+ ].
+ ]
].
!
@@ -1658,24 +1658,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.
@@ -1686,8 +1686,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
@@ -1696,42 +1696,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.
@@ -1751,32 +1751,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 |
@@ -1799,85 +1799,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
"/ 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.
self changed:#classRename with:(Array with:aClass with:oldName).
@@ -2084,21 +2084,21 @@
numClassesHintTimes2 := NumberOfClassesHint*2.
already := IdentitySet new:numClassesHintTimes2.
self allClassesDo:[:eachClass |
- |theNonMeta theMeta|
-
- theNonMeta := eachClass theNonMetaclass.
- (already includes:theNonMeta) ifFalse:[
- aBlock value:theNonMeta.
- already add:theNonMeta.
- ].
- theMeta := theNonMeta class.
- (already includes:theMeta) ifFalse:[
- aBlock value:theMeta.
- already add:theMeta.
- ].
- already size > numClassesHintTimes2 ifTrue:[
- NumberOfClassesHint := (already size // 2) + 10
- ].
+ |theNonMeta theMeta|
+
+ theNonMeta := eachClass theNonMetaclass.
+ (already includes:theNonMeta) ifFalse:[
+ aBlock value:theNonMeta.
+ already add:theNonMeta.
+ ].
+ theMeta := theNonMeta class.
+ (already includes:theMeta) ifFalse:[
+ aBlock value:theMeta.
+ already add:theMeta.
+ ].
+ already size > numClassesHintTimes2 ifTrue:[
+ NumberOfClassesHint := (already size // 2) + 10
+ ].
].
!
@@ -2124,13 +2124,13 @@
collectedClasses := OrderedCollection new.
self allClassesForWhich:filter do:[:cls |
- collectedClasses add:cls
+ collectedClasses add:cls
].
^ collectedClasses
"
Smalltalk
- allClassesForWhich:[:cls | cls name startsWith:'Po']
+ allClassesForWhich:[:cls | cls name startsWith:'Po']
"
"Created: / 10-08-2006 / 12:11:31 / cg"
@@ -2142,13 +2142,13 @@
Enumerates non-meta classes only - not metaclasses"
self allClassesDo:[:cls |
- (filter value:cls) ifTrue:[ aBlock value:cls ].
+ (filter value:cls) ifTrue:[ aBlock value:cls ].
].
"
Smalltalk
- allClassesForWhich:[:cls | cls name startsWith:'Po']
- do:[:aClass | Transcript showCR:aClass name]
+ allClassesForWhich:[:cls | cls name startsWith:'Po']
+ do:[:aClass | Transcript showCR:aClass name]
"
"Modified (comment): / 19-02-2017 / 12:37:59 / cg"
@@ -2274,7 +2274,7 @@
allCategories := Set new.
Smalltalk allClassesDo:[:cls |
- allCategories addAll:cls methodCategories.
+ allCategories addAll:cls methodCategories.
].
^ allCategories.
@@ -2318,11 +2318,11 @@
"enumerate methods for which aCheckBlock returns true"
Smalltalk allClassesDo:[:eachClass |
- eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- (aCheckBlock value:mthd) ifTrue:[
- actionBlock value:mthd
- ].
- ]
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ (aCheckBlock value:mthd) ifTrue:[
+ actionBlock value:mthd
+ ].
+ ]
].
"
@@ -2452,9 +2452,9 @@
|sav|
Smalltalk verbose ifTrue:[
- ^ aBlock value.
- ].
-
+ ^ aBlock value.
+ ].
+
sav := SilentLoading.
SilentLoading := true.
^ aBlock ensure:[ SilentLoading := sav ].
@@ -2492,15 +2492,15 @@
The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
Answer true, if the load succeeded, false if it failed"
- |packageDirOrNil binaryClassLibraryFilename projectDefinitionFilename
+ |packageDirOrNil binaryClassLibraryFilename projectDefinitionFilename
projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
loadOK errorInInitialize|
packageDirOrStringOrNil notNil ifTrue:[
- packageDirOrNil := packageDirOrStringOrNil asFilename.
- ].
- silent := VerboseLoading not
- and:[SilentLoading or:[StandAlone or:[InfoPrinting not]]].
+ packageDirOrNil := packageDirOrStringOrNil asFilename.
+ ].
+ silent := VerboseLoading not
+ and:[SilentLoading or:[StandAlone or:[InfoPrinting not]]].
"For now: have to read the project definition first!!
The class library may contain subclasses of classes in prerequisite packages -
@@ -2510,106 +2510,106 @@
"maybe, it is already in the image"
projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass checkForLoad.
+ projectDefinitionClass checkForLoad.
].
"Is there a shared library (.dll or .so) ?"
binaryClassLibraryFilename := ObjectFileLoader
- binaryClassFilenameForPackage:aPackageString
- inDirectory:packageDirOrNil.
+ binaryClassFilenameForPackage:aPackageString
+ inDirectory:packageDirOrNil.
(binaryClassLibraryFilename notNil and:[binaryClassLibraryFilename exists]) ifTrue:[
- |loadErrorOccurred|
-
- loadErrorOccurred := false.
- ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
- loadErrorOccurred := true.
- ex proceedWith:true.
- ] do:[
- loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
- "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
- ].
- (loadOK and:[loadErrorOccurred not]) ifTrue:[
- "now, all compiled classes have been loaded.
- keep classes in the package which are autoloaded as autoloaded."
- ^ true
- ].
-
- loadErrorOccurred ifTrue:[
- self breakPoint:#cg.
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass
- checkForLoad;
- loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- ].
- ].
+ |loadErrorOccurred|
+
+ loadErrorOccurred := false.
+ ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
+ loadErrorOccurred := true.
+ ex proceedWith:true.
+ ] do:[
+ loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
+ "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
+ ].
+ (loadOK and:[loadErrorOccurred not]) ifTrue:[
+ "now, all compiled classes have been loaded.
+ keep classes in the package which are autoloaded as autoloaded."
+ ^ true
+ ].
+
+ loadErrorOccurred ifTrue:[
+ self breakPoint:#cg.
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass
+ checkForLoad;
+ loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ ].
+ ].
].
packageDirOrNil isNil ifTrue:[
- ^ PackageNotFoundError raiseRequestWith:aPackageString.
+ ^ PackageNotFoundError raiseRequestWith:aPackageString.
].
"fallback - go through the project definition"
projectDefinitionClass isNil ifTrue:[
- projectDefinitionClassName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:aPackageString.
- "/ try to load the project definition class
- projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
- projectDefinitionFilename exists ifFalse:[
- projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
- ].
- projectDefinitionFilename exists ifTrue:[
- Class withoutUpdatingChangesDo:[
- Smalltalk silentlyLoadingDo:[
- Error handle:[:ex |
- "/ catch error during initialization;
- ex suspendedContext withAllSendersDo:[:sender |
- (sender selector == #initialize
- and:[sender receiver isBehavior
- and:[sender receiver name = projectDefinitionClassName]]
- ) ifTrue:[
- errorInInitialize := true
- ].
- ].
- errorInInitialize ifFalse:[ ex reject ].
- ] do:[
- projectDefinitionFilename fileIn.
- ].
- ].
- ].
- errorInInitialize ifTrue:[
- Transcript showCR:'Smalltalk [warning]: an error happened in #initialize - retry after loading package.'.
- ].
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- ].
+ projectDefinitionClassName := ProjectDefinition projectDefinitionClassNameForDefinitionOf:aPackageString.
+ "/ try to load the project definition class
+ projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
+ projectDefinitionFilename exists ifFalse:[
+ projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
+ ].
+ projectDefinitionFilename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ Smalltalk silentlyLoadingDo:[
+ Error handle:[:ex |
+ "/ catch error during initialization;
+ ex suspendedContext withAllSendersDo:[:sender |
+ (sender selector == #initialize
+ and:[sender receiver isBehavior
+ and:[sender receiver name = projectDefinitionClassName]]
+ ) ifTrue:[
+ errorInInitialize := true
+ ].
+ ].
+ errorInInitialize ifFalse:[ ex reject ].
+ ] do:[
+ projectDefinitionFilename fileIn.
+ ].
+ ].
+ ].
+ errorInInitialize ifTrue:[
+ Transcript showCR:'Smalltalk [warning]: an error happened in #initialize - retry after loading package.'.
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ ].
].
projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass
- autoload;
- checkForLoad;
- loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
-
- somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
- errorInInitialize ifTrue:[
- Transcript showCR:('Smalltalk [info]: retrying #initialize').
- projectDefinitionClass initialize.
- ].
- (silent not and:[somethingHasBeenLoaded]) ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
- ].
- ^ true.
+ projectDefinitionClass
+ autoload;
+ checkForLoad;
+ loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ errorInInitialize ifTrue:[
+ Transcript showCR:('Smalltalk [info]: retrying #initialize').
+ projectDefinitionClass initialize.
+ ].
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
+ ].
+ ^ true.
].
"/ source files-file loading no longer supported
"/ however, allow for autoload-stub loaded
doLoadAsAutoloaded ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:packageDirOrNil
- rememberIn:Set new
- maxLevels:2
- noAutoload:false
- packageTop:packageDirOrNil
- showSplashInLevels:0.
- ^ true
+ self
+ recursiveInstallAutoloadedClassesFrom:packageDirOrNil
+ rememberIn:Set new
+ maxLevels:2
+ noAutoload:false
+ packageTop:packageDirOrNil
+ showSplashInLevels:0.
+ ^ true
].
^ PackageNotFoundError raiseRequestWith:aPackageString errorString:' - no projectDef, dll or loadAll found'.
@@ -2628,8 +2628,8 @@
extensionsLoaded := false.
ProgrammingLanguage allDo:[:programmingLanguage|
- "/ evaluating or here - want all extensions to be loaded
- extensionsLoaded := extensionsLoaded | (self loadExtensionsForPackage:aPackageId language: programmingLanguage)
+ "/ evaluating or here - want all extensions to be loaded
+ extensionsLoaded := extensionsLoaded | (self loadExtensionsForPackage:aPackageId language: programmingLanguage)
].
^ extensionsLoaded
@@ -2648,71 +2648,71 @@
packageDirName := self getPackageFileName:packageDirName.
(packageDirName notNil and:[Class tryLocalSourceFirst]) ifTrue:[
- (self loadExtensionsFromDirectory:packageDirName language: programmingLanguage) ifTrue:[
- ^ true.
- ].
- packageDirName := nil. "do not try again"
+ (self loadExtensionsFromDirectory:packageDirName language: programmingLanguage) ifTrue:[
+ ^ true.
+ ].
+ packageDirName := nil. "do not try again"
].
"
if there is a sourceCodeManager, ask it first for the extensions
"
(Smalltalk at:#AbstractSourceCodeManager) notNil ifTrue:[
- mgr := AbstractSourceCodeManager managerForPackage: aPackageId
+ mgr := AbstractSourceCodeManager managerForPackage: aPackageId
].
mgr notNil ifTrue:[
- extensionsFilename := 'extensions.' , programmingLanguage sourceFileSuffix.
-
- projectDefinition := ProjectDefinition definitionClassForPackage:aPackageId.
- projectDefinition notNil ifTrue:[
- mod := aPackageId asPackageId module.
- dir := aPackageId asPackageId directory.
- extensionsRevisionString := projectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
- extensionsRevisionString notNil ifTrue:[
- extensionsRevisionInfo := mgr revisionInfoFromString:extensionsRevisionString inClass:nil.
- extensionsRevisionInfo notNil ifTrue:[
- extensionsRevisionInfo fileName = extensionsFilename ifFalse:[
- "JV@2011-10-23: following condition is never satisfied for
- filed-in packages. The whole scheme of extensionVersion_XXX
- works ONLY for compiled packages as it depends on fact, that
- extension Init() routine is called AFTER all classes are inited,
- therefore the extensionVersion_XXX methods from extensions.st
- overwrites methods coming from package definition class. All this
- is so tricky and error prone, that we have to come up with better
- solution!!"
- packageDirName notNil ifTrue:[
- ^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
- ] ifFalse:[
- ^ false
- ]
- ]
- ]
- ].
- SourceCodeManagerError handle:[:ex |
- ] do:[
- inStream := mgr streamForExtensionFile:extensionsFilename package:aPackageId directory:dir module:mod cache:true.
- ].
- ].
- inStream isNil ifTrue:[
- SourceCodeManagerError handle:[:ex |
- ] do:[
- inStream := mgr getMostRecentSourceStreamForFile:extensionsFilename inPackage:aPackageId.
- ].
- ].
- inStream notNil ifTrue:[
- Class withoutUpdatingChangeSetDo:[
- inStream fileIn.
- ].
- inStream close.
- VerboseLoading ifTrue:[
- Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
- ].
- ^ true
- ]
+ extensionsFilename := 'extensions.' , programmingLanguage sourceFileSuffix.
+
+ projectDefinition := ProjectDefinition definitionClassForPackage:aPackageId.
+ projectDefinition notNil ifTrue:[
+ mod := aPackageId asPackageId module.
+ dir := aPackageId asPackageId directory.
+ extensionsRevisionString := projectDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
+ extensionsRevisionString notNil ifTrue:[
+ extensionsRevisionInfo := mgr revisionInfoFromString:extensionsRevisionString inClass:nil.
+ extensionsRevisionInfo notNil ifTrue:[
+ extensionsRevisionInfo fileName = extensionsFilename ifFalse:[
+ "JV@2011-10-23: following condition is never satisfied for
+ filed-in packages. The whole scheme of extensionVersion_XXX
+ works ONLY for compiled packages as it depends on fact, that
+ extension Init() routine is called AFTER all classes are inited,
+ therefore the extensionVersion_XXX methods from extensions.st
+ overwrites methods coming from package definition class. All this
+ is so tricky and error prone, that we have to come up with better
+ solution!!"
+ packageDirName notNil ifTrue:[
+ ^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
+ ] ifFalse:[
+ ^ false
+ ]
+ ]
+ ]
+ ].
+ SourceCodeManagerError handle:[:ex |
+ ] do:[
+ inStream := mgr streamForExtensionFile:extensionsFilename package:aPackageId directory:dir module:mod cache:true.
+ ].
+ ].
+ inStream isNil ifTrue:[
+ SourceCodeManagerError handle:[:ex |
+ ] do:[
+ inStream := mgr getMostRecentSourceStreamForFile:extensionsFilename inPackage:aPackageId.
+ ].
+ ].
+ inStream notNil ifTrue:[
+ Class withoutUpdatingChangeSetDo:[
+ inStream fileIn.
+ ].
+ inStream close.
+ VerboseLoading ifTrue:[
+ Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
+ ].
+ ^ true
+ ]
].
packageDirName notNil ifTrue:[
- ^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
+ ^ self loadExtensionsFromDirectory:packageDirName language: programmingLanguage
].
^ false
@@ -2727,8 +2727,8 @@
extensionsLoaded := false.
ProgrammingLanguage allDo:[:programmingLanguage|
- "/ evaluating or here - want all extensions to be loaded
- extensionsLoaded := extensionsLoaded | (self loadExtensionsFromDirectory: packageDirOrString language: programmingLanguage)
+ "/ evaluating or here - want all extensions to be loaded
+ extensionsLoaded := extensionsLoaded | (self loadExtensionsFromDirectory: packageDirOrString language: programmingLanguage)
].
^ extensionsLoaded
@@ -2767,7 +2767,7 @@
"/ a little convenience: so you can stx packages with loadPackage:'goodies/soap'
(packageString includes:$:) ifFalse:[
- packageString := 'stx:',packageString.
+ packageString := 'stx:',packageString.
].
"if I am here, so must my package"
@@ -2778,31 +2778,31 @@
"/ if there is a projectDefinition, let it load itself...
def := packageId projectDefinitionClass.
(def notNil and:[def isLoaded]) ifTrue:[
- def loadAsAutoloaded:doLoadAsAutoloaded.
- ^ true.
+ def loadAsAutoloaded:doLoadAsAutoloaded.
+ ^ true.
].
packageDir := self packageDirectoryForPackageId:packageId.
[
- self
- loadPackage:packageString
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded.
+ self
+ loadPackage:packageString
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded.
] on:PackageLoadError do:[:ex|
- ex creator ~~ PackageNotCompatibleError ifTrue:[
- AbstractSourceCodeManager notNil ifTrue:[
- sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString.
- sourceCodeManager notNil ifTrue:[
- PackageLoadError handle:[:ex2 |
- ex reject
- ] do:[
- ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
- ].
- ].
- ].
- ].
- ex reject.
+ ex creator ~~ PackageNotCompatibleError ifTrue:[
+ AbstractSourceCodeManager notNil ifTrue:[
+ sourceCodeManager := AbstractSourceCodeManager sourceCodeManagerForPackage:packageString.
+ sourceCodeManager notNil ifTrue:[
+ PackageLoadError handle:[:ex2 |
+ ex reject
+ ] do:[
+ ^ sourceCodeManager loadPackageWithId:packageString fromRepositoryAsAutoloaded:doLoadAsAutoloaded
+ ].
+ ].
+ ].
+ ].
+ ex reject.
].
^ true
@@ -2960,8 +2960,8 @@
Experimental."
PackageLoadError
- raiseWith:aPackageId
- errorString:' - package loading from zip is not yet implemented'.
+ raiseWith:aPackageId
+ errorString:' - package loading from zip is not yet implemented'.
!
loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded
@@ -3009,27 +3009,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
@@ -3065,13 +3065,13 @@
(i.e. anonymous ones have to be acquired by Behavior allSubInstances)"
^ self allClasses select:[:aClass |
- |owner|
-
- (aClass isRealNameSpace not)
- and:[
- owner := aClass topOwningClass.
- (owner ? aClass) nameSpace == Smalltalk
- ]
+ |owner|
+
+ (aClass isRealNameSpace not)
+ and:[
+ owner := aClass topOwningClass.
+ (owner ? aClass) nameSpace == Smalltalk
+ ]
]
"
@@ -3124,8 +3124,8 @@
^ implementors
"
- Smalltalk allImplementorsOf:#isNil
- (Smalltalk allImplementorsOf:#add:) size
+ Smalltalk allImplementorsOf:#isNil
+ (Smalltalk allImplementorsOf:#add:) size
"
"Modified: / 30-04-2016 / 17:37:39 / cg"
@@ -3135,12 +3135,12 @@
"enumerate all classes which implement the given selector"
self allClassesDo:[:cls |
- (cls includesSelector:aSelector) ifTrue:[
- aBlock value:cls.
- ].
- (cls class includesSelector:aSelector) ifTrue:[
- aBlock value:cls class.
- ].
+ (cls includesSelector:aSelector) ifTrue:[
+ aBlock value:cls.
+ ].
+ (cls class includesSelector:aSelector) ifTrue:[
+ aBlock value:cls class.
+ ].
].
"
@@ -3190,30 +3190,30 @@
allProjects := Set new.
self allClassesDo:[:eachClass |
- |cls pkg|
-
- eachClass isRealNameSpace ifFalse:[
- (includeUnloadedClasses or:[eachClass isLoaded]) ifTrue:[
- cls := eachClass theNonMetaclass.
- cls isPrivate ifTrue:[
- cls := cls topOwningClass
- ].
- pkg := cls package.
- pkg 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|
+
+ eachClass isRealNameSpace ifFalse:[
+ (includeUnloadedClasses or:[eachClass isLoaded]) ifTrue:[
+ cls := eachClass theNonMetaclass.
+ cls isPrivate ifTrue:[
+ cls := cls topOwningClass
+ ].
+ pkg := cls package.
+ pkg 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
@@ -3291,46 +3291,46 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym isSymbol 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 copyButLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
- ^ nil.
+ nonMeta := self classNamed:(aString copyButLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
+ ^ nil.
].
"no success yet. Try if this is a private class of an autoloaded class"
cls isNil ifTrue:[
- idx := aString indexOfSubCollection:'::'.
- idx ~~ 0 ifTrue:[
- prefix := aString copyTo:idx-1.
- nsNameSymbol := prefix asSymbolIfInterned.
- nsNameSymbol notNil ifTrue:[
- 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.
+ nsNameSymbol := prefix asSymbolIfInterned.
+ nsNameSymbol notNil ifTrue:[
+ 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
@@ -3908,13 +3908,13 @@
ParserFlags warnDollarInIdentifier:false.
ParserFlags warnUnderscoreInIdentifier:false.
ParserFlags allowOldStyleAssignment:false.
-
+
"/ add bindings for arguments
Workspace workspaceVariableAt:('_$0') put:CommandName.
Workspace workspaceVariableAt:('_$n') put:CommandLineArguments size.
Workspace workspaceVariableAt:('_$$') put:CommandLineArguments.
CommandLineArguments doWithIndex:[:arg :i |
- Workspace workspaceVariableAt:('_$',i printString) put:arg.
+ Workspace workspaceVariableAt:('_$',i printString) put:arg.
].
!
@@ -3958,15 +3958,15 @@
lateOpenDisplay
"this is called when a view is opened without a display being already opened."
-
+
|display|
display := Smalltalk openDisplay.
- display notNil ifTrue:[
- IsRepl ifFalse:[
- display exitOnLastClose:true.
- ].
- "/ Processor exitWhenNoMoreUserProcesses:true.
+ display notNil ifTrue:[
+ IsRepl ifFalse:[
+ display exitOnLastClose:true.
+ ].
+ "/ Processor exitWhenNoMoreUserProcesses:true.
].
^ display
@@ -3983,43 +3983,43 @@
thisIsARestart := imageName notNil.
true "graphicalMode" ifTrue:[
- Display isNil ifTrue:[
- (StartupClass notNil
- and:[ (StartupClass perform:#isHeadless ifNotUnderstood:false) ]) ifFalse:[
- self openDisplay.
- ].
- ].
+ Display isNil ifTrue:[
+ (StartupClass notNil
+ and:[ (StartupClass perform:#isHeadless ifNotUnderstood:false) ]) ifFalse:[
+ self openDisplay.
+ ].
+ ].
].
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.
].
"
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:11.
- ].
- 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:11.
+ ].
+ Display startDispatch.
].
idx := CommandLineArguments indexOf:'--browserWindow:'.
IsPlugin := (idx ~~ 0).
IsPlugin ifTrue:[
- 'Smalltalk [info]: startup browser window...' infoPrintCR.
- self browserWindowStartup.
- "/ not reached
+ 'Smalltalk [info]: startup browser window...' infoPrintCR.
+ self browserWindowStartup.
+ "/ not reached
].
Initializing := false.
@@ -4030,49 +4030,49 @@
"/ Therefore, it is now done by an extra user-process.
process := [
- 'Smalltalk [info]: startup process 1 active.' infoPrintCR.
- StartBlocks notNil ifTrue:[
- self executeStartBlocks.
- StartBlocks := nil.
- ].
- ImageStartBlocks notNil ifTrue:[
- 'Smalltalk [info]: execute imageStartBlocks...' infoPrintCR.
- 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.
- ].
-
- 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.
- ]
+ 'Smalltalk [info]: startup process 1 active.' infoPrintCR.
+ StartBlocks notNil ifTrue:[
+ self executeStartBlocks.
+ StartBlocks := nil.
+ ].
+ ImageStartBlocks notNil ifTrue:[
+ 'Smalltalk [info]: execute imageStartBlocks...' infoPrintCR.
+ 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.
+ ].
+
+ 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.
@@ -4089,70 +4089,70 @@
"/ 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 copyButLast:4
- ].
- self fileIn:(imageName , '.rc')
- ].
-
- Display notNil ifTrue:[
- Display exitOnLastClose:true.
- ].
- Processor exitWhenNoMoreUserProcesses:true.
-
- process := [
- 'Smalltalk [info]: startup process 2 active.' infoPrintCR.
- StandAlone ifTrue:[
- AbortOperationRequest handle:[:ex |
- 'Smalltalk [info]: aborted - exit.' infoPrintCR.
- OperatingSystem exit:1
- ] do:[
- ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (1)') infoPrintCR.
- StartupClass perform:StartupSelector withArguments:StartupArguments.
- ]
- ] ifFalse:[
- ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (2)') infoPrintCR.
- 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:11.
- ].
+ "
+ allow more customization by reading an image specific rc-file
+ "
+ thisIsARestart ifTrue:[
+ (imageName asFilename hasSuffix:'img') ifTrue:[
+ imageName := imageName copyButLast:4
+ ].
+ self fileIn:(imageName , '.rc')
+ ].
+
+ Display notNil ifTrue:[
+ Display exitOnLastClose:true.
+ ].
+ Processor exitWhenNoMoreUserProcesses:true.
+
+ process := [
+ 'Smalltalk [info]: startup process 2 active.' infoPrintCR.
+ StandAlone ifTrue:[
+ AbortOperationRequest handle:[:ex |
+ 'Smalltalk [info]: aborted - exit.' infoPrintCR.
+ OperatingSystem exit:1
+ ] do:[
+ ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (1)') infoPrintCR.
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
+ ]
+ ] ifFalse:[
+ ('Smalltalk [info]: call ',StartupSelector,' of ',StartupClass name,' (2)') infoPrintCR.
+ 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:11.
+ ].
"/ "/
"/ "/ 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 := nil. "do not refer to process"
+ Processor exitWhenNoMoreUserProcesses:true.
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+ process := nil. "do not refer to process"
].
StandAlone ifTrue:[
- Display notNil ifTrue:[
- FlyByHelp notNil ifTrue:[
- FlyByHelp start
- ].
- ].
+ Display notNil ifTrue:[
+ FlyByHelp notNil ifTrue:[
+ FlyByHelp start
+ ].
+ ].
].
"/ Display notNil ifTrue:[
"/ Display exitOnLastClose:true.
"/ ].
OperatingSystem finishLaunching.
-
+
"
if view-classes exist, start dispatching;
otherwise go into a read-eval-print loop
@@ -4162,14 +4162,14 @@
or:[HeadlessOperation
or:[StandAlone]]]
) ifTrue:[
- Processor exitWhenNoMoreUserProcesses:true.
- Processor dispatchLoop.
- "done - the last process finished"
- 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
+ Processor exitWhenNoMoreUserProcesses:true.
+ Processor dispatchLoop.
+ "done - the last process finished"
+ 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
] ifFalse:[
- StandAlone ifFalse:[
- self readEvalPrintLoop
- ]
+ StandAlone ifFalse:[
+ self readEvalPrintLoop
+ ]
].
self exit
@@ -4189,30 +4189,30 @@
(commandName, ' [info]: opening display...') infoPrintCR.
Display isNil ifTrue:[
- Screen notNil ifTrue:[
- [
- Screen openDefaultDisplay:nil.
- ] on:Screen deviceOpenErrorSignal do:[:ex|
- "do not use #errorPrintCR, it is no error, when an app supports display and no display.
- in case shell exec 'app --version' we do not want this error string as part of the output"
- ('%1 [error]: No display connection to: %2' bindWith:commandName with:ex parameter) infoPrintCR.
+ Screen notNil ifTrue:[
+ [
+ Screen openDefaultDisplay:nil.
+ ] on:Screen deviceOpenErrorSignal do:[:ex|
+ "do not use #errorPrintCR, it is no error, when an app supports display and no display.
+ in case shell exec 'app --version' we do not want this error string as part of the output"
+ ('%1 [error]: No display connection to: %2' bindWith:commandName with:ex parameter) infoPrintCR.
"/ ('%1 [error]: No display connection to: %2' bindWith:commandName with:ex parameter) errorPrintCR.
- (commandName, ' [info]: Either set the DISPLAY environment variable,') infoPrintCR.
- (commandName, ' [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.
- ]
- ]
- ].
- ]
+ (commandName, ' [info]: Either set the DISPLAY environment variable,') infoPrintCR.
+ (commandName, ' [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.
+ ]
+ ]
+ ].
+ ]
].
^ Display
@@ -4224,28 +4224,34 @@
providingDisplayDo:aBlock
"/ provide a Display, if needed
(Smalltalk at:#Screen) currentScreenQuerySignal handle:[:ex |
- Display isNil ifTrue:[ self lateOpenDisplay ].
- ex proceedWith:Display.
- ] do:aBlock
+ Display isNil ifTrue:[ self lateOpenDisplay ].
+ ex proceedWith:Display.
+ ] do:aBlock
!
readEvalPrintLoop
"say hello, then go into a read-eval-print loop"
-
+
"{ Pragma: +optSpace }"
- Transcript showCR:(self hello).
- Transcript showCR:(self copyrightString).
- Transcript cr.
- Transcript showCR:'Read-eval-print loop; exit with "#exit"; help with "?"'.
-
- ReadEvalPrintLoop new
- prompt:'ST> ';
- doChunkFormat:false;
- error:Stderr;
- readEvalPrintLoop
-
- "Modified: / 07-12-2006 / 17:35:19 / cg"
+ |repl|
+
+ repl := ReadEvalPrintLoop new.
+
+ SilentLoading == true ifTrue:[
+ repl answerPrompt:''.
+ ] ifFalse:[
+ Transcript showCR:(self hello).
+ Transcript showCR:(self copyrightString).
+ Transcript cr.
+ Transcript showCR:'Read-eval-print loop; exit with "#exit"; help with "?"'.
+ ].
+
+ repl
+ prompt:'ST> ';
+ doChunkFormat:false;
+ error:Stderr;
+ readEvalPrintLoop
!
restart
@@ -4485,16 +4491,16 @@
start
"low level entry from the VM's main.
After initializeSystem, this is the very first real entry into the Smalltalk world.
- Analyzes the command line and checks what to do
+ Analyzes the command line and checks what to do
(i.e. script/repl/eval or full blown IDE).
Also handles --load and various debug options.
- Caveat:
- this has become too complicated and desperately needs a rewrite.
+ Caveat:
+ this has become too complicated and desperately needs a rewrite.
Also:
- Be very careful when changing things here;
- especially be careful to ensure that the scripting options are robust against any
- missing packages; so the error handlers should not depend on any stream, logger etc. features.
+ Be very careful when changing things here;
+ especially be careful to ensure that the scripting options are robust against any
+ missing packages; so the error handlers should not depend on any stream, logger etc. features.
"
|idx graphicalMode arg didReadRCFile keepSplashWindow|
@@ -4506,436 +4512,436 @@
idx := CommandLineArguments indexOf:'--debug'.
(idx ~~ 0) ifTrue:[
- CommandLineArguments removeAtIndex:idx.
- ].
+ CommandLineArguments removeAtIndex:idx.
+ ].
"
while reading patches- and rc-file, do not add things into change-file
"
Class withoutUpdatingChangesDo:[
- |commandFiles rcFile defaultRC prevCatchSetting
- isEval isPrint isFilter isRepl isRunMain idxFileArg process|
-
- isEval := isPrint := isFilter := isRepl := isRunMain := false.
- didReadRCFile := false.
-
- StandAlone ifFalse:[
- "/ self initializeVerboseFlags.
-
- "/
- "/ look for any '-q', '-e', '-l' or '-f' command line arguments
- "/ and handle them;
- "/ read startup and patches file
- "/
- idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- isRepl := IsRepl := (idx ~~ 0).
-
- idx := CommandLineArguments indexOfAny:#('-q' '--silent').
- idx ~~ 0 ifTrue:[
- Object infoPrinting:false.
- ObjectMemory infoPrinting:false.
- CommandLineArguments removeAtIndex:idx.
- SilentLoading := true.
- ].
-
- [
- idx := CommandLineArguments indexOfAny:#('-pp' '--packagePath').
- idx ~~ 0
- ] whileTrue:[
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
- self packagePath addLast:each.
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
- ].
- ].
- ].
-
- [
- idx := CommandLineArguments indexOfAny:#('-l' '--load').
- idx ~~ 0
- ] whileTrue:[
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
- Smalltalk silentlyLoadingDo:[
- (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
- each asFilename exists ifTrue:[
- (VerboseStartup | VerboseLoading) ifTrue:[
- ('Smalltalk [info]: loading file: "', each, '".') infoPrintCR.
- ].
- Smalltalk fileIn:each
- ] ifFalse:[
- (VerboseStartup | VerboseLoading) ifTrue:[
- ('Smalltalk [info]: loading package: "', each, '".') infoPrintCR.
- ].
- Smalltalk loadPackage:each
- ].
- ].
- ].
- ].
-
- "/ look for a '-e filename' or '--execute filename' or '--script filename' argument
- "/ this will force fileIn of filename only, no standard startup.
-
- idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
- idx ~~ 0 ifTrue:[
- SilentLoading := true.
- CommandName := arg := CommandLineArguments at:idx + 1.
-
- CommandLineArguments
- removeAtIndex:idx+1; removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- Initializing := false.
-
- process := [
- Processor exitWhenNoMoreUserProcesses:true.
-
- "/ set workspace variables
- self defineCommandLineAsWorkspaceVariablesForScripts.
-
- "/ provide a Display, if needed
- self providingDisplayDo:[
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
- ].
- NoHandlerError handle:[:ex |
- Debugging == true ifTrue:[
- MiniDebugger enterException:ex.
- ] ifFalse:[
- Silent ifFalse:[
- 'Smalltalk [error]: ' _errorPrint. ex exception description _errorPrintCR.
- ].
- (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
- ex suspendedContext fullPrintAll.
- ].
- self exit:1.
- ].
- self exit:1.
- "/ ex reject.
- ] do:[
- UserInterrupt handle:[:ex |
- Debugging == true ifTrue:[
- 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
- "/ thisContext fullPrintAll.
- MiniDebugger enterException:ex.
- ex proceed.
- ].
- Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- |cmdStream result|
-
- arg = '-' ifTrue:[
- cmdStream := Stdin.
- ] ifFalse:[
- IsSTScript := true.
- cmdStream := arg asFilename readStream.
- ].
- result := [
- self fileInStream:cmdStream
- lazy:nil
- silent:self verbose not
- logged:false
- addPath:nil
- ] ensure:[
- IsSTScript ifTrue:[
- "/ do not close Stdin
- cmdStream close.
- ].
- ].
- result ifFalse:[
- self exit:1.
- ].
- ].
- ].
- ].
-
- "/ after the script, if Screen has been opened and there are any open windows,
- "/ then do not exit
+ |commandFiles rcFile defaultRC prevCatchSetting
+ isEval isPrint isFilter isRepl isRunMain idxFileArg process|
+
+ isEval := isPrint := isFilter := isRepl := isRunMain := false.
+ didReadRCFile := false.
+
+ StandAlone ifFalse:[
+ "/ self initializeVerboseFlags.
+
+ "/
+ "/ look for any '-q', '-e', '-l' or '-f' command line arguments
+ "/ and handle them;
+ "/ read startup and patches file
+ "/
+ idx := CommandLineArguments indexOfAny:#('-R' '--repl').
+ isRepl := IsRepl := (idx ~~ 0).
+
+ idx := CommandLineArguments indexOfAny:#('-q' '--silent').
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ SilentLoading := true.
+ ].
+
+ [
+ idx := CommandLineArguments indexOfAny:#('-pp' '--packagePath').
+ idx ~~ 0
+ ] whileTrue:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
+ self packagePath addLast:each.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: add to packagePath: "', arg, '".') infoPrintCR.
+ ].
+ ].
+ ].
+
+ [
+ idx := CommandLineArguments indexOfAny:#('-l' '--load').
+ idx ~~ 0
+ ] whileTrue:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1; removeAtIndex:idx.
+ Smalltalk silentlyLoadingDo:[
+ (arg asCollectionOfSubstringsSeparatedByAny:',;') do:[:each |
+ each asFilename exists ifTrue:[
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: loading file: "', each, '".') infoPrintCR.
+ ].
+ Smalltalk fileIn:each
+ ] ifFalse:[
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: loading package: "', each, '".') infoPrintCR.
+ ].
+ Smalltalk loadPackage:each
+ ].
+ ].
+ ].
+ ].
+
+ "/ look for a '-e filename' or '--execute filename' or '--script filename' argument
+ "/ this will force fileIn of filename only, no standard startup.
+
+ idx := CommandLineArguments indexOfAny:#('-e' '--execute' '--script').
+ idx ~~ 0 ifTrue:[
+ SilentLoading := true.
+ CommandName := arg := CommandLineArguments at:idx + 1.
+
+ CommandLineArguments
+ removeAtIndex:idx+1; removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ Initializing := false.
+
+ process := [
+ Processor exitWhenNoMoreUserProcesses:true.
+
+ "/ set workspace variables
+ self defineCommandLineAsWorkspaceVariablesForScripts.
+
+ "/ provide a Display, if needed
+ self providingDisplayDo:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: reading script from: "', arg, '".') infoPrintCR.
+ ].
+ NoHandlerError handle:[:ex |
+ Debugging == true ifTrue:[
+ MiniDebugger enterException:ex.
+ ] ifFalse:[
+ Silent ifFalse:[
+ 'Smalltalk [error]: ' _errorPrint. ex exception description _errorPrintCR.
+ ].
+ (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
+ ex suspendedContext fullPrintAll.
+ ].
+ self exit:1.
+ ].
+ self exit:1.
+ "/ ex reject.
+ ] do:[
+ UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enterException:ex.
+ ex proceed.
+ ].
+ Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ |cmdStream result|
+
+ arg = '-' ifTrue:[
+ cmdStream := Stdin.
+ ] ifFalse:[
+ IsSTScript := true.
+ cmdStream := arg asFilename readStream.
+ ].
+ result := [
+ self fileInStream:cmdStream
+ lazy:nil
+ silent:self verbose not
+ logged:false
+ addPath:nil
+ ] ensure:[
+ IsSTScript ifTrue:[
+ "/ do not close Stdin
+ cmdStream close.
+ ].
+ ].
+ result ifFalse:[
+ self exit:1.
+ ].
+ ].
+ ].
+ ].
+
+ "/ after the script, if Screen has been opened and there are any open windows,
+ "/ then do not exit
false ifTrue:[
- Display notNil ifTrue:[
- Processor exitWhenNoMoreUserProcesses:true.
- "/ Display exitOnLastClose:true.
- "/ Display checkForEndOfDispatch.
- ] ifFalse:[
- self exit.
- ].
+ Display notNil ifTrue:[
+ Processor exitWhenNoMoreUserProcesses:true.
+ "/ Display exitOnLastClose:true.
+ "/ Display checkForEndOfDispatch.
+ ] ifFalse:[
+ self exit.
+ ].
].
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
-
- Processor dispatchLoop.
- self exit
- ].
-
- "look for a '-f filename' or '--file filename' argument
- if scripting, these are loaded before -P, -E or -R action.
- if not scripting, this will force evaluation of filename instead of smalltalk.rc"
- [
- idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
- (idxFileArg ~~ 0)
- ] whileTrue:[
- commandFiles isNil ifTrue:[ commandFiles := OrderedCollection new ].
- commandFiles add:(CommandLineArguments at:idxFileArg+1).
- CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
- ].
-
- "/ look for a '-E expr' or '--eval expr' argument (-P or --print to print the result of evaluation)
- "/ or -F/--filter or a '--repl' argument
- "/ E, P and F this will force evaluation of expr only, no standard startup
- "/ repl go into an interactive loop.
- idx := CommandLineArguments indexOfAny:#('-E' '--eval').
- (isEval := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-P' '--print').
- (isPrint := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-F' '--filter').
- (isFilter := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('-R' '--repl').
- (isRepl := (idx ~~ 0)) ifFalse:[
- idx := CommandLineArguments indexOfAny:#('--run').
- isRunMain := (idx ~~ 0)
- ].
- ].
- ].
- ].
-
- (isEval | isPrint | isFilter | isRepl | isRunMain) ifTrue:[
- |args|
-
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: eval/filter/print or repl') infoPrintCR.
- ].
- isRepl ifFalse:[
- CommandLineArguments size <= idx ifTrue:[
- StandAlone := true.
- self exitWithErrorMessage:'missing argument after -E/-P/-F/--run.'.
- ].
- isFilter ifTrue:[
- args := CommandLineArguments copyFrom:idx + 1.
- CommandLineArguments removeFromIndex:idx+1.
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: filter expression(s): ') infoPrint.
- args infoPrintCR.
- ].
- ] ifFalse:[
- arg := CommandLineArguments at:idx + 1.
- CommandLineArguments removeAtIndex:idx+1.
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: eval expression: ') infoPrint.
- arg infoPrintCR.
- ].
- ].
- ].
- CommandLineArguments removeAtIndex:idx.
-
- self startSchedulerAndBackgroundCollector.
-
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- Initializing := false.
-
- "/ set workspace variables
- self defineCommandLineAsWorkspaceVariablesForScripts.
-
- "/ all of the above allow for a -f file to be loaded before any other action
- (commandFiles notEmptyOrNil) ifTrue:[
- commandFiles do:[:commandFile |
- (VerboseStartup | VerboseLoading) ifTrue:[
- ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
- ].
- Smalltalk silentlyLoadingDo:[
- (self secureFileIn:commandFile) ifFalse:[
- StandAlone := true.
- self exitWithErrorMessage:('"', commandFile, '" not found.').
- ]
- ]
- ]
- ].
-
- isRepl ifFalse:[
- Debugging == true ifFalse:[
- "/ remove the Debugger
- Debugger := nil.
- ].
- ].
-
- process := [
- self providingDisplayDo:[
- isRepl ifTrue:[
- Processor exitWhenNoMoreUserProcesses:false.
- Processor activeProcess name:'repl'.
- self readEvalPrintLoop.
- self exit.
- ].
-
- Processor exitWhenNoMoreUserProcesses:true.
-
- NoHandlerError handle:[:ex |
- Debugging == true ifTrue:[
- MiniDebugger enterException:ex.
- ] ifFalse:[
- Silent ifFalse:[
- 'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
- ].
- (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
- ex suspendedContext fullPrintAll.
- ].
- self exit:1.
- ].
- self exit:1.
- "/ ex reject.
- ] do:[
- UserInterrupt handle:[:ex |
- Debugging == true ifTrue:[
- 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
- "/ thisContext fullPrintAll.
- MiniDebugger enterException:ex.
- ex proceed.
- ].
- Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
- self exit:128+(OperatingSystem sigINT).
- ] do:[
- |filterCode filterStart filterEnd|
-
- isFilter ifTrue:[
- "/ --filter - apply code to each input line.
- "/ compile code only once
- (args size == 1) ifTrue:[
- VerboseStartup ifTrue:[
- 'Smalltalk [info]: filter 1-arg' infoPrintCR.
- ].
- filterCode := args at:1.
- ] ifFalse:[
- (args size == 3) ifTrue:[
- VerboseStartup ifTrue:[
- 'Smalltalk [info]: filter 3-arg' infoPrintCR.
- ].
- filterStart := args at:1.
- filterCode := args at:2.
- filterEnd := args at:3.
- ] ifFalse:[
- StandAlone := true.
- self exitWithErrorMessage:'--filter must be followed by 1 or 3 expression arg(s)'
- ].
- ].
- filterStart notEmptyOrNil ifTrue:[
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: eval: "', filterStart, '"...') infoPrintCR.
- ].
- Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
- ].
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: compile: "', filterCode, '"...') infoPrintCR.
- ].
- Compiler
- compile:'doIt:line ',filterCode
- forClass:String
- notifying:(EvalScriptingErrorHandler new source:filterCode).
-
- [Stdin atEnd] whileFalse:[
- |line|
-
- line := Stdin nextLine.
- line doIt:line.
- ].
- filterEnd notEmptyOrNil ifTrue:[
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: eval: "', filterEnd, '"...') infoPrintCR.
- ].
- Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
- ].
- ] ifFalse:[
- (isPrint | isEval) ifTrue:[
- "/ --print or --eval
- |rslt|
-
- rslt := Parser new
- evaluate:arg
- notifying:(EvalScriptingErrorHandler new source:arg)
- compile:true.
- isPrint ifTrue:[
- rslt printCR.
- ].
- ] ifFalse:[
- "/ --run <className>
- |className class|
-
- className := arg.
- class := Smalltalk classNamed:className.
- class isNil ifTrue:[
- StandAlone := true.
- self exitWithErrorMessage:'no such class: "', className, '".'
- ].
- (class respondsTo:#main:) ifTrue:[
- class main:CommandLineArguments.
- ] ifFalse:[
- (class respondsTo:#main) ifTrue:[
- class main.
- ] ifFalse:[
- (class respondsTo:#start) ifTrue:[
- class start.
- ] ifFalse:[
- StandAlone := true.
- self exitWithErrorMessage:'class has no "main:", "main" or "start" method.'
- ].
- ].
- ].
- ].
- ].
- ].
- ].
- ].
-
- "/ after the script, if Screen has been opened and there are any open windows,
- "/ then do not exit
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+
+ Processor dispatchLoop.
+ self exit
+ ].
+
+ "look for a '-f filename' or '--file filename' argument
+ if scripting, these are loaded before -P, -E or -R action.
+ if not scripting, this will force evaluation of filename instead of smalltalk.rc"
+ [
+ idxFileArg := CommandLineArguments indexOfAny:#('-f' '--file').
+ (idxFileArg ~~ 0)
+ ] whileTrue:[
+ commandFiles isNil ifTrue:[ commandFiles := OrderedCollection new ].
+ commandFiles add:(CommandLineArguments at:idxFileArg+1).
+ CommandLineArguments removeAtIndex:idxFileArg+1; removeAtIndex:idxFileArg.
+ ].
+
+ "/ look for a '-E expr' or '--eval expr' argument (-P or --print to print the result of evaluation)
+ "/ or -F/--filter or a '--repl' argument
+ "/ E, P and F this will force evaluation of expr only, no standard startup
+ "/ repl go into an interactive loop.
+ idx := CommandLineArguments indexOfAny:#('-E' '--eval').
+ (isEval := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-P' '--print').
+ (isPrint := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-F' '--filter').
+ (isFilter := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('-R' '--repl').
+ (isRepl := (idx ~~ 0)) ifFalse:[
+ idx := CommandLineArguments indexOfAny:#('--run').
+ isRunMain := (idx ~~ 0)
+ ].
+ ].
+ ].
+ ].
+
+ (isEval | isPrint | isFilter | isRepl | isRunMain) ifTrue:[
+ |args|
+
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval/filter/print or repl') infoPrintCR.
+ ].
+ isRepl ifFalse:[
+ CommandLineArguments size <= idx ifTrue:[
+ StandAlone := true.
+ self exitWithErrorMessage:'missing argument after -E/-P/-F/--run.'.
+ ].
+ isFilter ifTrue:[
+ args := CommandLineArguments copyFrom:idx + 1.
+ CommandLineArguments removeFromIndex:idx+1.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: filter expression(s): ') infoPrint.
+ args infoPrintCR.
+ ].
+ ] ifFalse:[
+ arg := CommandLineArguments at:idx + 1.
+ CommandLineArguments removeAtIndex:idx+1.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval expression: ') infoPrint.
+ arg infoPrintCR.
+ ].
+ ].
+ ].
+ CommandLineArguments removeAtIndex:idx.
+
+ self startSchedulerAndBackgroundCollector.
+
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ Initializing := false.
+
+ "/ set workspace variables
+ self defineCommandLineAsWorkspaceVariablesForScripts.
+
+ "/ all of the above allow for a -f file to be loaded before any other action
+ (commandFiles notEmptyOrNil) ifTrue:[
+ commandFiles do:[:commandFile |
+ (VerboseStartup | VerboseLoading) ifTrue:[
+ ('Smalltalk [info]: reading command file from: "', commandFile, '".') infoPrintCR.
+ ].
+ Smalltalk silentlyLoadingDo:[
+ (self secureFileIn:commandFile) ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:('"', commandFile, '" not found.').
+ ]
+ ]
+ ]
+ ].
+
+ isRepl ifFalse:[
+ Debugging == true ifFalse:[
+ "/ remove the Debugger
+ Debugger := nil.
+ ].
+ ].
+
+ process := [
+ self providingDisplayDo:[
+ isRepl ifTrue:[
+ Processor exitWhenNoMoreUserProcesses:false.
+ Processor activeProcess name:'repl'.
+ self readEvalPrintLoop.
+ self exit.
+ ].
+
+ Processor exitWhenNoMoreUserProcesses:true.
+
+ NoHandlerError handle:[:ex |
+ Debugging == true ifTrue:[
+ MiniDebugger enterException:ex.
+ ] ifFalse:[
+ Silent ifFalse:[
+ 'Smalltalk [error]: ' _errorPrint. ex description _errorPrintCR.
+ ].
+ (VerboseStartup or:[ObjectMemory debugPrinting]) ifTrue:[
+ ex suspendedContext fullPrintAll.
+ ].
+ self exit:1.
+ ].
+ self exit:1.
+ "/ ex reject.
+ ] do:[
+ UserInterrupt handle:[:ex |
+ Debugging == true ifTrue:[
+ 'user interrupt (type "c" to continue; "x" to exit; "?" for help).' errorPrintCR.
+ "/ thisContext fullPrintAll.
+ MiniDebugger enterException:ex.
+ ex proceed.
+ ].
+ Silent ifFalse:[ 'user interrupt.' errorPrintCR ].
+ self exit:128+(OperatingSystem sigINT).
+ ] do:[
+ |filterCode filterStart filterEnd|
+
+ isFilter ifTrue:[
+ "/ --filter - apply code to each input line.
+ "/ compile code only once
+ (args size == 1) ifTrue:[
+ VerboseStartup ifTrue:[
+ 'Smalltalk [info]: filter 1-arg' infoPrintCR.
+ ].
+ filterCode := args at:1.
+ ] ifFalse:[
+ (args size == 3) ifTrue:[
+ VerboseStartup ifTrue:[
+ 'Smalltalk [info]: filter 3-arg' infoPrintCR.
+ ].
+ filterStart := args at:1.
+ filterCode := args at:2.
+ filterEnd := args at:3.
+ ] ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:'--filter must be followed by 1 or 3 expression arg(s)'
+ ].
+ ].
+ filterStart notEmptyOrNil ifTrue:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval: "', filterStart, '"...') infoPrintCR.
+ ].
+ Compiler evaluate:filterStart notifying:(EvalScriptingErrorHandler new source:filterStart)
+ ].
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: compile: "', filterCode, '"...') infoPrintCR.
+ ].
+ Compiler
+ compile:'doIt:line ',filterCode
+ forClass:String
+ notifying:(EvalScriptingErrorHandler new source:filterCode).
+
+ [Stdin atEnd] whileFalse:[
+ |line|
+
+ line := Stdin nextLine.
+ line doIt:line.
+ ].
+ filterEnd notEmptyOrNil ifTrue:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: eval: "', filterEnd, '"...') infoPrintCR.
+ ].
+ Compiler evaluate:filterEnd notifying:(EvalScriptingErrorHandler new source:filterEnd)
+ ].
+ ] ifFalse:[
+ (isPrint | isEval) ifTrue:[
+ "/ --print or --eval
+ |rslt|
+
+ rslt := Parser new
+ evaluate:arg
+ notifying:(EvalScriptingErrorHandler new source:arg)
+ compile:true.
+ isPrint ifTrue:[
+ rslt printCR.
+ ].
+ ] ifFalse:[
+ "/ --run <className>
+ |className class|
+
+ className := arg.
+ class := Smalltalk classNamed:className.
+ class isNil ifTrue:[
+ StandAlone := true.
+ self exitWithErrorMessage:'no such class: "', className, '".'
+ ].
+ (class respondsTo:#main:) ifTrue:[
+ class main:CommandLineArguments.
+ ] ifFalse:[
+ (class respondsTo:#main) ifTrue:[
+ class main.
+ ] ifFalse:[
+ (class respondsTo:#start) ifTrue:[
+ class start.
+ ] ifFalse:[
+ StandAlone := true.
+ self exitWithErrorMessage:'class has no "main:", "main" or "start" method.'
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "/ after the script, if Screen has been opened and there are any open windows,
+ "/ then do not exit
false ifTrue:[
- Display notNil ifTrue:[
- Processor exitWhenNoMoreUserProcesses:true.
- "/ Display exitOnLastClose:true.
- "/ Display checkForEndOfDispatch.
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: display opened.') infoPrintCR.
- ].
- ] ifFalse:[
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: no display - exit after script.') infoPrintCR.
- ].
- self exit.
- ].
+ Display notNil ifTrue:[
+ Processor exitWhenNoMoreUserProcesses:true.
+ "/ Display exitOnLastClose:true.
+ "/ Display checkForEndOfDispatch.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: display opened.') infoPrintCR.
+ ].
+ ] ifFalse:[
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: no display - exit after script.') infoPrintCR.
+ ].
+ self exit.
+ ].
].
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: script/repl/eval finished.') infoPrintCR.
- ].
-
- ] newProcess.
- process priority:(Processor userSchedulingPriority).
- process name:'main'.
- process beGroupLeader.
- process resume.
-
- Processor dispatchLoop.
- VerboseStartup ifTrue:[
- ('Smalltalk [info]: exit normally.') infoPrintCR.
- ].
- self exit
- ].
- ].
-
- commandFiles notNil ifTrue:[
- SilentLoading := true. "/ suppress the hello & copyright messages
- self addStartBlock:
- [
- commandFiles do:[:commandFile |
- (self secureFileIn:commandFile) ifFalse:[
- self exitWithErrorMessage:('startup file "', commandFile, '" not found.').
- ].
- ].
- ].
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: script/repl/eval finished.') infoPrintCR.
+ ].
+
+ ] newProcess.
+ process priority:(Processor userSchedulingPriority).
+ process name:'main'.
+ process beGroupLeader.
+ process resume.
+
+ Processor dispatchLoop.
+ VerboseStartup ifTrue:[
+ ('Smalltalk [info]: exit normally.') infoPrintCR.
+ ].
+ self exit
+ ].
+ ].
+
+ commandFiles notNil ifTrue:[
+ SilentLoading := true. "/ suppress the hello & copyright messages
+ self addStartBlock:
+ [
+ commandFiles do:[:commandFile |
+ (self secureFileIn:commandFile) ifFalse:[
+ self exitWithErrorMessage:('startup file "', commandFile, '" not found.').
+ ].
+ ].
+ ].
"/ self startSchedulerAndBackgroundCollector.
"/ keepSplashWindow ifFalse:[ self hideSplashWindow ].
@@ -4945,67 +4951,67 @@
"/ ('Smalltalk [error]: startup file "', commandFile, '" not found.') errorPrintCR.
"/ OperatingSystem exit:1.
"/ ].
- ] ifFalse:[
- "/ look for <command>.rc
- "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
-
- rcFile := self commandName asFilename withSuffix:'rc'.
- (didReadRCFile := rcFile exists and:[self secureFileIn:rcFile]) ifFalse:[
- StandAlone ifFalse:[
- defaultRC := 'smalltalk.rc' "/asFilename
- ] ifTrue:[
- defaultRC := 'stxapp.rc' "/asFilename
- ].
- "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
- to be started with different working directory than stx/projects/smalltalk !!!!!!"
-
- "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
- didReadRCFile := (self getSystemFileName:defaultRC) notNil
- and:[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.
-
- keepSplashWindow ifFalse:[ self hideSplashWindow ].
- didReadRCFile ifFalse:[
- 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
-
- "/
- "/ 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.
- ].
-
- "/ setup more defaults...
+ ] ifFalse:[
+ "/ look for <command>.rc
+ "/ if not found, read smalltalk.rc (or stxapp.rc for standAlone operation)
+
+ rcFile := self commandName asFilename withSuffix:'rc'.
+ (didReadRCFile := rcFile exists and:[self secureFileIn:rcFile]) ifFalse:[
+ StandAlone ifFalse:[
+ defaultRC := 'smalltalk.rc' "/asFilename
+ ] ifTrue:[
+ defaultRC := 'stxapp.rc' "/asFilename
+ ].
+ "JV@2011-11-01: DO NOT check defaultRC exist - this prevents smalltalk to
+ to be started with different working directory than stx/projects/smalltalk !!!!!!"
+
+ "/didReadRCFile := defaultRC exists and:[self secureFileIn:defaultRC].
+ didReadRCFile := (self getSystemFileName:defaultRC) notNil
+ and:[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.
+
+ keepSplashWindow ifFalse:[ self hideSplashWindow ].
+ didReadRCFile ifFalse:[
+ 'private.rc' asFilename exists ifTrue:[ self secureFileIn:'private.rc' ].
+
+ "/
+ "/ 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.
+ ].
+
+ "/ setup more defaults...
"/ ObjectMemory startBackgroundCollectorAt:5.
"/ ObjectMemory startBackgroundFinalizationAt:5.
- self addStartBlock:[
- self startSchedulerAndBackgroundCollector
- ].
- ].
- ].
- (CommandLineArguments includes:'--scripting') ifTrue:[
- self addStartBlock:[
- StandaloneStartup handleScriptingOptionsFromArguments:CommandLineArguments.
- ].
- ].
+ self addStartBlock:[
+ self startSchedulerAndBackgroundCollector
+ ].
+ ].
+ ].
+ (CommandLineArguments includes:'--scripting') ifTrue:[
+ self addStartBlock:[
+ StandaloneStartup handleScriptingOptionsFromArguments:CommandLineArguments.
+ ].
+ ].
].
HeadlessOperation ifTrue:[
- graphicalMode := false.
+ graphicalMode := false.
].
keepSplashWindow ifFalse:[ self hideSplashWindow ].
@@ -5132,9 +5138,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
+ ]
].
Display notNil ifTrue:[ Display closeConnection ].
@@ -5170,10 +5176,10 @@
"{ Pragma: +optSpace }"
Smalltalk isStandAloneApp ifTrue:[
- self exit:statusInteger
+ self exit:statusInteger
] ifFalse:[
- self warn:'Application asks Smalltalk to exit (this is suppressed in IDE).'.
- AbortOperationRequest raise.
+ self warn:'Application asks Smalltalk to exit (this is suppressed in IDE).'.
+ AbortOperationRequest raise.
]
"
@@ -5190,7 +5196,7 @@
your development system."
self isStandAloneApp ifTrue:[
- self exit:exitCode.
+ self exit:exitCode.
].
self error:'standalone smalltalk would exit here with exit code: ', exitCode printString.
@@ -5481,8 +5487,8 @@
"set the language - send out change notifications"
aLanguageSymbol ~= Language ifTrue:[
- Language := aLanguageSymbol asSymbol.
- self changed:#Language
+ Language := aLanguageSymbol asSymbol.
+ self changed:#Language
].
"
@@ -5497,9 +5503,9 @@
"set the language & territory - send out change notifications"
((Language ~= aLanguageSymbol) or:[ LanguageTerritory ~= aTerritorySymbol]) ifTrue:[
- Language := aLanguageSymbol asSymbol.
- LanguageTerritory := aTerritorySymbol asSymbol.
- self changed:#Language
+ Language := aLanguageSymbol asSymbol.
+ LanguageTerritory := aTerritorySymbol asSymbol.
+ self changed:#Language
].
"
@@ -5540,10 +5546,10 @@
"set the language territory - send out change notifications"
aTerritorySymbol ~= LanguageTerritory ifTrue:[
- LanguageTerritory := aTerritorySymbol asSymbol.
- self changed:#LanguageTerritory
- ].
-
+ LanguageTerritory := aTerritorySymbol asSymbol.
+ self changed:#LanguageTerritory
+ ].
+
"
Time now
@@ -5596,26 +5602,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 position + 1.
- 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 position + 1.
+ 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 syncData; close.
@@ -5630,7 +5636,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -5658,18 +5664,18 @@
table := IdentityDictionary new:100.
Method allSubInstancesDo:[:aMethod |
- source := aMethod source.
- source notNil ifTrue:[
- pos := newStream position + 1.
- newStream nextChunkPut:source.
-
- "
- don't change the method's 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 position + 1.
+ newStream nextChunkPut:source.
+
+ "
+ don't change the method's info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
].
newStream syncData; close.
@@ -5684,7 +5690,7 @@
source reference"
table keysAndValuesDo:[:aMethod :pos |
- aMethod localSourceFilename:fileName position:pos.
+ aMethod localSourceFilename:fileName position:pos.
"/ aMethod printCR.
].
@@ -5829,16 +5835,16 @@
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"].
]
"
@@ -5851,13 +5857,13 @@
installAutoloadedClassesFromAbbrevFile:aFilename
aFilename readingFileDo:[:abbrevStream |
- self installAutoloadedClassesFromStream:abbrevStream.
+ self installAutoloadedClassesFromStream:abbrevStream.
]
"
self installAutoloadedClassesFromAbbrevFile:('../../goodies/communication/abbrev.stc' asFilename)
"
-
+
"Created: / 29-07-2011 / 20:39:21 / cg"
!
@@ -5870,71 +5876,71 @@
|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.
].
"/ yes, create any required nameSpace, without asking user.
Class createNameSpaceQuerySignal answer:true do:[
- [anAbbrevFileStream atEnd] whileFalse:[
- l := anAbbrevFileStream nextLine withoutSeparators.
- "Skip empty lines and comments"
- (l notEmpty and:[l first ~= $#]) ifTrue:[
- "/ must do it manually, caring for quoted strings.
+ [anAbbrevFileStream atEnd] whileFalse:[
+ l := anAbbrevFileStream nextLine withoutSeparators.
+ "Skip empty lines and comments"
+ (l notEmpty and:[l first ~= $#]) 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].
-
- (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.
+ 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].
+
+ (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.
"/ ].
- ]
- ]
- ]
+ ]
+ ]
+ ]
]
!
@@ -5996,19 +6002,19 @@
Experimental and not yet used."
Method allSubInstancesDo:[:aMethod |
- |newMethod|
-
- aMethod hasPrimitiveCode ifFalse:[
+ |newMethod|
+
+ aMethod hasPrimitiveCode ifFalse:[
"/ aMethod errorPrintCR.
- newMethod := aMethod asByteCodeMethod.
- newMethod ~~ aMethod ifTrue:[
- newMethod isNil ifTrue:[
- 'Smalltalk>>makeBytecodeMethods could nor recompile: ' errorPrint. aMethod errorPrintCR.
- ] ifFalse:[
- aMethod becomeSameAs:newMethod
- ].
- ]
- ].
+ newMethod := aMethod asByteCodeMethod.
+ newMethod ~~ aMethod ifTrue:[
+ newMethod isNil ifTrue:[
+ 'Smalltalk>>makeBytecodeMethods could nor recompile: ' errorPrint. aMethod errorPrintCR.
+ ] ifFalse:[
+ aMethod becomeSameAs:newMethod
+ ].
+ ]
+ ].
].
"
@@ -6028,12 +6034,12 @@
dirsConsulted := Set new.
self
- recursiveInstallAutoloadedClassesFrom:aTopDirectory
- rememberIn:dirsConsulted
- maxLevels:15
- noAutoload:false
- packageTop:nil
- showSplashInLevels:-1.
+ recursiveInstallAutoloadedClassesFrom:aTopDirectory
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:nil
+ showSplashInLevels:-1.
"
@@ -6085,36 +6091,36 @@
dirName := dir physicalPathName. "take care of symbolic links"
(dirsConsulted includes:dirName) ifTrue:[
- ^ self
+ ^ self
].
(dir / 'NOPACKAGES') exists ifTrue:[
- ^ self.
+ ^ self.
].
(dir / 'NOSUBAUTOLOAD') exists ifTrue:[
- ^ self.
+ ^ self.
].
maxLevels == 0 ifTrue:[
- Transcript showCR:('Autoload: max directory nesting reached in %1' bindWith:dir pathName).
- ^ self
+ Transcript showCR:('Autoload: max directory nesting reached in %1' bindWith:dir pathName).
+ ^ self
].
dirsConsulted add:dirName.
noAutoloadHere := noAutoloadIn.
noAutoloadHere ifFalse:[
- (dir / 'NOAUTOLOAD') exists ifTrue:[
- noAutoloadHere := true.
- ].
+ (dir / 'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
] ifTrue:[
- (dir / 'AUTOLOAD') exists ifTrue:[
- noAutoloadHere := false.
- ].
+ (dir / 'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"/
@@ -6123,74 +6129,74 @@
"/
haveAbbrevDotSTC := false.
noAutoloadHere ifFalse:[
- [
- self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
- haveAbbrevDotSTC := true.
- ] on:FileStream openErrorSignal
- do:[:ex|
- "ignore this file"
- ].
+ [
+ self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
+ haveAbbrevDotSTC := true.
+ ] on:FileStream openErrorSignal
+ do:[:ex|
+ "ignore this file"
+ ].
].
[
- directoryContents := dir directoryContents.
+ directoryContents := dir directoryContents.
] on:FileStream openErrorSignal do:[:ex|
- "non-accessible directory: we are done"
- ^ self
+ "non-accessible directory: we are done"
+ ^ self
].
directoryContents := directoryContents select:[:fn | (fn startsWith:'.') not] as:Set.
directoryContents removeAllFoundIn:#(
- 'objbc' 'objvc' 'objmingw'
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- 'not_delivered'
- 'not_ported'
- ).
+ 'objbc' 'objvc' 'objmingw'
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ 'not_delivered'
+ 'not_ported'
+ ).
dir baseName = 'stx' ifTrue:[
- directoryContents removeAllFoundIn:#(
- 'configurations'
- 'include'
- 'rules'
- 'stc'
- 'support'
- ).
+ directoryContents removeAllFoundIn:#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ).
].
directoryContents do:[:eachFilenameString |
- |f|
-
- f := dir / eachFilenameString.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath
- showSplashInLevels:showSplashInLevels - 1.
- ] ifFalse:[
- (noAutoloadHere not and:[haveAbbrevDotSTC not]) ifTrue:[
- f suffix = 'st' ifTrue:[
- [
- self installAutoloadedClassFromSourceFile:f.
- f directory baseName = 'libbasic' ifTrue:[self halt].
- ] on:FileStream openErrorSignal do:[:ex|
- "ignore this file, but write a warning"
- Transcript showCR:('Autoload: cannot install %1. (%2)' bindWith:f pathName with:ex description).
- ].
- ]
- ].
- ]
+ |f|
+
+ f := dir / eachFilenameString.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath
+ showSplashInLevels:showSplashInLevels - 1.
+ ] ifFalse:[
+ (noAutoloadHere not and:[haveAbbrevDotSTC not]) ifTrue:[
+ f suffix = 'st' ifTrue:[
+ [
+ self installAutoloadedClassFromSourceFile:f.
+ f directory baseName = 'libbasic' ifTrue:[self halt].
+ ] on:FileStream openErrorSignal do:[:ex|
+ "ignore this file, but write a warning"
+ Transcript showCR:('Autoload: cannot install %1. (%2)' bindWith:f pathName with:ex description).
+ ].
+ ]
+ ].
+ ]
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"
@@ -6333,10 +6339,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 inStream path morePath bos|
@@ -6347,41 +6353,41 @@
"
(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
].
inStream := self systemFileStreamFor:fileNameString.
inStream isNil ifTrue:[^ false].
(aFileNameOrString asFilename hasSuffix:'cls') ifTrue:[
- BinaryObjectStorage isNil ifTrue:[
- ^ false.
- ].
- [
- inStream binary.
- bos := BinaryObjectStorage onOld:inStream.
- bos next.
- ] ensure:[
- bos close.
- ].
- ^ true
+ BinaryObjectStorage isNil ifTrue:[
+ ^ false.
+ ].
+ [
+ inStream binary.
+ bos := BinaryObjectStorage onOld:inStream.
+ bos next.
+ ] ensure:[
+ bos close.
+ ].
+ ^ true
].
(fileNameString includes:$/) ifTrue:[
- "/ temporarily prepend the file's 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 := inStream fileName directoryName.
+ "/ temporarily prepend the file's 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 := inStream fileName directoryName.
].
^ self fileInStream:inStream lazy:lazy silent:silent logged:logged addPath:morePath
@@ -6526,11 +6532,11 @@
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"
!
@@ -6567,315 +6573,315 @@
ClassLoadInProgressQuery answerNotifyLoading:aClassName do:[
- wasLazy := Compiler compileLazy:loadLazy.
- beSilent notNil ifTrue:[
- 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
- ].
- ].
-
- classFileName asFilename isAbsolute ifTrue:[
- classFileName asFilename suffix notEmptyOrNil ifTrue:[
- ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
- ] ifFalse:[
- ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
- ]
- ] ifFalse:[
- classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName.
- [
- Class withoutUpdatingChangesDo:[
- |zarFn zar entry|
-
- ok := false.
-
- package notNil ifTrue:[
- packageDir := package asPackageId packageDirectory.
- "/ packageDir := package asString.
- "/ packageDir := packageDir copyReplaceAll:$: with:$/.
- packageDir isNil ifTrue:[
- packageDir := self packageDirectoryForPackageId:package
- ].
- packageDir notNil ifTrue:[
- packageDir := packageDir asFilename.
- ].
- ].
-
- 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:(classFileName, sharedLibExtension))
- ifFalse:[
- sharedLibExtension ~= '.o' ifTrue:[
- ok := self fileInClass:aClassName fromObject:(classFileName, '.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:(classFileName , '.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' / classFileName) addSuffix:'cls').
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'.
- ].
- (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
- packageFile isNil ifTrue:[
- packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'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:(classFileName , '.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:[
- filenameToSet := classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source' asFilename / classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source' asFilename / alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet 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 getPackageSourceFileName:(packageDir / 'source' / classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'source' / classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / 'source' / alternativeClassFileName).
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- packageFile := self getPackageSourceFileName:(packageDir / classFileName).
- packageFile isNil ifTrue:[
- packageFile := (packageDir / classFileName).
- ].
- filenameToSet := packageFile.
- (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- packageFile := self getPackageFileName:(packageDir / alternativeClassFileName).
- packageFile isNil ifTrue:[
- packageFile := packageDir / alternativeClassFileName.
- ].
- filenameToSet := packageFile.
- ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
- ].
- ok ifFalse:[
- "
- ... and in the standard source-directory
- "
- filenameToSet := 'source' asFilename / packageDir / classFileName.
- (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
- ifFalse:[
- alternativeClassFileName notNil ifTrue:[
- filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName.
- ok := self fileInSourceFile:filenameToSet 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 withSuffix:'zip'.
- zarFn := self getSourceFileName:zarFn.
- ].
- (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
- zar := ZipArchive oldFileNamed:zarFn.
- zar notNil ifTrue:[
- entry := zar extract:(classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := 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 := classFileName , '.st').
- (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
- entry := zar extract:(zarFn := alternativeClassFileName , '.st').
- ].
- entry notNil ifTrue:[
- filenameToSet := 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 inPackage:package.
- inStream notNil ifTrue:[
- filenameToSet := 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:[
- "set the classes name - but do not change if already set"
- filenameToSet notNil ifTrue:[
- newClass getClassFilename isNil ifTrue:[
- newClass setClassFilename:(filenameToSet asFilename baseName)
- ].
- ].
-
- doInit ifTrue:[
- newClass initialize
- ]
- ]
- ].
+ wasLazy := Compiler compileLazy:loadLazy.
+ beSilent notNil ifTrue:[
+ 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
+ ].
+ ].
+
+ classFileName asFilename isAbsolute ifTrue:[
+ classFileName asFilename suffix notEmptyOrNil ifTrue:[
+ ok := self fileIn:classFileName lazy:loadLazy silent:beSilent.
+ ] ifFalse:[
+ ok := self fileInSourceFile:classFileName lazy:loadLazy silent:beSilent.
+ ]
+ ] ifFalse:[
+ classFileName := classFileName copyReplaceAll:$: with:$_ ifNone:classFileName.
+ [
+ Class withoutUpdatingChangesDo:[
+ |zarFn zar entry|
+
+ ok := false.
+
+ package notNil ifTrue:[
+ packageDir := package asPackageId packageDirectory.
+ "/ packageDir := package asString.
+ "/ packageDir := packageDir copyReplaceAll:$: with:$/.
+ packageDir isNil ifTrue:[
+ packageDir := self packageDirectoryForPackageId:package
+ ].
+ packageDir notNil ifTrue:[
+ packageDir := packageDir asFilename.
+ ].
+ ].
+
+ 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:(classFileName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(classFileName, '.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:(classFileName , '.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' / classFileName) addSuffix:'cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'classes' / classFileName) addSuffix:'cls'.
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:((packageDir / 'classes' / alternativeClassFileName) addSuffix:'cls').
+ packageFile isNil ifTrue:[
+ packageFile := ((packageDir / 'classes' / alternativeClassFileName) addSuffix:'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:(classFileName , '.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:[
+ filenameToSet := classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source' asFilename / classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source' asFilename / alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet 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 getPackageSourceFileName:(packageDir / 'source' / classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'source' / classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageSourceFileName:(packageDir / 'source' / alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / 'source' / alternativeClassFileName).
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ packageFile := self getPackageSourceFileName:(packageDir / classFileName).
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir / classFileName).
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir / alternativeClassFileName).
+ packageFile isNil ifTrue:[
+ packageFile := packageDir / alternativeClassFileName.
+ ].
+ filenameToSet := packageFile.
+ ok := self fileInSourceFile:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source' asFilename / packageDir / classFileName.
+ (ok := self fileInSourceFile:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source' asFilename / packageDir / alternativeClassFileName.
+ ok := self fileInSourceFile:filenameToSet 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 withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ (zarFn notNil and:[zarFn asFilename exists]) ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := 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 := classFileName , '.st').
+ (entry isNil and:[alternativeClassFileName notNil]) ifTrue:[
+ entry := zar extract:(zarFn := alternativeClassFileName , '.st').
+ ].
+ entry notNil ifTrue:[
+ filenameToSet := 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 inPackage:package.
+ inStream notNil ifTrue:[
+ filenameToSet := 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:[
+ "set the classes name - but do not change if already set"
+ filenameToSet notNil ifTrue:[
+ newClass getClassFilename isNil ifTrue:[
+ newClass setClassFilename:(filenameToSet asFilename baseName)
+ ].
+ ].
+
+ doInit ifTrue:[
+ newClass initialize
+ ]
+ ]
+ ].
].
^ newClass
@@ -7002,11 +7008,11 @@
"/ ].
"/ revert to old code to get stuff running again- please review - (autoload problems)
ProgrammingLanguage allDo:[:lang| | f |
- f := (filename hasSuffix:lang sourceFileSuffix)
- ifTrue:[filename]
- ifFalse:[filename addSuffix:lang sourceFileSuffix].
- (self fileIn:f lazy:loadLazy silent:beSilent)
- ifTrue:[^ true]
+ f := (filename hasSuffix:lang sourceFileSuffix)
+ ifTrue:[filename]
+ ifFalse:[filename addSuffix:lang sourceFileSuffix].
+ (self fileIn:f lazy:loadLazy silent:beSilent)
+ ifTrue:[^ true]
].
^ false
@@ -7037,44 +7043,44 @@
inStream := streamArg.
inStream isNil ifTrue:[^ false].
inStream isLineNumberReadStream ifFalse:[
- LineNumberReadStream notNil ifTrue:[
- "/ sigh - is in libbasic2, which is not always present
- inStream := LineNumberReadStream on:inStream.
- ].
+ LineNumberReadStream notNil ifTrue:[
+ "/ sigh - is in libbasic2, which is not always present
+ inStream := LineNumberReadStream on:inStream.
+ ].
].
inStream := EncodedStream decodedStreamFor:inStream.
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:[
- "JV: Changed to give ProgrammingLanguage to choose
- proper reader"
- ((ProgrammingLanguage forStream: inStream) fileInStream: inStream) ~~ #Error
- ]
+ (Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
+ "JV: Changed to give ProgrammingLanguage to choose
+ proper reader"
+ ((ProgrammingLanguage forStream: inStream) fileInStream: inStream) ~~ #Error
+ ]
] 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
].
"
@@ -7136,15 +7142,15 @@
Return true if ok, false if failed"
Parser isNil ifTrue:[
- ^ false "/ for small stand alone apps.
- ].
+ ^ false "/ for small stand alone apps.
+ ].
^ (SignalSet
- with:AbortOperationRequest
- with:TerminateProcessRequest
- with:ParseError)
- handle:[:ex | ex return:false ]
- do:[ self fileIn:aFileName ].
+ with:AbortOperationRequest
+ with:TerminateProcessRequest
+ with:ParseError)
+ handle:[:ex | ex return:false ]
+ do:[ self fileIn:aFileName ].
"Modified: / 23-04-2018 / 16:53:29 / stefan"
!
@@ -7154,7 +7160,7 @@
Main use is during startup."
^ self silentlyLoadingDo:[
- self fileIn:aFilename
+ self fileIn:aFilename
].
"Modified: / 23-04-2018 / 16:57:17 / stefan"
@@ -7166,29 +7172,29 @@
"{ Pragma: +optSpace }"
|topDirectory|
-
+
(topDirectory := OperatingSystem pathOfSTXExecutable) notNil ifTrue:[
- topDirectory := topDirectory asFilename.
- (topDirectory directory / 'stc') exists ifTrue:[
- topDirectory := topDirectory directory.
- ] ifFalse:[
- (topDirectory directory directory / 'stc') exists ifTrue:[
- topDirectory := topDirectory directory directory.
- ] ifFalse:[
- (topDirectory directory directory directory / 'stc') exists ifTrue:[
- topDirectory := topDirectory directory directory directory.
- ] ifFalse:[
- topDirectory := nil
- ].
- ].
- ].
- topDirectory notNil ifTrue:[
- "/ one above "stx"
- topDirectory := topDirectory directory pathName.
- (PackagePath includes:topDirectory) ifFalse:[
- PackagePath add:topDirectory
- ]
- ]
+ topDirectory := topDirectory asFilename.
+ (topDirectory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory.
+ ] ifFalse:[
+ (topDirectory directory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory directory.
+ ] ifFalse:[
+ (topDirectory directory directory directory / 'stc') exists ifTrue:[
+ topDirectory := topDirectory directory directory directory.
+ ] ifFalse:[
+ topDirectory := nil
+ ].
+ ].
+ ].
+ topDirectory notNil ifTrue:[
+ "/ one above "stx"
+ topDirectory := topDirectory directory pathName.
+ (PackagePath includes:topDirectory) ifFalse:[
+ PackagePath add:topDirectory
+ ]
+ ]
].
!
@@ -7196,14 +7202,14 @@
"{ Pragma: +optSpace }"
|workspaceDirectory|
-
+
(workspaceDirectory := UserPreferences current workspaceDirectory) notNil ifTrue:[
- (workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
- workspaceDirectory := workspaceDirectory pathName.
- (PackagePath includes:workspaceDirectory) ifFalse:[
- PackagePath addFirst:workspaceDirectory
- ]
- ]
+ (workspaceDirectory := workspaceDirectory asFilename) exists ifTrue:[
+ workspaceDirectory := workspaceDirectory pathName.
+ (PackagePath includes:workspaceDirectory) ifFalse:[
+ PackagePath addFirst:workspaceDirectory
+ ]
+ ]
].
!
@@ -7280,11 +7286,11 @@
return a collection of paths 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]
].
!
@@ -7590,22 +7596,22 @@
packageSubDirectory := packageId directory.
checkForPackageDirectory :=
- [:moduleDir |
- |packageDir|
-
- moduleDir isDirectory ifTrue:[
- packageDir := moduleDir / packageSubDirectory.
- packageDir isDirectory ifTrue:[
- ^ packageDir
- ]
- ].
- ].
+ [:moduleDir |
+ |packageDir|
+
+ moduleDir isDirectory ifTrue:[
+ packageDir := moduleDir / packageSubDirectory.
+ packageDir isDirectory ifTrue:[
+ ^ packageDir
+ ]
+ ].
+ ].
self packagePath do:[:aPath |
- |moduleDir|
-
- moduleDir := aPath asFilename / module.
- checkForPackageDirectory value:moduleDir.
+ |moduleDir|
+
+ moduleDir := aPath asFilename / module.
+ checkForPackageDirectory value:moduleDir.
].
^ nil
@@ -7824,23 +7830,23 @@
fn := aFileNameOrString asFilename.
nameString := fn name.
fn isAbsolute ifTrue:[
- "don't use path for absolute file names"
-
- ^ nameString
+ "don't use path for absolute file names"
+
+ ^ nameString
].
self realSystemPath do:[:dirName |
- |realName|
-
- realName := dirName asFilename / nameString.
- "/
- "/ here, we also return true if it's 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 / nameString.
+ "/
+ "/ here, we also return true if it's a directory
+ "/ (Even if unreadable).
+ "/ It could be that the file itself is still readable.
+ "/
+ (realName isDirectory or:[realName isReadable]) ifTrue: [
+ ^ realName name
+ ]
].
^ nil
@@ -8125,40 +8131,40 @@
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
dir exists ifFalse:[^ self].
[
- abbrevStream := (dir / 'abbrev.stc') asFilename readStream.
- self readAbbreviationsFromStream:abbrevStream.
- abbrevStream close.
+ abbrevStream := (dir / '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-accessible directory: we are done"
- ^ self
+ "non-accessible directory: we are done"
+ ^ self
].
directoryContents do:[:aFilename |
- |f|
-
- (#(
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- ) includes:aFilename) ifFalse:[
- f := dir / aFilename.
- f isDirectory ifTrue:[
- self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
- ]
- ].
+ |f|
+
+ (#(
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ ) includes:aFilename) ifFalse:[
+ f := dir / aFilename.
+ f isDirectory ifTrue:[
+ self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
+ ]
+ ].
].
!
@@ -8166,10 +8172,10 @@
"{ Pragma: +optSpace }"
PackagePath notNil ifTrue:[
- PackagePath := PackagePath select:[:p | p asFilename exists].
+ PackagePath := PackagePath select:[:p | p asFilename exists].
].
PackagePath isEmptyOrNil ifTrue:[
- PackagePath := OperatingSystem defaultPackagePath
+ PackagePath := OperatingSystem defaultPackagePath
].
self addWorkspaceDirectoryToPackagePath.
!
@@ -8252,26 +8258,26 @@
((f := aFileName asFilename) isAbsolute
or:[f isExplicitRelative]) ifTrue:[
- "/
- "/ don't use path for absolute or explicit .-relative file names
- "/
- ^ aFileName
+ "/
+ "/ don't 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 / aDirName / aFileName.
- ] ifFalse:[
- realName := dir / aFileName.
- ].
- (realName isReadable) ifTrue:[
- ^ realName name
- ]
- ].
+ aPath do:[:dirName |
+ |realName dir|
+
+ dir := dirName asFilename.
+ aDirName notNil ifTrue:[
+ realName := dir / aDirName / aFileName.
+ ] ifFalse:[
+ realName := dir / aFileName.
+ ].
+ (realName isReadable) ifTrue:[
+ ^ realName name
+ ]
+ ].
].
"/ not needed - executing dir is always in SearchPath
@@ -8530,61 +8536,61 @@
"enumerate loadable packages from the packages folder."
Smalltalk realSystemPath do:[:dirName |
- |packageDir|
-
- packageDir := dirName asFilename / 'packages'.
- (packageDir exists and:[packageDir isDirectory]) ifTrue:[
- packageDir directoryContentsAsFilenames sort do:[:fn |
- |item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded
- defClass target type nameComponents packageName packageID|
-
- ((fn suffix = 'mcz')
- or:[ fn isDirectory
- or:[ (fn baseName startsWith:'.')
- or:[ (fn baseName = 'README') ]]]) ifFalse:[
- base := fn withoutSuffix baseName.
- (base startsWith:'lib') ifTrue:[
- nm := (base copyFrom:4).
- fn suffix notEmptyOrNil ifTrue:[
- type := #library.
- ] ifFalse:[
- type := #application.
- ]
- ] ifFalse:[
- nm := base.
- type := #application.
- ].
-
- (base ~= 'librun') ifTrue:[
- (fn suffix = 'mcz') ifTrue:[
- packageName := fn withoutSuffix.
- target := fn.
- ] ifFalse:[
- ( #('dll' 'so' 'sl' 'dylib') includes:(fn suffix)) ifTrue:[
- (base startsWith:'lib') ifTrue:[
- nm := base copyFrom:4.
- ] ifFalse:[
- nm := base.
- ].
- ].
- nameComponents := nm asCollectionOfSubstringsSeparatedBy:$_.
- packageName := nameComponents first.
- nameComponents size > 1 ifTrue:[
- packageName := packageName,':',((nameComponents copyFrom:2) asStringWith:'/')
- ].
- ].
- packageName notNil ifTrue:[
- aBlock value:packageName value:type value:fn .
- ]
- ]
- ]
- ]
- ]
+ |packageDir|
+
+ packageDir := dirName asFilename / 'packages'.
+ (packageDir exists and:[packageDir isDirectory]) ifTrue:[
+ packageDir directoryContentsAsFilenames sort do:[:fn |
+ |item base nm path parentPath parent isLibrary isApplication isAlreadyLoaded
+ defClass target type nameComponents packageName packageID|
+
+ ((fn suffix = 'mcz')
+ or:[ fn isDirectory
+ or:[ (fn baseName startsWith:'.')
+ or:[ (fn baseName = 'README') ]]]) ifFalse:[
+ base := fn withoutSuffix baseName.
+ (base startsWith:'lib') ifTrue:[
+ nm := (base copyFrom:4).
+ fn suffix notEmptyOrNil ifTrue:[
+ type := #library.
+ ] ifFalse:[
+ type := #application.
+ ]
+ ] ifFalse:[
+ nm := base.
+ type := #application.
+ ].
+
+ (base ~= 'librun') ifTrue:[
+ (fn suffix = 'mcz') ifTrue:[
+ packageName := fn withoutSuffix.
+ target := fn.
+ ] ifFalse:[
+ ( #('dll' 'so' 'sl' 'dylib') includes:(fn suffix)) ifTrue:[
+ (base startsWith:'lib') ifTrue:[
+ nm := base copyFrom:4.
+ ] ifFalse:[
+ nm := base.
+ ].
+ ].
+ nameComponents := nm asCollectionOfSubstringsSeparatedBy:$_.
+ packageName := nameComponents first.
+ nameComponents size > 1 ifTrue:[
+ packageName := packageName,':',((nameComponents copyFrom:2) asStringWith:'/')
+ ].
+ ].
+ packageName notNil ifTrue:[
+ aBlock value:packageName value:type value:fn .
+ ]
+ ]
+ ]
+ ]
+ ]
]
"
Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
- Transcript showCR:'%1 (%2) in %3' with:packageID with:type with:path.
+ Transcript showCR:'%1 (%2) in %3' with:packageID with:type with:path.
]
"
!
@@ -8648,11 +8654,11 @@
projectDefinition := aPackageIdOrPackage.
projectDefinition isProjectDefinition ifFalse:[
- projectDefinition := projectDefinition asPackageId projectDefinitionClass.
- projectDefinition isNil ifTrue:[
- Logger warning:'trying to unload non-existing package: %1' with:aPackageIdOrPackage.
- ^ self.
- ].
+ projectDefinition := projectDefinition asPackageId projectDefinitionClass.
+ projectDefinition isNil ifTrue:[
+ Logger warning:'trying to unload non-existing package: %1' with:aPackageIdOrPackage.
+ ^ self.
+ ].
].
projectDefinition unloadPackage.
@@ -8770,14 +8776,14 @@
"return a full version string"
^ 'Smalltalk/X release %1%2 of %3'
- bindWith:(self versionString)
- with:((ExternalAddress pointerSize == 8)
- ifTrue:[' (64bit)']
- ifFalse:[''])
- with:(self versionDate)
-
- "
- Smalltalk fullVersionString
+ bindWith:(self versionString)
+ with:((ExternalAddress pointerSize == 8)
+ ifTrue:[' (64bit)']
+ ifFalse:[''])
+ with:(self versionDate)
+
+ "
+ Smalltalk fullVersionString
"
"Created: / 27.10.1997 / 17:03:09 / cg"
@@ -8799,38 +8805,38 @@
bit := 'bit'.
(lang == #de) ifTrue:[
- proto := 'Willkommen bei %1 (%4Version %2 von %3)'. bit := 'Bit'.
+ proto := 'Willkommen bei %1 (%4Version %2 von %3)'. bit := 'Bit'.
] ifFalse:[ (lang == #fr) ifTrue:[
- proto := 'Salut, Bienvenue à %1 (%4version %2 de %3)'
+ proto := 'Salut, Bienvenue à %1 (%4version %2 de %3)'
] ifFalse:[ (lang == #it) ifTrue:[
- proto := 'Ciao, benvenuto al %1 (%4versione %2 di %3)'
+ proto := 'Ciao, benvenuto al %1 (%4versione %2 di %3)'
] ifFalse:[ (lang == #es) ifTrue:[
- proto := 'Hola, bienvenida a %1 (%4version %2 de %3)'
+ proto := 'Hola, bienvenida a %1 (%4version %2 de %3)'
] ifFalse:[ (lang == #pt) ifTrue:[
- proto := 'Olá!!, mem-vindo a %1 (%4version %2 de %3)'
+ proto := 'Olá!!, mem-vindo a %1 (%4version %2 de %3)'
] ifFalse:[ (lang == #no) ifTrue:[
- proto := 'Hei, verdenmottakelse til %1 (%4versjon %2 av %3)'
+ proto := 'Hei, verdenmottakelse til %1 (%4versjon %2 av %3)'
]]]]]].
"/ ... more needed here ...
proto isNil ifTrue:[
- proto := 'Hello World - welcome to %1 (%4version %2 of %3)'.
+ proto := 'Hello World - welcome to %1 (%4version %2 of %3)'.
].
ExternalAddress pointerSize ~~ 4 ifTrue:[
- bitsPerWordString := (ExternalAddress pointerSize * 8) printString,bit,' '.
+ bitsPerWordString := (ExternalAddress pointerSize * 8) printString,bit,' '.
] ifFalse:[
- bitsPerWordString := ''
- ].
+ bitsPerWordString := ''
+ ].
^ proto bindWith:('SmallTalk/X' allBold)
- with:(self versionString)
- with:(self versionDate)
- with:bitsPerWordString
+ with:(self versionString)
+ with:(self versionDate)
+ with:bitsPerWordString
"
Smalltalk language:#us.
- Smalltalk hello
+ Smalltalk hello
Smalltalk language:#de.
Smalltalk hello
@@ -8895,7 +8901,7 @@
classes changes).
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 7
@@ -8915,7 +8921,7 @@
classes need rework.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 1
@@ -8979,7 +8985,7 @@
to the outside world.
ST/X revision Naming is:
- <major>.<minor>.<revision>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 0
@@ -9104,4 +9110,3 @@
version_SVN
^ '$ Id: Smalltalk.st 10648 2011-06-23 15:55:10Z vranyj1 $'
! !
-