--- a/Smalltalk.st Thu Apr 25 11:30:13 2013 +0100
+++ b/Smalltalk.st Fri Apr 26 15:26:55 2013 +0100
@@ -12,8 +12,8 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#Smalltalk
- instanceVariableNames:''
- classVariableNames:'StartBlocks ImageStartBlocks ExitBlocks CachedClasses
+ instanceVariableNames: ''
+ classVariableNames: 'StartBlocks ImageStartBlocks ExitBlocks CachedClasses
NumberOfClassesHint SystemPath StartupClass StartupSelector
StartupArguments CommandLine CommandName CommandLineArguments
CachedAbbreviations VerboseLoading SilentLoading Initializing
@@ -26,8 +26,8 @@
SpecialObjectArray CallbackSignal KnownPackages
ClassesFailedToInitialize HasNoConsole IgnoreHalt
PackageToPathMapping'
- poolDictionaries:''
- category:'System-Support'
+ poolDictionaries: ''
+ category: 'System-Support'
!
Smalltalk comment:''
@@ -752,13 +752,7 @@
^ self
].
oldClass removeFromSystem
-!
-
-
-
-
-
- !
+! !
!Smalltalk class methodsFor:'Compatibility-V''Age'!
@@ -2483,7 +2477,7 @@
binaryClassLibraryFilename := packageDir / shLibName.
binaryClassLibraryFilename exists ifFalse:[
"/ mhmh - is this a good idea ? (temporary kludge)
- ExternalAddress pointerSize == 4 ifTrue:[
+ ExternalAddress pointerSize == 4 ifTrue:[
binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
binaryClassLibraryFilename exists ifFalse:[
binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
@@ -2501,7 +2495,7 @@
"/ look in package directory
binaryClassLibraryFilename := packageDir / shLibName.
binaryClassLibraryFilename exists ifFalse:[
- ExternalAddress pointerSize == 4 ifTrue:[
+ ExternalAddress pointerSize == 4 ifTrue:[
binaryClassLibraryFilename := packageDir / 'objbc' / shLibName.
binaryClassLibraryFilename exists ifFalse:[
binaryClassLibraryFilename := packageDir / 'objvc' / shLibName.
@@ -2522,7 +2516,7 @@
loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
"/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
].
- loadOK ifTrue:[
+ (loadOK and:[loadErrorOccurred not]) ifTrue:[
silent ifFalse:[
Transcript showCR:('loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
].
@@ -2537,6 +2531,7 @@
"/ ].
^ true
].
+
loadErrorOccurred ifTrue:[
self breakPoint:#cg.
projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
@@ -2547,7 +2542,6 @@
].
].
].
-
packageDir isNil ifTrue:[
^ false.
].
@@ -2989,45 +2983,45 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
- cls := self at:sym ifAbsent:nil.
- cls isBehavior ifTrue:[^ cls].
+ cls := self at:sym ifAbsent:nil.
+ cls isBehavior ifTrue:[^ cls].
].
(aString endsWith:' class') ifTrue:[
- nonMeta := self classNamed:(aString copyWithoutLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
+ nonMeta := self classNamed:(aString copyButLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
].
"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
@@ -3258,15 +3252,15 @@
But be careful, to not invent new symbols ..."
sym := aString asSymbolIfInterned.
sym notNil ifTrue:[
- cls := self at:sym ifAbsent:nil.
- cls isBehavior ifTrue:[^ cls].
+ cls := self at:sym ifAbsent:nil.
+ cls isBehavior ifTrue:[^ cls].
].
(aString endsWith:' class') ifTrue:[
- nonMeta := self loadedClassNamed:(aString copyWithoutLast:6).
- nonMeta notNil ifTrue:[
- ^ nonMeta theMetaclass
- ].
+ nonMeta := self loadedClassNamed:(aString copyButLast:6).
+ nonMeta notNil ifTrue:[
+ ^ nonMeta theMetaclass
+ ].
].
^ nil
@@ -3591,43 +3585,43 @@
thisIsARestart := imageName notNil.
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.
- ].
- Display startDispatch.
+ Display deviceIOTimeoutErrorSignal handlerBlock:[:ex |
+ SaveEmergencyImage == true ifTrue:[
+ 'Display [warning]: broken display connection - emergency save in ''crash.img''.' infoPrintCR.
+ ObjectMemory primSnapShotOn:'crash.img'.
+ ].
+ 'Display [warning]: broken display connection - exit.' infoPrintCR.
+ self exit.
+ ].
+ Display startDispatch.
].
idx := CommandLineArguments indexOf:'--browserWindow:'.
IsPlugin := (idx ~~ 0).
IsPlugin ifTrue:[
- 'Smalltalk [info]: startup browser window...' infoPrintCR.
- self browserWindowStartup.
- "/ not reached
+ 'Smalltalk [info]: startup browser window...' infoPrintCR.
+ self browserWindowStartup.
+ "/ not reached
].
Initializing := false.
@@ -3638,49 +3632,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.
@@ -3697,63 +3691,63 @@
"/ message.
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
- "
- allow more customization by reading an image specific rc-file
- "
- thisIsARestart ifTrue:[
- (imageName asFilename hasSuffix:'img') ifTrue:[
- imageName := imageName copyWithoutLast:4
- ].
- self fileIn:(imageName , '.rc')
- ].
+ "
+ allow more customization by reading an image specific rc-file
+ "
+ thisIsARestart ifTrue:[
+ (imageName asFilename hasSuffix:'img') ifTrue:[
+ imageName := imageName 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.
- ].
- "/
- "/ 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"
+ 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.
+ ].
+ "/
+ "/ 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"
].
StandAlone ifTrue:[
- Display notNil ifTrue:[
- FlyByHelp notNil ifTrue:[
- FlyByHelp start
- ].
- ].
+ Display notNil ifTrue:[
+ FlyByHelp notNil ifTrue:[
+ FlyByHelp start
+ ].
+ ].
].
"
@@ -3764,13 +3758,13 @@
or:[process notNil
or:[HeadlessOperation
or:[StandAlone]]]) ifTrue:[
- Processor dispatchLoop.
- "done - the last process finished"
- 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
+ Processor dispatchLoop.
+ "done - the last process finished"
+ 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
] ifFalse:[
- StandAlone ifFalse:[
- self readEvalPrint
- ]
+ StandAlone ifFalse:[
+ self readEvalPrint
+ ]
].
self exit
@@ -6270,9 +6264,9 @@
|fn|
(aFileName asFilename hasSuffix:'st') ifTrue:[
- fn := aFileName copyWithoutLast:3
+ fn := aFileName copyButLast:3
] ifFalse:[
- fn := aFileName
+ fn := aFileName
].
^ self filenameAbbreviations keyAtEqualValue:fn ifAbsent:[fn].
@@ -7982,11 +7976,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1023 2013-04-16 18:09:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1025 2013-04-25 19:09:39 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1023 2013-04-16 18:09:17 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1025 2013-04-25 19:09:39 stefan Exp $'
!
version_HG