--- a/Smalltalk.st Wed Jul 04 19:03:58 2007 +0200
+++ b/Smalltalk.st Wed Jul 04 19:06:37 2007 +0200
@@ -1907,12 +1907,6 @@
"Created: / 06-12-2006 / 16:43:36 / cg"
!
-beStandAloneApp
- "set the StandAlone flag."
-
- StandAlone := true
-!
-
standAloneApp:aBoolean
"set/clear the StandAlone flag."
@@ -2720,9 +2714,6 @@
|process imageName thisIsARestart idx|
-'mainStartup' printCR.
-'Display is ' print. Display printCR.
-
imageName := ObjectMemory imageName.
thisIsARestart := imageName notNil.
@@ -2879,14 +2870,15 @@
or:[process notNil
or:[HeadlessOperation]]) ifTrue:[
Processor dispatchLoop.
- "done - the last process finished"
- 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
] ifFalse:[
StandAlone ifFalse:[
self readEvalPrint
]
].
+ "done - the last process finished"
+
+ 'Smalltalk [info]: last process finished - exit.' infoPrintCR.
self exit
"Created: / 18.7.1996 / 21:07:39 / cg"
@@ -2894,13 +2886,254 @@
"Modified: / 25.5.1998 / 15:02:57 / cg"
!
-5.1998 / 15:02:57 / cg"
-!
-
-2-2006 / 15:38:17 / cg"
-!
-
-2-2006 / 17:35:19 / cg"
+openDisplay
+ "try to open a display connection.
+ If so, also read display- and keyboard.rc"
+
+ Display isNil ifTrue:[
+ Screen notNil ifTrue:[
+ [
+ Screen openDefaultDisplay:nil.
+ ] on:Screen deviceOpenErrorSignal do:[:ex|
+ ('Smalltalk [error]: No Display connection to: ', ex parameter printString) errorPrintCR.
+ 'Smalltalk [info]: Either set the DISPLAY environment variable,' infoPrintCR.
+ 'Smalltalk [info]: or start smalltalk with a -display argument.' infoPrintCR.
+ HeadlessOperation == true ifFalse:[
+ OperatingSystem exit:1.
+ ].
+ ].
+
+ Display notNil ifTrue:[
+ (self secureFileIn:'display.rc') ifFalse:[
+ "/ 'Smalltalk [warning]: no display.rc found; screen setting might be wrong.' errorPrintCR.
+ (self secureFileIn:'keyboard.rc') ifFalse:[
+ "/ 'Smalltalk [warning]: no keyboard.rc found; shortkey setting might be wrong.' errorPrintCR.
+ ]
+ ]
+ ].
+ ]
+ ]
+
+ "Created: / 06-12-2006 / 15:38:17 / cg"
+!
+
+readEvalPrint
+ "{ Pragma: +optSpace }"
+
+ (ReadEvalPrintLoop new prompt:'ST> ') readEvalPrintLoop
+
+ "Modified: / 07-12-2006 / 17:35:19 / cg"
+!
+
+restart
+ "startup after an image has been loaded;
+ there are three change-notifications made to dependents of ObjectMemory,
+ which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
+
+ #earlySystemInstallation is sent for ST80 compatibility
+
+ #earlyRestart is send first, nothing has been setup yet.
+ (should be used to flush all device dependent entries)
+
+ #restarted is send right after.
+ (should be used to recreate external resources (fds, bitmaps etc)
+
+ #returnFromSnapshot is sent last
+ (should be used to restart processes, reOpen Streams which cannot
+ be automatically be reopened (i.e. Sockets, Pipes) and so on.
+ (Notice that positionable fileStreams are already reopened and repositioned)
+ "
+
+ |deb insp transcript idx|
+
+ "/
+ "/ when we arrive here, all objects from our previous life
+ "/ have been reloaded - however, some may still contain invalid device
+ "/ handles, display information etc.
+ "/ also, dynamically loaded modules have not yet been reloaded yet.
+ "/ and the concrete OS, concrete FileName etc. are still refering to
+ "/ the previous classes.
+
+ Initializing := true.
+ AbstractOperatingSystem initializeConcreteClass.
+
+ ImageRestartTime := Timestamp now.
+
+ CommandLine := CommandLineArguments copy.
+ CommandLineArguments := CommandLineArguments asOrderedCollection.
+ CommandName := CommandLineArguments removeFirst. "/ the command
+
+ idx := CommandLineArguments indexOf:'-q'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--silent'.
+ ].
+ idx ~~ 0 ifTrue:[
+ Object infoPrinting:false.
+ ObjectMemory infoPrinting:false.
+ CommandLineArguments removeAtIndex:idx.
+ ].
+
+ "/
+ "/ start catching SIGSEGV and SIGBUS
+
+ OperatingSystem enableHardSignalInterrupts.
+
+ "/ reinit Filename
+ Filename reinitialize.
+
+ "/
+ "/ flush cached path directories (may have changed in the meanwhile)
+
+ self flushPathCaches.
+
+ "/
+ "/ reinit the default streams: Stdin, Stdout and Stderr
+ "/ after that, we can write to stderr.
+
+ self reinitStandardStreams.
+
+ "/
+ "/ redirect Transcript to Stderr during startup
+
+ transcript := Transcript.
+ Transcript := Stderr.
+
+ "/
+ "/ temporary switch back to dumb interface -
+ "/ to handle errors while view-stuff is not yet reinitialized
+
+ insp := Inspector.
+ deb := Debugger.
+ deb notNil ifTrue:[
+ deb reinitialize
+ ].
+ Inspector := MiniInspector.
+ Debugger := MiniDebugger.
+
+ "/ reload any dynamically loaded objects.
+ "/ this must be done before doing anything else below,
+ "/ because the Processor may restart processes which use
+ "/ this code.
+ "/ Also, a dynamic object might be registered as dependent of
+ "/ ObjectFileLoader; therefore, must reload before doing any notifications.
+
+ ObjectFileLoader notNil ifTrue:[
+ ObjectFileLoader reloadAllRememberedObjectFiles.
+ ].
+
+ "/
+ "/ invalidate all display connections.
+ "/ This is required to avoid trouble if someone accesses
+ "/ a display during early startup.
+
+ Screen notNil ifTrue:[
+ Screen allScreens do:[:aDisplay |
+ aDisplay invalidateConnection
+ ].
+ ].
+
+ ObjectMemory changed:#earlySystemInstallation.
+
+ "/
+ "/ reinitialize the Processor - restartable processes
+ "/ are now restarted here (but not yet scheduled).
+ "/
+ Processor reinitialize.
+
+ "/
+ "/ flush device handles & recreate OS resources (if possible)
+ "/ (mostly view/GC/color & font stuff)
+
+ ObjectMemory
+ changed:#earlyRestart; changed:#restarted.
+
+ "/
+ "/ start catching SIGINT and SIGQUIT
+
+ OperatingSystem enableUserInterrupts.
+ OperatingSystem enableCrashSignalInterrupts.
+
+ "/ give user a chance to re-customize things in smalltalk_r.rc.
+ "/ reading if smalltalk_r.rc may be suppressed by the --faststart argument.
+
+ idx := CommandLineArguments indexOf:'--faststart'.
+ idx == 0 ifTrue:[
+ idx := CommandLineArguments indexOf:'--fastStart'.
+ ].
+ idx ~~ 0 ifTrue:[
+ CommandLineArguments removeAtIndex:idx.
+ ] ifFalse:[
+ CallbackSignal := QuerySignal new.
+ [
+ Class withoutUpdatingChangesDo:[
+ (self fileIn:(self commandName , '_r.rc')) ifFalse:[
+ "no _r.rc file where executable is; try default smalltalk_r.rc"
+ self fileIn:'smalltalk_r.rc'
+ ].
+ ]
+ ] on:CallbackSignal do:[:ex|
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
+ ex proceed.
+ ].
+ CallbackSignal := nil.
+ ].
+
+ "/ reinitialization (restart) of Display is normally performed
+ "/ in the restart script. If this has not been run for some reason,
+ "/ do in now.
+ Initializing ifTrue:[
+ Display notNil ifTrue:[
+ [
+ Display reinitializeFor:Screen defaultDisplayName.
+ ] on:Screen deviceOpenErrorSignal do:[
+ 'Smalltalk [error]: Cannot restart connection to: ' errorPrint.
+ Screen defaultDisplayName errorPrintCR.
+ OperatingSystem exit:1.
+ ].
+ ].
+ "/ now, display and view-stuff works;
+ "/ back to the previous debugging interface
+
+ Inspector := insp.
+ Debugger := deb.
+
+ "/ reinstall Transcript, if not changed during restart.
+ "/ if there was no Transcript, go to stderr
+
+ (transcript notNil and:[Transcript == Stderr]) ifTrue:[
+ Transcript := transcript.
+ ].
+ Initializing := false.
+ ].
+ Screen notNil ifTrue:[
+ "clean up leftover screens (and views) that haven't been reopened.
+ Operate on a copy, since brokenConnection removes us from AllScreens"
+ Screen allScreens copy do:[:eachDisplay |
+ eachDisplay isOpen ifFalse:[
+ 'Smalltalk [info]: cannot reopen secondary display: ' errorPrint.
+ eachDisplay errorPrintCR.
+ eachDisplay cleanupAfterDispatch; brokenConnection.
+ ]
+ ].
+ ].
+
+ deb := insp := transcript := nil. "avoid dangling refs"
+ self mainStartup:true
+
+ "Modified: / 7.6.1998 / 02:48:00 / cg"
+ "Modified: / 3.8.1999 / 09:42:21 / stefan"
!
start
@@ -2909,7 +3142,6 @@
|idx graphicalMode arg didReadRCFile|
-'start' printCR.
graphicalMode := true.
Initializing := true.
@@ -3068,6 +3300,7 @@
(Display isNil or:[HeadlessOperation]) ifTrue:[
graphicalMode := false.
].
+
self mainStartup:graphicalMode
"Modified: / 06-12-2006 / 15:39:17 / cg"
@@ -3075,529 +3308,3703 @@
!Smalltalk class methodsFor:'startup queries'!
-malltalk class methodsFor:'startup queries'
-!
-
-"Created: 19.7.1996 / 11:09:06 / cg"
-!
-
-ommandLineArgumentNamed:'-display'
- "
-!
-
-"Modified: 19.7.1996 / 11:11:03 / cg"
-!
-
-"Modified: 19.7.1996 / 11:11:16 / cg"
-!
-
-"
+commandLine
+ "return the full command line arguments (with which ST/X was started)"
+
+ ^ CommandLine
+
+ "
+ Smalltalk commandLine
+ "
+
+ "Created: 19.7.1996 / 11:09:06 / cg"
+!
+
+commandLineArgumentNamed:aString
+ "extract a named argument from the command line arguments."
+
+ |args index|
+
+ args := self commandLineArguments.
+ index := args indexOf:aString.
+ (index between:1 and:(args size - 1)) ifTrue:[
+ ^ args at:index+1
+ ].
+ ^ nil.
+
+ "
+ self commandLineArgumentNamed:'-display'
+ "
+!
+
+commandLineArguments
+ "return the user command line arguments;
+ This is a collection of strings (separated command line words),
+ from which the internal startup arguments have already been removed.
+ I.e. if started with: 'smalltalk -I -f xxx foo bar baz',
+ the commandLineArguments will be #('foo' 'bar' 'baz').
+ In contrast, the value returned by #commandLine will be the full set of words."
+
+ ^ CommandLineArguments
+
+ "Modified: 19.7.1996 / 11:11:03 / cg"
+!
+
+commandName
+ "return the excutables name - this is normally 'stx',
+ but can be something else for standAlone apps."
+
+ ^ CommandName.
+
+ "
+ Smalltalk commandName
+ "
+
+ "Modified: 19.7.1996 / 11:11:16 / cg"
+!
+
+hasNoConsole
+ "return true, if this is a console-less application (i.e. I am winstx)
+ i.e. there should be no writing to stdout/stderr"
+
+ ^ HasNoConsole ? false
+
+ "
Smalltalk hasNoConsole
"
!
-"
+isHeadless
+ "return true, if this is a headless application
+ i.e. no default Display connection is required/used"
+
+ ^ HeadlessOperation ? false
+
+ "
Smalltalk isHeadless
"
!
-"
+isPlugin
+ "return true, if this is a plugin application
+ i.e. running in a browserWindow"
+
+ ^ IsPlugin ? false
+
+ "
Smalltalk isPlugin
"
!
-"Created: / 06-12-2006 / 16:41:21 / cg"
-!
-
-"Created: / 10-08-2006 / 13:09:34 / cg"
-!
-
-"Modified: / 06-12-2006 / 16:42:56 / cg"
-!
-
-"
+isSTScript
+ "return true, if this is stscript. i.e. the stx scripting engine."
+
+ ^ IsSTScript ? false
+
+ "
+ Smalltalk isSTScript
+ "
+
+ "Created: / 06-12-2006 / 16:41:21 / cg"
+!
+
+isSharedLibraryComponent
+ "return true, if this is a shared library component of another application
+ i.e. a dll within another app."
+
+ ^ IsSharedLibraryComponent ? false
+
+ "
+ Smalltalk isSharedLibraryComponent
+ "
+
+ "Created: / 10-08-2006 / 13:09:34 / cg"
+!
+
+isSmalltalkDevelopmentSystem
+ "return true, if this is a real smalltalk system
+ i.e. NOT a stripped or a linked application (such as the webServer)
+ and NOT a plugIn (i.e. running in a browser)
+ and NOT a sharedLibrary component (i.e. a dll in another app).
+ This is used to determine, wether debugging is possible or not."
+
+ self isPlugin ifTrue:[^ false]. "/ I am a browser-plugin
+ self isSharedLibraryComponent ifTrue:[^ false]. "/ I am a COM-ponent
+ self isSTScript ifTrue:[^ true ]. "/ I am stScript
+ ^ self isStandAloneApp not.
+
+ "
+ Smalltalk isSmalltalkDevelopmentSystem
+ "
+
+ "Created: / 10-08-2006 / 13:12:49 / cg"
+ "Modified: / 06-12-2006 / 16:42:56 / cg"
+!
+
+isStandAloneApp
+ "return true, if this is a standAlone application
+ i.e. a stripped & linked application (such as the webServer)
+ in contrast to a full smalltalk (development) system."
+
+ ^ StandAlone ? false
+
+ "
Smalltalk isStandAloneApp
"
!
-"
+startupArguments
+ "return the arguments passed to StartupClass when stx gets started.
+ Usually these are nil,
+ but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
+ a simple way to configure and create stand-alone applications"
+
+ ^ StartupArguments
+
+ "
Smalltalk startupArguments
"
!
-"
+startupClass
+ "return the class, that will get the start message when smalltalk
+ starts and its non-nil. Usually this is nil,
+ but saving an image with a non-nil StartupClass/StartupSelector/StartupArgs allows for
+ a simple way to configure and create stand-alone applications"
+
+ ^ StartupClass
+
+ "
Smalltalk startupClass
"
!
-ol.
+startupClass:aClass selector:aSymbol arguments:anArrayOrNil
+ "{ Pragma: +optSpace }"
+
+ "set the class, selector and arguments to be performed when smalltalk
+ starts. Setting those before saving a snapshot, will make the saved
+ image come up executing your application (instead of the normal mainloop)"
+
+ StartupClass := aClass.
+ StartupSelector := aSymbol.
StartupArguments := anArrayOrNil
!
-"
+startupSelector
+ "return the selector, that will be sent to StartupClass.
+ Usually this is nil,
+ but saving an image with a non-nil StartupClass/StartupSelector allows for
+ a simple way to configure and create stand-alone applications"
+
+ ^ StartupSelector
+
+ "
Smalltalk startupSelector
"
+!
+
+wasStartedFromImage
+ "return true, if this smalltalk was started from an image,
+ as opposed to a fresh and clean startup"
+
+ ^ ImageRestartTime notNil
+
+ "
+ Smalltalk wasStartedFromImage
+ "
! !
!Smalltalk class methodsFor:'system environment'!
-ltalk class methodsFor:'system environment'
-!
-
-"Modified: 26.4.1996 / 17:10:05 / cg"
-!
-
-"Modified: / 19-10-2006 / 23:17:29 / cg"
-!
-
-"Modified: / 19-10-2006 / 23:17:36 / cg"
-!
-
-itory setting"
+language
+ "return the language setting"
+
+ ^ Language
+
+ "
+ Smalltalk language
+ "
+
+ "Modified: 26.4.1996 / 17:10:05 / cg"
+!
+
+language:aLanguageSymbol
+ "set the language"
+
+ Language := aLanguageSymbol asSymbol.
+ self changed:#Language
+
+ "
+ Smalltalk language:#de
+ "
+
+ "Modified: / 19-10-2006 / 23:17:29 / cg"
+!
+
+language:aLanguageSymbol territory:aTerritorySymbol
+ "set the language & territory"
+
+ Language := aLanguageSymbol asSymbol.
+ LanguageTerritory := aTerritorySymbol asSymbol.
+ self changed:#Language
+
+ "
+ Smalltalk language:#de territory:#de
+ "
+
+ "Created: / 19-10-2006 / 22:16:22 / cg"
+ "Modified: / 19-10-2006 / 23:17:36 / cg"
+!
+
+languageTerritory
+ "return the language territory setting"
^ LanguageTerritory
!
-"Modified: / 19-10-2006 / 23:17:40 / cg"
+languageTerritory:aTerritorySymbol
+ "set the language territory"
+
+ LanguageTerritory := aTerritorySymbol asSymbol.
+ self changed:#LanguageTerritory
+
+ "
+ Time now
+
+ Smalltalk languageTerritory:#us.
+ Time now
+
+ Smalltalk languageTerritory:#de.
+ Time now
+ "
+
+ "Modified: / 19-10-2006 / 23:17:40 / cg"
+!
+
+setLanguage:aLanguageSymbol
+ "set the language withotu change notifications"
+
+ Language := aLanguageSymbol.
! !
!Smalltalk class methodsFor:'system management'!
-lltalk class methodsFor:'system management'
-!
-
-"Modified: 16.1.1997 / 01:25:58 / cg"
-!
-
-"Created: 17.10.1997 / 13:00:56 / cg"
-!
-
-ion:revisionOrNil
+compressSources
+ "{ Pragma: +optSpace }"
+
+ "compress the sources file, and remove all method source strings
+ from the system and replace them by refs to a string in the source file.
+ This is a bit different in ST/X than in other smalltalks,
+ since we use per-class sourcefiles for the compiled classes,
+ and a mix of in-memory strings and one-for-all sourceFile for
+ incremental compiled methods.
+ Therefore, only those sources which are not coming from compiled
+ methods are put into the 'st.src' file - all others are untouched.
+ This is being automated - so dont care for now."
+
+ |newStream table source pos fileName|
+
+ "
+ first, find all methods which contain either a string-ref
+ or an external string in the 'st.src' file
+ "
+ newStream := 'src.tmp' asFilename writeStream.
+
+ table := IdentityDictionary new:100.
+
+ Method allSubInstancesDo:[:aMethod |
+ source := nil.
+ aMethod sourcePosition notNil ifTrue:[
+ aMethod sourceFilename = 'st.src' ifTrue:[
+ source := aMethod source.
+ ]
+ ] ifFalse:[
+ source := aMethod source
+ ].
+
+ source notNil ifTrue:[
+ pos := newStream position1Based.
+ newStream nextChunkPut:source.
+
+ "
+ dont change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
+ ].
+
+ newStream close.
+
+ "
+ now, rename the new source file,
+ "
+ fileName := (ObjectMemory nameForSources).
+ 'src.tmp' asFilename renameTo:fileName.
+
+ "good - now go over all changed methods, and change their
+ source reference"
+
+ table keysAndValuesDo:[:aMethod :pos |
+ aMethod localSourceFilename:fileName position:pos.
+"/ aMethod printCR.
+ ].
+
+ "
+ Smalltalk compressSources
+ "
+
+ "Modified: 16.1.1997 / 01:25:58 / cg"
+!
+
+generateSingleSourceFile
+ "{ Pragma: +optSpace }"
+
+ "generate the sources file, and remove all method source strings
+ from the system and replace them by refs to a string in the source file.
+ This makes the image independent from the per-class source files
+ and makes transportation of endUser applications easier, since
+ only 3 files (executable, image and sourceFile) need to be
+ transported."
+
+ |newStream table source pos fileName|
+
+ newStream := 'src.tmp' asFilename writeStream.
+
+ table := IdentityDictionary new:100.
+
+ Method allSubInstancesDo:[:aMethod |
+ source := aMethod source.
+ source notNil ifTrue:[
+ pos := newStream position1Based.
+ newStream nextChunkPut:source.
+
+ "
+ dont change the methods info - maybe some write error
+ occurs later, in that case we abort and leave everything
+ untouched.
+ "
+ table at:aMethod put:pos
+ ]
+ ].
+
+ newStream close.
+
+ "
+ now, rename the new source file,
+ "
+ fileName := (ObjectMemory nameForSources).
+ 'src.tmp' asFilename renameTo:fileName.
+
+ "good - now go over all changed methods, and change their
+ source reference"
+
+ table keysAndValuesDo:[:aMethod :pos |
+ aMethod localSourceFilename:fileName position:pos.
+"/ aMethod printCR.
+ ].
+
+ "
+ Smalltalk generateSingleSourceFile
+ "
+
+ "Modified: 16.1.1997 / 01:25:58 / cg"
+ "Created: 17.10.1997 / 13:00:56 / cg"
+!
+
+installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil
+ "create & install an autoload stub for a class named: clsName,
+ to be loaded from package.
+ If revisionOrNil is non-nil, set it up to load exactly that revision
+ (otherwise, the newest revision will be loaded"
+
+ ^ self
+ installAutoloadedClassNamed:clsName
+ category:cat
+ package:package
+ revision:revisionOrNil
numClassInstVars:nil.
!
-"Modified: / 16-01-2007 / 12:56:18 / cg"
-!
-
-"Modified: / 13.12.1999 / 11:56:50 / cg"
-!
-
-"Modified: / 5.11.1998 / 15:10:51 / cg"
-!
-
-].
+installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil numClassInstVars:numClassInstVarsOrNil
+ "create & install an autoload stub for a class named: clsName,
+ to be loaded from package.
+ If revisionOrNil is non-nil, set it up to load exactly that revision
+ (otherwise, the newest revision will be loaded"
+
+ |clsSym cls|
+
+ clsSym := clsName asSymbol.
+
+ "/ install if not already compiled-in
+ (cls := self at:clsSym) isNil ifTrue:[
+ Autoload subclass:clsSym
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:cat
+ inEnvironment:Smalltalk.
+
+ cls := self at:clsSym.
+ cls isNil ifTrue:[
+ ('Smalltalk [warning]: failed to install ' , clsName , ' as autoloaded.') infoPrintCR.
+ ] ifFalse:[
+ cls package:package asSymbol.
+ revisionOrNil notNil ifTrue:[
+ cls setBinaryRevision:revisionOrNil
+ ]
+ ]
+ ] ifFalse:[
+ "/ class already present - however, if unloaded, check for category/package change
+ cls isLoaded ifFalse:[
+ package ~= cls package ifTrue:[
+ cls package:package asSymbol.
+ ].
+ cat ~= cls category ifTrue:[
+ cls category:cat.
+ ].
+ ]
+ ].
+ ^ cls.
+
+ "Created: / 05-11-1998 / 15:10:25 / cg"
+ "Modified: / 16-01-2007 / 12:56:18 / cg"
+!
+
+installAutoloadedClasses
+ "read the standard abbreviation file; install all classes found there as
+ autoloaded. This takes some time ..."
+
+ |dirsConsulted p|
+
+ "/ new scheme: look for a directory called 'packages'
+ "/ and enumerate its abbrev.stc files...
+ dirsConsulted := Set new.
+
+ "/ along the package-path
+ (p := self packagePath) do:[:aPath |
+ (dirsConsulted includes:aPath) ifFalse:[
+ ('Smalltalk [info]: installing autoloaded classes found under ''' , aPath ,'''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:aPath
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:aPath.
+ ]
+ ].
+ p size == 0 ifTrue:[
+ '../../../stx' asFilename exists ifTrue:[
+ ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
+ self
+ recursiveInstallAutoloadedClassesFrom:'../../..'
+ rememberIn:dirsConsulted
+ maxLevels:15
+ noAutoload:false
+ packageTop:'../../..'.
+ ].
+ ].
+
+ "
+ Smalltalk installAutoloadedClasses
+ "
+
+ "Created: / 14.2.1997 / 17:32:57 / cg"
+ "Modified: / 13.12.1999 / 11:56:50 / cg"
+!
+
+installAutoloadedClassesFrom:anAbbrevFilePath
+ "read the given abbreviation file; install all classes found there as
+ autoloaded. This takes some time ..."
+
+ |f s|
+
+ f := self getSystemFileName:anAbbrevFilePath.
+ 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"].
+ ]
+
+ "
+ Smalltalk installAutoloadedClassesFrom:'include/abbrev.stc'
+ "
+
+ "Modified: / 5.11.1998 / 15:10:51 / cg"
+!
+
+installAutoloadedClassesFromStream:anAbbrevFileStream
+ "read the given abbreviation file;
+ install all classes found there as autoloaded, and also update the
+ abbreviation (className-to-fileName mapping) table.
+ This takes some time ..."
+
+ |s2 l abbrevFileName info clsName cls abbrev package cat numClassInstVars words w|
+
+ anAbbrevFileStream isFileStream ifTrue:[
+ abbrevFileName := anAbbrevFileStream pathName.
+ info := 'declared from: ', abbrevFileName.
+ ].
+
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+
+ "/ yes, create any required nameSpace, without asking user.
+ Class createNameSpaceQuerySignal answer:true do:[
+
+ [anAbbrevFileStream atEnd] whileFalse:[
+ l := anAbbrevFileStream nextLine withoutSeparators.
+ l notEmpty ifTrue:[
+ "/ must do it manually, caring for quoted strings.
+"/ 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].
+
+"/ KnownPackages add:package.
+
+ (cat size == 0) ifTrue:[
+ cat := 'autoloaded'
+ ].
+
+ "/ on the fly, update the abbreviations
+ self setFilename:abbrev forClass:clsName package:package.
+
+ "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
+
+ cls := self
+ installAutoloadedClassNamed:clsName
+ category:cat
+ package:package
+ revision:nil
+ numClassInstVars:numClassInstVars.
+
+"/ info notNil ifTrue:[
+"/ cls setComment:info.
+"/ ].
]
]
]
]
!
-s false (for now)."
+loadBinaries
+ "return true, if binaries should be loaded into the system,
+ false if this should be suppressed. The default is false (for now)."
^ LoadBinaries
!
-"Modified: 10.1.1997 / 15:11:00 / cg"
-!
-
-ts := false
+loadBinaries:aBoolean
+ "{ Pragma: +optSpace }"
+
+ "turn on/off loading of binary objects"
+
+ aBoolean ifTrue:[
+ (ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
+ LoadBinaries := true.
+ ^ self
+ ].
+ 'Smalltalk [info]: this system does not support binary loading' infoPrintCR.
+ ].
+ LoadBinaries := false
+
+ "Modified: 10.1.1997 / 15:11:00 / cg"
+!
+
+logDoits
+ "return true if doits should go into the changes file
+ as well as changes - by default, this is off, since
+ it can blow up the changes file enormously ...
+ "
+
+ ^ LogDoits
+
+ "
+ LogDoits := false
LogDoits := true
"
!
-...
+logDoits:aBoolean
+ "{ Pragma: +optSpace }"
+
+ "turn on/off logging of doits in the changes file.
+ By default, this is off, since it can blow up the
+ changes file enormously ...
"
LogDoits := aBoolean
!
-"Created: 17.10.1997 / 13:52:19 / cg"
-!
-
-"Modified: / 17-08-2006 / 16:48:43 / cg"
-!
-
-lf at:(each key) put:(each value)
- ].
-!
-
-"Modified: / 24.10.1997 / 18:22:26 / cg"
+makeBytecodeMethods
+ "{ Pragma: +optSpace }"
+
+ "walk over all methods and make each a bytecode method
+ iff it does not contain primitive C code.
+ Experimental and not yet used."
+
+ Method allSubInstancesDo:[:aMethod |
+ |newMethod|
+
+ aMethod hasPrimitiveCode ifFalse:[
+ newMethod := aMethod asByteCodeMethod.
+ newMethod ~~ aMethod ifTrue:[
+ aMethod becomeSameAs:newMethod
+ ]
+ ].
+ ].
+
+ "
+ Smalltalk makeBytecodeMethods
+ "
+
+ "Modified: 16.1.1997 / 01:25:58 / cg"
+ "Created: 17.10.1997 / 13:52:19 / cg"
+!
+
+recursiveInstallAutoloadedClassesFrom:aDirectory rememberIn:dirsConsulted maxLevels:maxLevels noAutoload:noAutoloadIn packageTop:packageTopPath
+ "read all abbrev.stc files from and under aDirectory
+ and install autoloaded classes.
+ If a file called NOAUTOLOAD is found, no classes there and below are installed as autoloaded
+ (however, the directories are searched for packages)
+ If a file called NOPACKAGES is found, no further searching is done in that directory or below."
+
+ |abbrevStream dir noAutoloadHere dirName pkgName directoryContents|
+
+ maxLevels == 0 ifTrue:[
+"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
+ ^ self
+ ].
+
+ dir := aDirectory asFilename.
+
+ (dirsConsulted includes:dir pathName) ifTrue:[
+ ^ self
+ ].
+ dirsConsulted add:dir pathName.
+
+ (dir construct:'NOPACKAGES') exists ifTrue:[
+ ^ self.
+ ].
+ (dir construct:'NOSUBAUTOLOAD') exists ifTrue:[
+ ^ self.
+ ].
+ noAutoloadHere := noAutoloadIn.
+ noAutoloadHere ifFalse:[
+ (dir construct:'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
+ ] ifTrue:[
+ (dir construct:'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
+ ].
+
+ ((dir construct:'loadAll') exists
+ or:[(dir construct:'abbrev.stc') exists
+ or:[(dir construct:(dir baseName , '.prj')) exists]]) ifTrue:[
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+ dirName := dir pathName.
+ pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
+ KnownPackages add:pkgName
+ ].
+
+ "/
+ "/ suppress installation as autoloaded in this and everything
+ "/ below; however, still traverse the directories to find packages ...
+ "/
+ noAutoloadHere ifFalse:[
+ [
+ abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+ self installAutoloadedClassesFromStream:abbrevStream.
+ abbrevStream close.
+ ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
+ ].
+
+ [
+ directoryContents := dir directoryContents.
+ ] on:FileStream openErrorSignal do:[:ex|
+ "non-accessable directory: we are done"
+ ^ self
+ ].
+
+ directoryContents do:[:aFilename |
+ |f|
+
+ (#(
+ 'objbc'
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ 'not_delivered'
+ 'not_ported'
+ ) includes:aFilename) ifFalse:[
+ ((dir baseName ~= 'stx')
+ or:[
+ (#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ) includes:aFilename) not])
+ ifTrue:[
+ f := dir construct:aFilename.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath.
+ ]
+ ]
+ ].
+ ].
+
+ "
+ Smalltalk installAutoloadedClasses
+ "
+
+ "Modified: / 17-08-2006 / 16:48:43 / cg"
+!
+
+replaceReferencesTo:anObject with:newRef
+ |toAdd|
+
+ toAdd := OrderedCollection new.
+ self keysAndValuesDo:[:key :val |
+ (key == anObject) ifTrue:[
+ self shouldImplement.
+ ].
+ (val == anObject ) ifTrue:[
+ toAdd add:(key -> newRef)
+ ].
+ ].
+ toAdd do:[:each |
+ self at:(each key) put:(each value)
+ ].
+!
+
+saveEmergencyImage:aBoolean
+ "set/clear the flag which controls if ST/X should save an
+ emergency image in case of a broken display connection.
+ The default is true.
+ This may be useful, if you work with an unsecure display
+ (serial line), and want to have a chance of proceeding after
+ a crash. In multiheaded applications, this only affects
+ crashes of the master Display connection (the initial connection);
+ errors on other displays are reported to the views and treated
+ like window destroy from the windowManager."
+
+ SaveEmergencyImage := aBoolean
+
+ "Modified: / 24.10.1997 / 18:22:26 / cg"
+!
+
+systemOrganization
+ "for partial ST80 compatibility;
+ In ST80, Smalltalk organization returns a systemOrganizer, which
+ keeps track of class-categories, while all classes return a classOrganizer
+ from #organization, which keeps track of method categories of that class.
+ Since in ST/X, Smalltalk is a class, there is now a conflict.
+ To make a workaround possible, use #systemOrganization when porting
+ VW apps to ST/X to get the class-categories.
+ Read the documentation in SystemOrganizer for more info."
+
+ ^ SystemOrganizer for:nil
+
+ "Created: / 20.6.1998 / 12:24:02 / cg"
+ "Modified: / 20.6.1998 / 12:41:34 / cg"
! !
!Smalltalk class methodsFor:'system management-fileIn'!
-class methodsFor:'system management-fileIn'
-!
-
-"Created: 28.10.1995 / 17:06:28 / cg"
-!
-
-onstruct:'source') construct:aFileName) ]
-!
-
-"Created: 28.10.1995 / 17:06:36 / cg"
-!
-
-"Created: 28.10.1995 / 17:06:41 / cg"
-!
-
-"Modified: / 08-09-2006 / 19:21:16 / cg"
-!
-
-'source/TicTacToe.st' logged:false
- "
-!
-
-"Created: 28.10.1995 / 17:06:36 / cg"
-!
-
-"
+fileIn:aFileName
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ This method can load almost anything which makes sense:
+ .st - source files
+ .cls - binary smalltalk bytecode files
+ .so - binary compiled machine code class libraries
+ [.class - java bytecode -- soon to come]"
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:false
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st'
+ Smalltalk fileIn:'binary/TicTacToe.cls'
+ Smalltalk fileIn:'binary/TicTacToe.so'
+ "
+
+ "Created: 28.10.1995 / 17:06:28 / cg"
+!
+
+fileIn:aFileName inPackage:aPackageID
+ "read in the named file in a packages directory."
+
+ |dir|
+
+ dir := self getPackageDirectoryForPackage:aPackageID.
+ dir isNil ifTrue:[^ false].
+
+ dir := dir asFilename.
+ ^ (self fileIn:(dir construct:aFileName))
+ or:[ self fileIn:((dir construct:'source') construct:aFileName) ]
+!
+
+fileIn:aFileName lazy:lazy
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ If lazy is true, no code is generated for methods, instead stubs
+ are created which compile themself when first executed. This allows
+ for much faster fileIn (but slows down the first execution later).
+ Since no syntax checks are done when doing lazy fileIn, use this only for
+ code which is known to be syntactically correct."
+
+ ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' lazy:true
+ "
+
+ "Created: 28.10.1995 / 17:06:36 / cg"
+!
+
+fileIn:aFileName lazy:lazy silent:silent
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ If lazy is true, no code is generated for methods, instead stubs
+ are created which compile themself when first executed. This allows
+ for much faster fileIn (but slows down the first execution later).
+ Since no syntax checks are done when doing lazy fileIn, use this only for
+ code which is known to be syntactically correct.
+ If silent is true, no compiler messages are output to the transcript.
+ Giving nil for silent/lazy will use the current settings."
+
+ ^ self fileIn:aFileName lazy:lazy silent:silent logged:false
+
+ "Created: 28.10.1995 / 17:06:41 / cg"
+!
+
+fileIn:aFileNameOrString lazy:lazy silent:silent logged:logged
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ If lazy is true, no code is generated for methods, instead stubs
+ are created which compile themself when first executed. This allows
+ for much faster fileIn (but slows down the first execution later).
+ Since no syntax checks are done when doing lazy fileIn, use this only for
+ code which is known to be syntactically correct.
+ 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]"
+
+ |fileNameString aStream path morePath bos|
+
+ fileNameString := aFileNameOrString asString.
+
+ "
+ an object or shared object ?
+ "
+ (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
+ ].
+
+ (fileNameString asFilename hasSuffix:'cls') ifTrue:[
+ BinaryObjectStorage notNil ifTrue:[
+ aStream := self systemFileStreamFor:fileNameString.
+"/ path := self getBinaryFileName:fileNameString.
+"/ path isNil ifTrue:[^ false].
+"/ aStream := path asFilename readStream.
+ aStream notNil ifTrue:[
+ aStream binary.
+ bos := BinaryObjectStorage onOld:aStream.
+ bos next.
+ bos close.
+ ^ true
+ ].
+ ^ false
+ ]
+ ].
+
+ aStream := self systemFileStreamFor:fileNameString.
+ aStream isNil ifTrue:[^ false].
+
+ (fileNameString includes:$/) ifTrue:[
+ "/ temporarily prepend the files directory
+ "/ to the searchPath.
+ "/ This allows fileIn-driver files to refer to local
+ "/ files via a relative path, and drivers to fileIn other
+ "/ drivers ...
+ morePath := aStream pathName asFilename directoryName.
+ ].
+ ^ self fileInStream:aStream lazy:lazy silent:silent logged:logged addPath:morePath
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' lazy:true silent:true
+ "
+
+ "Modified: / 08-09-2006 / 19:21:16 / cg"
+!
+
+fileIn:aFileName logged:logged
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ The argument logged controls, if the changefile is to be updated."
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:logged
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' logged:false
+ "
+!
+
+fileIn:aFileName silent:silent
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ If silent is true, no compiler messages are output to the transcript."
+
+ ^ self fileIn:aFileName lazy:nil silent:silent logged:false
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' silent:true
+ "
+
+ "Created: 28.10.1995 / 17:06:36 / cg"
+!
+
+fileInChanges
+ "read in the last changes file - bringing the system to the state it
+ had when left the last time.
+ WARNING: this method is rubbish: it should only read things after the
+ last '**snapshot**' - entry
+ (instead of the complete changes file)."
+
+ "
+ do NOT update the changes file now ...
+ "
+ self fileIn:ChangeFileName logged:false
+
+ "
Smalltalk fileInChanges
"
!
-"Modified: / 9.1.1998 / 14:41:46 / cg"
-!
-
-"Modified: 10.9.1996 / 20:43:52 / cg"
-!
-
-"Modified: / 9.1.1998 / 14:42:02 / cg"
-!
-
-"Modified: / 9.1.1998 / 14:42:19 / cg"
-!
-
-"Modified: / 9.1.1998 / 14:42:28 / cg"
-!
-
-"Created: / 08-01-2007 / 10:06:09 / cg"
-!
-
-"Modified: / 5.6.1999 / 14:53:01 / cg"
-!
-
-"Modified: 8.1.1997 / 17:58:56 / cg"
-!
-
-"Modified: 8.1.1997 / 17:58:56 / cg"
-!
-
-y:nil silent:nil logged:false addPath:nil
-!
-
-"Modified: 5.11.1996 / 20:03:35 / cg"
-!
-
-"Modified: / 23-08-2006 / 15:54:46 / cg"
-!
-
-"Modified: 31.10.1996 / 16:57:24 / cg"
-!
-
-:= self fileIn:aFileName ].
+fileInClass:aClassName
+ "find a source/object file for aClassName and -if found - load it.
+ search is in some standard places trying driver-file (.ld), object-file (.o) and
+ finally source file (.st) in that order.
+ The file is first searched for using the class name, then the abbreviated name."
+
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:true
+ lazy:false
+ silent:nil
+
+ "Modified: / 9.1.1998 / 14:41:46 / cg"
+!
+
+fileInClass:aClassName fromObject:aFileName
+ "read in the named object file and dynamic-link it into the system
+ - look for it in some standard places.
+ Only install the named class from this object file.
+ Return true if ok, false if failed."
+
+ |path ok|
+
+ "
+ check if the dynamic loader class is in
+ "
+ (LoadBinaries not or:[ObjectFileLoader isNil]) ifTrue:[^ false].
+
+ (path := self getBinaryFileName:aFileName) isNil ifTrue:[^ false].
+ ok := (ObjectFileLoader loadClass:aClassName fromObjectFile:path) notNil.
+ ok ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript show:' loaded ' , aClassName , ' from ' ; showCR:aFileName.
+ ]
+ ].
+ ^ ok
+
+ "
+ Smalltalk fileInClass:'AbstractPath' fromObject:'../../goodies/Paths/AbstrPath.so'
+ Smalltalk fileInClass:'ClockView' fromObject:'../../libwidg3/libwidg3.so'
+ "
+
+ "Modified: 10.9.1996 / 20:43:52 / cg"
+!
+
+fileInClass:aClassName initialize:doInit
+ "find a source/object file for aClassName and -if found - load it.
+ search is in some standard places trying driver-file (.ld), object-file (.o) and
+ finally source file (.st) in that order.
+ The file is first searched for using the class name, then the abbreviated name."
+
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:false
+ silent:nil
+
+ "Modified: / 9.1.1998 / 14:42:02 / cg"
+!
+
+fileInClass:aClassName initialize:doInit lazy:loadLazy
+ "find a source/object file for aClassName and -if found - load it.
+ search is in some standard places trying driver-file (.ld), object-file (.o) and
+ finally source file (.st) in that order.
+ The file is first searched for using the class name, then the abbreviated name."
+
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:loadLazy
+ silent:nil
+
+ "Modified: / 9.1.1998 / 14:42:19 / cg"
+!
+
+fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
+ "find a source/object file for aClassName and -if found - load it.
+ Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
+ finally source file (.st), in that order.
+ The file is first searched for using the class name, then the abbreviated name.
+ The argument doInit controlls if the class should be sent a #initialize after the
+ load; loadLazy tells if it should be loaded lazyly. beSilent tells if the compiler
+ should not send notes to the transcript; it can be true, false or nil, where
+ nil uses the value from SilentLoading."
+
+ ^ self
+ fileInClass:aClassName
+ package:nil
+ initialize:doInit
+ lazy:loadLazy
+ silent:beSilent
+
+ "Modified: / 9.1.1998 / 14:42:28 / cg"
+!
+
+fileInClass:aClassName package:package
+ "find a source/object file for aClassName and -if found - load it.
+ search is in some standard places trying driver-file (.ld), object-file (.o) and
+ finally source file (.st) in that order.
+ The file is first searched for using the class name, then the abbreviated name."
+
+ ^ self
+ fileInClass:aClassName
+ package:package
+ initialize:true
+ lazy:false
+ silent:nil
+
+ "Created: / 08-01-2007 / 10:06:09 / cg"
+!
+
+fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
+ "find a source/object file for aClassName and -if found - load it.
+ This is the workhorse for autoloading.
+ Search is in some standard places, trying driver-file (.ld), object-file (.so / .o) and
+ finally source file (.st), in that order.
+ The file is first searched for using the class name, then the abbreviated name.
+ The argument doInit controlls if the class should be sent a #initialize after the
+ load; loadLazy tells if it should be loaded lazyly. beSilent tells if the compiler
+ should not send notes to the transcript; it can be true, false or nil, where
+ nil uses the value from SilentLoading."
+
+ |classFileName alternativeClassFileName libName newClass ok wasLazy wasSilent sharedLibExtension inStream mgr
+ filenameToSet packageDir packageFile bos|
+
+ 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 fileIn:(classFileName,'.st') lazy:loadLazy silent:beSilent.
+ ]
+ ] ifFalse:[
+ classFileName := classFileName copyReplaceAll:$: with:$_.
+ [
+ Class withoutUpdatingChangesDo:[
+ |zarFn zar entry|
+
+ ok := false.
+
+ package notNil ifTrue:[
+ packageDir := package asString.
+ packageDir := packageDir copyReplaceAll:$: with:$/.
+ ].
+
+ Class packageQuerySignal answer:package do:[
+ "
+ then, if dynamic linking is available,
+ "
+ (LoadBinaries and:[ObjectFileLoader notNil]) ifTrue:[
+ sharedLibExtension := ObjectFileLoader sharedLibraryExtension.
+ "
+ first look for a class packages shared binary in binary/xxx.o
+ "
+ libName := self libraryFileNameOfClass:aClassName.
+ libName notNil ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(libName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(libName, '.o')
+ ]
+ ].
+ ].
+ "
+ then, look for a shared binary in binary/xxx.o
+ "
+ ok ifFalse:[
+ (ok := self fileInClass:aClassName fromObject:(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 , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , classFileName , '.cls').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , alternativeClassFileName , '.cls').
+ ].
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ]
+ ].
+
+ zarFn := self getPackageFileName:(packageDir , '/classes.zip').
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(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 , '.st'.
+ (ok := self fileIn:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := alternativeClassFileName , '.st'.
+ ok := self fileIn:filenameToSet lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source/' , classFileName , '.st'.
+ (ok := self fileIn:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source/' , alternativeClassFileName , '.st'.
+ ok := self fileIn: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 getPackageFileName:(packageDir , '/source/' , classFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , classFileName , '.st').
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , alternativeClassFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , alternativeClassFileName , '.st').
+ ].
+ filenameToSet := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ packageFile := self getPackageFileName:(packageDir , '/' , classFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , classFileName , '.st').
+ ].
+ filenameToSet := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/' , alternativeClassFileName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , alternativeClassFileName , '.st').
+ ].
+ filenameToSet := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ filenameToSet := 'source/' , packageDir , '/' , classFileName , '.st'.
+ (ok := self fileIn:filenameToSet lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ alternativeClassFileName notNil ifTrue:[
+ filenameToSet := 'source/' , packageDir , '/' , alternativeClassFileName , '.st'.
+ ok := self fileIn: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 asFilename withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ zarFn notNil 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.
+ 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
+
+ "Created: / 9.1.1998 / 14:40:32 / cg"
+ "Modified: / 5.6.1999 / 14:53:01 / cg"
+!
+
+fileInClassLibrary:aClassLibraryName
+ "find an object file containing a binary class library in some standard places
+ and load it. This install all of its contained classes.
+ Return true if ok, false if not.
+ Notice: the argument may not have an extension (by purpose);
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
+
+ |path fn|
+
+ ObjectFileLoader isNil ifTrue:[^ false].
+
+ fn := aClassLibraryName asFilename withSuffix:(ObjectFileLoader sharedLibrarySuffix).
+ fn := fn pathName.
+
+ path := self getBinaryFileName:fn.
+ path isNil ifTrue:[
+ path := self getSystemFileName:fn.
+ ].
+ path isNil ifTrue:[^ false].
+
+ ^ (ObjectFileLoader loadObjectFile:path) notNil
+
+ "
+ Smalltalk fileInClassLibrary:'libtable'
+ Smalltalk fileInClassLibrary:'binary/libwidg3'
+ "
+
+ "Modified: 8.1.1997 / 17:58:56 / cg"
+!
+
+fileInClassLibrary:aClassLibraryName inPackage:packageID
+ "find an object file containing a binary class library in some standard places
+ and load it. This installs all of its contained classes.
+ Return true if ok, false if not.
+ Notice: the argument may not have an extension (by purpose);
+ the sharedLib extension (.dll / .so / .sl) is added here, to
+ make the caller independent of the underlying operatingSystem."
+
+ |path baseName handle|
+
+ ObjectFileLoader isNil ifTrue:[^ false].
+
+ baseName := aClassLibraryName asFilename withSuffix:(ObjectFileLoader sharedLibrarySuffix).
+ baseName exists ifTrue:[
+ "/ load local file first...
+ handle := (ObjectFileLoader loadObjectFile:baseName).
+ handle notNil ifTrue:[^ true].
+ ].
+
+ path := self getPackageDirectoryForPackage:packageID.
+ path isNil ifTrue:[^ false].
+ path := path asFilename construct:baseName.
+ path exists ifFalse:[^ false].
+
+ ^ (ObjectFileLoader loadObjectFile:path pathName) notNil
+
+ "
+ Smalltalk fileInClassLibrary:'libtable'
+ Smalltalk fileInClassLibrary:'binary/libwidg3'
+ Smalltalk fileInClassLibrary:'refactoryBrowser' inPackage:'stx:goodies/refactoryBrowser'
+ "
+
+ "Modified: 8.1.1997 / 17:58:56 / cg"
+!
+
+fileInStream:streamArg
+ ^ self fileInStream:streamArg lazy:nil silent:nil logged:false addPath:nil
+!
+
+fileInStream:streamArg lazy:lazy silent:silent logged:logged addPath:morePath
+ "read sourceCode from aStream;
+ return true if ok, false if failed.
+ If lazy is true, no code is generated for methods, instead stubs
+ are created which compile themself when first executed. This allows
+ for much faster fileIn (but slows down the first execution later).
+ Since no syntax checks are done when doing lazy fileIn, use this only for
+ code which is known to be syntactically correct.
+ If silent is true, no compiler messages are output to the transcript.
+ Giving nil for silent/lazy will use the current settings.
+ If morePath is nonNil, it is prepended to the systemPath temporarily during the
+ fileIn. This allows for st-expressions to refer to more files (i.e. fileIn more)
+ using a relative path."
+
+ |inStream decoder wasLazy wasSilent oldSystemPath oldRealPath encoding|
+
+ inStream := streamArg.
+ inStream isNil ifTrue:[^ false].
+
+ encoding := CharacterEncoder guessEncodingOfStream:inStream.
+ encoding notNil ifTrue:[
+ decoder := CharacterEncoder encoderFor:encoding.
+ inStream := EncodedStream stream:inStream encoder:decoder.
+ inStream skipEncodingChunk.
+ ].
+
+ lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
+ silent notNil ifTrue:[wasSilent := self silentLoading:silent].
+ morePath notNil ifTrue:[
+ oldSystemPath := SystemPath copy.
+ SystemPath addFirst:morePath.
+ oldRealPath := RealSystemPath.
+ RealSystemPath := nil.
+ ].
+ [
+ (Class updateChangeFileQuerySignal , Class updateChangeListQuerySignal) answer:logged do:[
+ inStream fileIn.
+ ]
+ ] ensure:[
+ morePath notNil ifTrue:[
+ "take care, someone could have changed SystemPath during fileIn!!"
+ (SystemPath copyFrom:2) = oldSystemPath ifTrue:[
+ SystemPath := oldSystemPath.
+ RealSystemPath := oldRealPath.
+ ] ifFalse:[
+ (oldSystemPath includes:morePath) ifFalse:[
+ SystemPath remove:morePath ifAbsent:[].
+ ].
+ RealSystemPath := nil.
+ ].
+ ].
+ lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
+ silent notNil ifTrue:[self silentLoading:wasSilent].
+ inStream close
+ ].
+ ^ true
+
+ "
+ Smalltalk fileInStream:('source/TicTacToe.st' asFilename readStream) lazy:true silent:true
+ "
+
+ "Modified: 5.11.1996 / 20:03:35 / cg"
+!
+
+isClassLibraryLoaded:name
+ "return true, if a particular class library is already loaded"
+
+ ObjectMemory
+ binaryModuleInfo
+ do:[:entry |
+ entry type == #classLibrary ifTrue:[
+ entry libraryName = name ifTrue:[
+ ^ true "/ already loaded
+ ]
+ ].
+ ].
+
+ ^ false
+
+ "
+ Smalltalk isClassLibraryLoaded:'libstx_libbasic'
+ Smalltalk isClassLibraryLoaded:'libstx_libwidg3'
+ Smalltalk isClassLibraryLoaded:'libstx_libboss'
+ "
+
+ "Modified: / 23-08-2006 / 15:54:46 / cg"
+!
+
+loadClassLibraryIfAbsent:name
+ "dynamically load a classLibrary, if not already loaded
+ and the system supports dynamic loading.
+ Return true, if the library is loaded, false if not.
+ This entry is called without system specific filename
+ extensions - it is portable among different architectures
+ as long as corresponding files (x.so / x.dll / x.sl / x.o)
+ are be present ..."
+
+ (self isClassLibraryLoaded:name) ifTrue:[ ^ true ]. "/ already loaded
+ ^ self fileInClassLibrary:name
+
+ "
+ Smalltalk loadClassLibraryIfAbsent:'libbasic'
+ Smalltalk loadClassLibraryIfAbsent:'libwidg3'
+ "
+
+ "Modified: 31.10.1996 / 16:57:24 / cg"
+!
+
+secureFileIn:aFileName
+ "read in the named file, looking for it at standard places.
+ Catch any error during fileIn. Return true if ok, false if failed"
+
+ |retVal|
+
+ retVal := false.
+ (SignalSet with:AbortOperationRequest with:TerminateProcessRequest)
+ handle:[:ex | ex return ]
+ do:[ retVal := self fileIn:aFileName ].
^ retVal
+!
+
+silentFileIn:aFilename
+ "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
+ Main use is during startup."
+
+ |wasSilent|
+
+ wasSilent := self silentLoading:true.
+ [
+ self fileIn:aFilename
+ ] ensure:[
+ self silentLoading:wasSilent
+ ]
! !
!Smalltalk class methodsFor:'system management-files'!
-class methodsFor:'system management-files'
-!
-
-lename readStreamOrNil
+bitmapFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'bitmaps' in the SystemPath.
+ Notice: this does not look in the package-specific bitmaps directories."
+
+ |aString|
+
+ aString := self getBitmapFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
+ ].
+ ^ nil
+!
+
+bitmapFromFileNamed:aFileName forClass:aClass
+ "backward compatibility:
+ search aFileName in some standard places:
+ first in the redefinable bitmaps path,
+ then in the classes own package directory if existing.
+ Return an image or nil."
+
+ ^ self imageFromFileNamed:aFileName forClass:aClass
+
+ "
+ Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' forClass:View
+ "
+!
+
+bitmapFromFileNamed:aFileName inPackage:aPackage
+ "backward compatibility:
+ search aFileName in some standard places:
+ first in the redefinable bitmaps path,
+ then in the package directory if existing.
+ Return an image or nil."
+
+ ^ self imageFromFileNamed:aFileName inPackage:aPackage
+
+ "
+ Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+ Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ "
+!
+
+classNameForFile:aFileName
+ "return the className which corresponds to an abbreviated fileName,
+ or nil if no special translation applies. The given filename arg may
+ include a '.st' suffix (but no other)."
+
+ |fn|
+
+ (aFileName asFilename hasSuffix:'st') ifTrue:[
+ fn := aFileName copyWithoutLast:3
+ ] ifFalse:[
+ fn := aFileName
+ ].
+ ^ self filenameAbbreviations keyAtEqualValue:fn ifAbsent:[fn].
+
+ "
+ Smalltalk classNameForFile:'DrawObj'
+ Smalltalk classNameForFile:'DrawObj.st'
+ Smalltalk classNameForFile:'ArrColl.st'
+ Smalltalk classNameForFile:'ArrColl.chg'
+ "
+
+ "Modified: 11.12.1995 / 14:51:10 / cg"
+!
+
+constructPathFor:aDirectoryName
+ "search for aDirectory in SystemPath;
+ return a collection of pathes which include that directory."
+
+ ^ self realSystemPath select:[:dirName |
+ |fullPath|
+
+ fullPath := dirName asFilename construct:aDirectoryName.
+ "/ fullPath exists and:[fullPath isDirectory and:[fullPath isReadable]]
+ fullPath isDirectory and:[fullPath isReadable]
+ ].
+!
+
+fileInFileStreamFor:aFileName
+ "obsolete
+ search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'fileIn' in SystemPath"
+
+ |aString|
+
+ aString := self getFileInFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
-med:'SmalltalkX.xbm' forClass:View
- "
-!
-
-talkX.xbm' inPackage:'stx:libtool'
- "
-!
-
-"Modified: 11.12.1995 / 14:51:10 / cg"
-!
-
-rectory and:[fullPath isReadable]
- ].
-!
-
-lename readStreamOrNil
+fileNameForClass:aClassOrClassName
+ "return a filename for aClassOrClassName"
+
+ |cls nonMetaclass nm nm1 nm2|
+
+ aClassOrClassName isBehavior ifTrue:[
+ nonMetaclass := aClassOrClassName theNonMetaclass.
+ nm1 := nonMetaclass name.
+ nm2 := nonMetaclass nameWithoutPrefix.
+ ] ifFalse:[
+ cls := Smalltalk classNamed:aClassOrClassName.
+ cls notNil ifTrue:[
+ nonMetaclass := cls theNonMetaclass.
+ nm := nonMetaclass getClassFilename.
+ nm notNil ifTrue:[^ nm asFilename withoutSuffix baseName].
+ nm1 := nonMetaclass name.
+ nm2 := nonMetaclass nameWithoutPrefix.
+ ] ifFalse:[
+ nm1 := aClassOrClassName.
+ nm2 := (aClassOrClassName copyFrom:(aClassOrClassName lastIndexOf:$:)+1).
+ ].
+ ].
+ nm1 := nm1 asSymbol.
+ nm2 := nm2 asSymbol.
+
+ CachedAbbreviations notNil ifTrue:[
+ (CachedAbbreviations includesKey:nm1) ifTrue:[
+ ^ (CachedAbbreviations at:nm1) asFilename baseName
+ ].
+ (CachedAbbreviations includesKey:nm2) ifTrue:[
+ ^ (CachedAbbreviations at:nm2) asFilename baseName
+ ].
+ ].
+ ^ nm1 copyReplaceAll:$: with:$_
+
+ "
+ Smalltalk fileNameForClass:#Complex
+ Smalltalk fileNameForClass:'SmallInteger'
+ Smalltalk fileNameForClass:'UnixOperatingSystem'
+ Smalltalk fileNameForClass:'Launcher'
+ Smalltalk fileNameForClass:'SomeUnknownClass'
+ Smalltalk fileNameForClass:OSI::FTAMOperation
+ Smalltalk fileNameForClass:'OSI::Foobar'
+ "
+
+ "Modified: / 06-10-2006 / 16:16:01 / cg"
+!
+
+filenameAbbreviations
+ "return a dictionary containing the classname-to-filename
+ mappings. (needed for sys5.3 users, where filenames are limited
+ to 14 chars)"
+
+ CachedAbbreviations isNil ifTrue:[
+ self readAbbreviations
+ ].
+ ^ CachedAbbreviations
+
+ "flush with:
+
+ CachedAbbreviations := nil
+ "
+ "
+ Smalltalk filenameAbbreviations
+ "
+!
+
+flushPathCaches
+ "{ Pragma: +optSpace }"
+
+ "forget pathCaches - these are collections containing valid directory names,
+ where system files (resource, bitmaps etc.) are found.
+ A flush is only required, if a new system directory has been created while
+ the system is active, and those files should override the others
+ (for example, if you created a private resource directory)"
+
+ RealSystemPath := ResourcePath := SourcePath :=
+ BinaryPath := FileInPath := nil
+
+ "
+ Smalltalk flushPathCaches
+ "
+!
+
+getBinaryFileName:aFileName
+ "obsolete
+ search aFileName in some standard places
+ (subdirectories named 'binary' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ BinaryPath isNil ifTrue:[
+ BinaryPath := self constructPathFor:BinaryDirName
+ ].
+
+ ^ self searchPath:BinaryPath for:aFileName in:BinaryDirName
+
+ "Modified: 18.7.1996 / 15:53:49 / cg"
+!
+
+getBitmapFileName:aFileName
+ "for backward compatibility:
+ search aFileName in some standard places
+ (subdirectories named 'bitmaps' in SystemPath);
+ Return the pathName or nil if none is found."
+
+ ^ self getBitmapFileName:aFileName forPackage:nil
+
+ "
+ Smalltalk getBitmapFileName:'SBrowser.xbm'
+ "
+
+ "Modified: 18.7.1996 / 15:53:55 / cg"
+!
+
+getBitmapFileName:aFileName forPackage:aPackageIDOrNil
+ "for backward compatibility.
+ search aFileName in some standard places:
+ first in the redefinable bitmaps path,
+ then in the package directory if existing.
+ Return a path or nil.
+ Search order is:
+ bitmaps/<pkg>/file
+ resources/<pkg>/bitmaps/file
+ <pkg>/bitmaps/file
+ "
+
+ |f dir packageDir pF|
+
+ ((f := aFileName asString) startsWith:'bitmaps/') ifTrue:[
+ f := f copyFrom:('bitmaps/' size + 1).
+ ].
+
+ aPackageIDOrNil isNil ifTrue:[
+ "/ this will be an error in the future
+"/ 'Smalltalk [warning]: bitmap file access without package: ' infoPrint. aFileName infoPrintCR.
+"/ self halt.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ f ~= aFileName ifTrue:[
+ pF := self searchPath:(self realSystemPath) for:f in:('bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ ].
+ ^ nil
+ ].
+
+ packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('bitmaps/',packageDir).
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir,'/bitmaps').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+
+ dir := self projectDirectoryForPackage:aPackageIDOrNil.
+ dir notNil ifTrue:[
+ pF := (dir asFilename construct:'bitmaps') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
+ ].
+ ^ nil
+
+ "
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
+ Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
+ "
+
+ "Modified: / 11-10-2006 / 13:53:18 / cg"
+!
+
+getFileInFileName:aFileName
+ "obsolete
+ search aFileName in some standard places
+ (subdirectories named 'fileIn' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ FileInPath isNil ifTrue:[
+ FileInPath := self constructPathFor:FileInDirName
+ ].
+
+ ^ self searchPath:FileInPath for:aFileName in:FileInDirName
+
+ "Modified: 18.7.1996 / 15:53:59 / cg"
+!
+
+getPackageDirectoryForPackage:aPackageID
+ "search for a particular package; return its directory, or nil.
+ Stand alone applications might get nil, if there are only binaries installed."
+
+ |checkForPackageDirectory module packageSubDirectory|
+
+ module := aPackageID asPackageId module.
+ packageSubDirectory := aPackageID asPackageId directory.
+
+ checkForPackageDirectory :=
+ [:moduleDir |
+ |packageDir|
+
+ (moduleDir exists and:[moduleDir isDirectory]) ifTrue:[
+ packageDir := moduleDir construct:packageSubDirectory.
+ (packageDir exists and:[packageDir isDirectory]) ifTrue:[
+ ^ packageDir
+ ]
+ ].
+ ].
+
+ self packagePath do:[:aPath |
+ |moduleDir|
+
+ moduleDir := aPath asFilename construct:module.
+ checkForPackageDirectory value:moduleDir.
+ ].
+
+ "/ not found - special case for the stx package...
+ module = 'stx' ifTrue:[
+ checkForPackageDirectory value:('../../' asFilename).
+ ].
+
+ ^ nil
+
+ "
+ Smalltalk getPackageDirectoryForPackage:(Array package)
+ Smalltalk getPackageDirectoryForPackage:'stx:goodies/bitmaps'
+ Smalltalk getPackageDirectoryForPackage:'stx:libview'
+ "
+
+ "Modified: / 06-10-2006 / 11:49:27 / cg"
+!
+
+getPackageFileName:aFileName
+ "search aFileName in some standard places
+ (packagePath and subdirectories named 'packages' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ |f|
+
+ "/ search along packagePath ...
+ f := self searchPath:self packagePath for:aFileName in:nil.
+ f isNil ifTrue:[
+ "/ search under packages-directory along systemPath ...
+ f := self searchPath:self realSystemPath for:aFileName in:PackageDirName.
+ "/ kludge - allow for stx-directory to be named differently
+ f isNil ifTrue:[
+ (aFileName startsWith:'stx') ifTrue:[
+ (aFileName startsWith:'stx' , Filename separator) ifTrue:[
+ f := '../..' asFilename construct:(aFileName copyFrom:5).
+ f exists ifTrue:[
+ ^ f pathName
+ ].
+ ]
+ ].
+ ].
+ ].
+ (f notNil and:[(f := f asFilename) exists]) ifTrue:[
+ ^ f pathName
].
^ nil
-!
-
-"Modified: / 06-10-2006 / 16:16:01 / cg"
-!
-
-Smalltalk filenameAbbreviations
- "
-!
-
-"
- Smalltalk flushPathCaches
- "
-!
-
-"Modified: 18.7.1996 / 15:53:49 / cg"
-!
-
-"Modified: 18.7.1996 / 15:53:55 / cg"
-!
-
-"Modified: / 11-10-2006 / 13:53:18 / cg"
-!
-
-"Modified: 18.7.1996 / 15:53:59 / cg"
-!
-
-"Modified: / 06-10-2006 / 11:49:27 / cg"
-!
-
-eFileName:'stx/libview/source.zip'
- "
-!
-
-"Modified: 18.7.1996 / 15:54:03 / cg"
-!
-
-Browser.rs' forClass:SystemBrowser
- "
-!
-
-"Modified: / 11-10-2006 / 13:53:43 / cg"
-!
-
-"Modified: 18.7.1996 / 15:54:07 / cg"
-!
-
-"Modified: / 6.5.1999 / 10:40:37 / cg"
-!
-
-med:'SmalltalkX.xbm' forClass:View
- "
-!
-
-"Modified: / 08-09-2006 / 18:02:04 / cg"
-!
-
-"Modified: 6.11.1995 / 15:41:39 / cg"
-!
-
-ddFirst:'/usr/local/otherPackages'
- "
-!
-
-ltalk' '/usr/local/otherPackages')
- "
-!
-
-talk projectDirectoryForClass:View
- "
-!
-
-"Modified: / 07-10-2006 / 17:45:58 / cg"
-!
-
-"Modified: / 10.12.1999 / 17:48:53 / cg"
-!
-
-"Modified: / 13.12.1999 / 11:54:17 / cg"
-!
-
-:= nP.
+
+ "
+ Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
+ Smalltalk getPackageFileName:'stx/libview/source.zip'
+ "
+!
+
+getResourceFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'resources' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ ^ self getResourceFileName:aFileName forPackage:nil
+
+ "
+ Smalltalk getResourceFileName:'SystemBrowser.rs'
+ "
+
+ "Modified: 18.7.1996 / 15:54:03 / cg"
+!
+
+getResourceFileName:aFileName forClass:aClassOrNil
+ "search aFileName in some standard places
+ (subdirectories named 'resource' in SystemPath);
+ and in aClasses package directory.
+ Return the absolute filename or nil if none is found."
+
+ |pkgOrNil|
+
+ aClassOrNil notNil ifTrue:[
+ pkgOrNil := aClassOrNil package.
+ ].
+ ^ self getResourceFileName:aFileName forPackage:pkgOrNil.
+
+ "
+ Smalltalk getResourceFileName:'SystemBrowser.rs' forClass:SystemBrowser
+ "
+!
+
+getResourceFileName:aFileName forPackage:aPackageIDOrNil
+ "search aFileName in some standard places
+ (subdirectories named 'resource' in SystemPath);
+ and in a packages directory.
+ Return the absolute filename or nil if none is found.
+ Search order is:
+ resources/<pkg>/file
+ <pkg>/resources/file
+ "
+
+ |pF f dir packageDir|
+
+ ((f := aFileName asString) startsWith:'resources/') ifTrue:[
+ f := aFileName copyFrom:('resources/' size + 1).
+ ].
+
+ aPackageIDOrNil isNil ifTrue:[
+ "/ this will be an error in the future
+"/ 'Smalltalk [warning]: resource file access without package: ' infoPrint. aFileName infoPrintCR.
+"/ self halt.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ f ~= aFileName ifTrue:[
+ pF := self searchPath:(self realSystemPath) for:f in:('resources').
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+ ].
+ ^ nil
+ ].
+
+ packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
+
+ pF := self searchPath:(self realSystemPath) for:aFileName in:('resources/',packageDir).
+ pF notNil ifTrue:[
+ ^ pF.
+ ].
+
+ dir := self projectDirectoryForPackage:aPackageIDOrNil.
+ dir notNil ifTrue:[
+ pF := (dir asFilename construct:'resources') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
+ pF := (dir asFilename construct:'styles') constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
+ "resolve something like: 'ASN/definition.asn1'"
+ pF := dir asFilename constructString:f.
+ pF asFilename exists ifTrue:[
+ ^ pF.
+ ].
+ ].
+ ^ nil
+
+ "
+ Smalltalk getResourceFileName:'SystemBrowser.rs' forPackage:'stx:libtool'
+ Smalltalk getResourceFileName:'normal.style' forPackage:'stx:libview'
+ Smalltalk getResourceFileName:'mswindowsXP.style' forPackage:'stx:libview'
+ Smalltalk getResourceFileName:'Foo.rs' forPackage:'stx:libview'
+ "
+
+ "Modified: / 11-10-2006 / 13:53:43 / cg"
+!
+
+getSourceFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'source' in SystemPath);
+ return the absolute filename or nil if none is found.
+ This is used to find a sourceFile for a methods source,
+ if no sourceCodeManager is available."
+
+ |f|
+
+ SourcePath isNil ifTrue:[
+ SourcePath := self constructPathFor:SourceDirName
+ ].
+
+ "/ first, try a source subdir along the path.
+ SourcePath notNil ifTrue:[
+ f := self searchPath:SourcePath for:aFileName in:SourceDirName.
+ ].
+ f isNil ifTrue:[
+ "/ then, try it itself along the path.
+ f := self searchPath:self realSystemPath for:aFileName in:nil
+ ].
+ ^ f
+
+ "
+ Smalltalk getSourceFileName:'Smalltalk.st'
+ Smalltalk getSourceFileName:'ArrColl.st'
+ "
+
+ "Modified: 18.7.1996 / 15:54:07 / cg"
+!
+
+getSystemFileName:aFileNameOrString
+ "search aFileNameOrString in some standard places;
+ return the absolute filename or nil if none is found.
+ see comment in Smalltalk>>initSystemPath.
+ This should be used to access resources such as bitmaps, doc-files,
+ and other help files.
+ "
+
+ "credits for this method go to Markus ...."
+
+ |fn nameString|
+
+ fn := aFileNameOrString asFilename.
+ nameString := fn name.
+ fn isAbsolute ifTrue:[
+ "dont use path for absolute file names"
+
+ ^ nameString
+ ].
+
+ self realSystemPath do:[:dirName |
+ |realName|
+
+ realName := dirName asFilename construct:nameString.
+ "/
+ "/ here, we also return true if its a directory
+ "/ (Even if unreadable).
+ "/ It could be that the file itself is still readable.
+ "/
+ (realName isDirectory or:[realName isReadable]) ifTrue: [
+ ^ realName name
+ ]
+ ].
+ ^ nil
+
+ "
+ Smalltalk getSystemFileName:'doc/online/english/TOP.html'
+ Smalltalk getSystemFileName:'bitmaps/SBrowser.xbm'
+ Smalltalk getSystemFileName:'bitmaps/foo'
+ Smalltalk getSystemFileName:'resources/View.rs'
+ Smalltalk getSystemFileName:'resources/iris.style'
+ "
+
+ "Modified: / 6.5.1999 / 10:40:37 / cg"
+!
+
+imageFromFileNamed:aFileName forClass:aClass
+ "search aFileName in some standard places:
+ first in the redefinable bitmaps path, then in the classes
+ own package directory if existing.
+ Return an image or nil."
+
+ |classPackage img|
+
+ classPackage := aClass package.
+ img := self imageFromFileNamed:aFileName inPackage:classPackage.
+ img isNil ifTrue:[
+ "/ try under the goodies package ...
+ classPackage ~= 'stx:goodies' ifTrue:[
+ img := self imageFromFileNamed:aFileName inPackage:'stx:goodies'.
+ ]
+ ].
+ ^ img
+
+ "
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' forClass:View
+ "
+!
+
+imageFromFileNamed:aFileName inPackage:aPackage
+ "search aFileName in some standard places:
+ first in the redefinable bitmaps path,
+ then in the package directory if existing.
+ Return an image or nil.
+ Search order is:
+ bitmaps/<pkg>/file
+ resources/<pkg>/bitmaps/file
+ <pkg>/bitmaps/file
+ "
+
+ |path|
+
+ path := self getBitmapFileName:aFileName forPackage:aPackage.
+ path notNil ifTrue:[
+ ^ Image fromFile:path.
+ ].
+ ^ nil
+
+ "
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+ Smalltalk imageFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
+ Smalltalk imageFromFileNamed:'bitmaps/gifImages/garfield.gif' inPackage:'stx:goodies'
+ Smalltalk imageFromFileNamed:'CheckOn10_xp.xpm' inPackage:'stx:libwidg'
+ Smalltalk imageFromFileNamed:'ComboDn_xp.xpm' inPackage:'stx:libwidg'
+ "
+
+ "Modified: / 08-09-2006 / 18:02:04 / cg"
+!
+
+libraryFileNameOfClass:aClassOrClassName
+ "for a given class, return the name of a classLibrary which contains
+ binary code for it.
+ Read the libinfo file 'liblist.stc' (which is created during the compilation process)
+ for an entry for aClassOrClassName.
+ Search for the className in the first col, and return the value found in
+ the 2nd col.
+ Return nil if no entry is found.
+
+ A nil returns means that this class is either built-in or not present
+ in a package-class library (i.e. either as separate .o or separate .st file).
+ Otherwise, the returned name is the classLibrary object of that class.
+ The classes code can be loaded from that file if binary loading is supported."
+
+ |aStream line words n aClassName|
+
+ aClassOrClassName isBehavior ifTrue:[
+ aClassName := aClassOrClassName name
+ ] ifFalse:[
+ aClassName := aClassOrClassName
+ ].
+ aClassName := aClassName asString.
+
+ #('include/liblist.stc') "/ filenames
+ with:#(2) "/ column
+ do:[:fileName :col |
+
+ aStream := self systemFileStreamFor:fileName.
+ aStream notNil ifTrue:[
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+ words := line asCollectionOfWords.
+ (n := words size) > 1 ifTrue:[
+ (words at:1) = aClassName ifTrue:[
+ n >= col ifTrue:[
+ aStream close.
+ ^ (words at:col) withoutSeparators
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
+ ].
+ ].
+
+ ^ nil
+
+ "
+ Smalltalk libraryFileNameOfClass:'ClockView'
+ Smalltalk libraryFileNameOfClass:'Bag'
+ "
+
+ "Modified: 6.11.1995 / 15:41:39 / cg"
+!
+
+packagePath
+ "return a collection of additional directorynames, where smalltalk
+ looks for package directories.
+ Notice, that directories named 'packages' under the systemPath are
+ always consulted - even if not in the packagePath"
+
+ ^ PackagePath
+
+ "
+ Smalltalk packagePath
+ Smalltalk packagePath addLast:'/opt/smalltalk'
+ Smalltalk packagePath addFirst:'/usr/local/otherPackages'
+ "
+!
+
+packagePath:aPath
+ "set the packagePath;
+ a collection of additional directorynames, where smalltalk
+ looks for package directories.
+ Notice, that directories named 'packages' under the systemPath are
+ always consulted - even if not in the packagePath"
+
+ PackagePath := aPath asOrderedCollection
+
+ "
+ Smalltalk packagePath:#( '.' '/opt/stx' '/opt/smalltalk' '/usr/local/otherPackages')
+ "
+!
+
+projectDirectoryForClass:aClass
+ "given a class, return the path to its package directory;
+ nil if not found."
+
+ |pkg|
+
+ pkg := aClass package.
+ pkg isNil ifTrue:[^ nil].
+
+ ^ self projectDirectoryForPackage:pkg.
+
+ "
+ Smalltalk projectDirectoryForClass:Array
+ Smalltalk projectDirectoryForClass:View
+ "
+!
+
+projectDirectoryForPackage:aPackage
+ "given a packageID, return the path to its package directory;
+ nil if not found."
+
+ |prj prjDir|
+
+ "/ there might be a package specific resource directory ...
+ "/ in the directory, from which the project was loaded
+ prj := Project projectWithId:aPackage.
+ prj notNil ifTrue:[
+ prjDir := prj directory.
+ ].
+ (prjDir notNil and:[prjDir asFilename exists]) ifFalse:[
+ prjDir := Smalltalk getPackageFileName:(aPackage copyReplaceAll:$: with:$/).
+ ].
+ ^ prjDir
+
+ "
+ Smalltalk projectDirectoryForPackage:'stx:libbasic'
+ Smalltalk projectDirectoryForPackage:'exept:smartcard'
+ Smalltalk projectDirectoryForPackage:'stx'
+ Smalltalk projectDirectoryForPackage:'bosch'
+ "
+
+ "Modified: / 07-10-2006 / 17:45:58 / cg"
+!
+
+readAbbreviations
+ "read classname to filename mappings from include/abbrev.stc.
+ sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
+
+ "since installAutoloadedClasses also reads all abbreviations, use it"
+
+ CachedAbbreviations := IdentityDictionary new.
+ self installAutoloadedClasses.
+ ^ CachedAbbreviations.
+
+"/ |aStream f dirsConsulted|
+"/
+"/ CachedAbbreviations := IdentityDictionary new.
+"/
+"/ "/ new scheme: look for a directory called 'packages'
+"/ "/ and enumerate its abbrev.stc files...
+"/ dirsConsulted := Set new.
+"/ f := Smalltalk getSystemFileName:'packages'.
+"/ f notNil ifTrue:[
+"/ f := f asFilename.
+"/ f isDirectory ifTrue:[
+"/ ('Smalltalk [info]: reading all class abbreviations found under ''' , f pathName ,'''') infoPrintCR.
+"/ self recursiveReadAllAbbreviationsFrom:f.
+"/ dirsConsulted add:f pathName.
+"/ ].
+"/ ].
+"/
+"/ "/ and along the package-path
+"/ self packagePath do:[:aPath |
+"/ (dirsConsulted includes:aPath) ifFalse:[
+"/ ('Smalltalk [info]: reading all class abbreviations found under ''' , aPath ,'''') infoPrintCR.
+"/ self recursiveReadAllAbbreviationsFrom:aPath.
+"/ dirsConsulted add:aPath
+"/ ]
+"/ ].
+"/
+"/ "/ old scheme: look for a single file called 'abbrev.stc' in the
+"/ "/ include directory. This will vanish.
+"/
+"/ aStream := self systemFileStreamFor:'include/abbrev.stc'.
+"/ aStream notNil ifTrue:[
+"/ ('Smalltalk [info]: reading additional abbreviations from ''' , aStream pathName ,'''') infoPrintCR.
+"/ self readAbbreviationsFromStream:aStream.
+"/ aStream close.
+"/"/ ] ifFalse:[
+"/"/ ('Smalltalk [warning]: no global''include/abbrev.stc'' file found') infoPrintCR
+"/ ].
+"/ ^ CachedAbbreviations
+
+ "
+ Smalltalk readAbbreviations
+ "
+
+ "Modified: / 10.12.1999 / 17:48:53 / cg"
+!
+
+readAbbreviationsFromStream:aStream
+ "read classname to filename mappings from aStream.
+ sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
+
+ |line words nm abbrev pkg s w|
+
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+
+ "/ must do it manually, caring for quoted strings.
+"/ words := line asCollectionOfWords.
+
+ words := OrderedCollection new.
+ s := line readStream.
+ [s atEnd] whileFalse:[
+ s skipSeparators.
+ s peek == $' ifTrue:[
+ s next.
+ w := s upTo:$'.
+ s skipSeparators.
+ ] ifFalse:[
+ w := s upToSeparator
+ ].
+ words add:w
+ ].
+ words size >= 3 ifTrue:[
+ nm := (words at:1) withoutSeparators.
+ abbrev := (words at:2) withoutSeparators.
+ pkg := (words at:3) withoutSeparators.
+ self setFilename:abbrev forClass:nm package:pkg.
+ ] ifFalse:[
+ ('Smalltalk [warning]: malformed line in ' , (aStream pathName)) infoPrintCR.
+ ]
+ ]
+ ]
+ ].
+
+ "Modified: / 13.12.1999 / 11:54:17 / cg"
+!
+
+realSystemPath
+ "return the realSystemPath - thats the directorynames from
+ SystemPath which exist and are readable"
+
+ |nP|
+
+ RealSystemPath isNil ifTrue:[
+ OperatingSystem isVMSlike ifTrue:[
+ "/ temporary kludge: since we cannot currently
+ "/ check for existance of a name like 'volume:',
+ "/ leave those in the Path without a check.
+ RealSystemPath := SystemPath select:[:dirName |
+ |f|
+
+ f := dirName asFilename.
+ f isVolumeOnly ifTrue:[
+ true
+ ] ifFalse:[
+ (f isDirectory) and:[f isReadable]
+ ]
+ ]
+ ] ifFalse:[
+ RealSystemPath := SystemPath select:[:dirName |
+ |f|
+
+ f := dirName asFilename.
+ (f isDirectory) and:[f isReadable]
+ ].
+ RealSystemPath := RealSystemPath collect:[:dirName |
+ |f|
+
+ f := dirName asFilename pathName.
+ ].
+ "/ remove duplicates (but keep order)
+ nP := OrderedCollection new.
+ RealSystemPath do:[:p |
+ (nP includes:p) ifFalse:[
+ nP add:p
+ ]
+ ].
+ RealSystemPath := nP.
].
].
^ RealSystemPath
!
-AbbreviationsFrom:aDirectory maxLevels:15
-!
-
-axLevels:maxLevels-1
+recursiveReadAllAbbreviationsFrom:aDirectory
+ self recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:15
+!
+
+recursiveReadAllAbbreviationsFrom:aDirectory maxLevels:maxLevels
+ "read all abbreviations from and under aDirectory."
+
+ |abbrevStream dir directoryContents|
+
+ maxLevels == 0 ifTrue:[
+"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
+ ^ self
+ ].
+
+ dir := aDirectory asFilename.
+ dir exists ifFalse:[^ self].
+
+ [
+ abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+ self readAbbreviationsFromStream:abbrevStream.
+ abbrevStream close.
+ ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
+
+ [
+ directoryContents := dir directoryContents.
+ ] on:FileStream openErrorSignal do:[:ex|
+ "non-accessable directory: we are done"
+ ^ self
+ ].
+
+ directoryContents do:[:aFilename |
+ |f|
+
+ (#(
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ ) includes:aFilename) ifFalse:[
+ f := dir construct:aFilename.
+ f isDirectory ifTrue:[
+ self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
]
].
].
!
-ectoryForPackage:'exept:smartcard'
- "
-!
-
-ourceFileStreamFor:aFileName forClass:nil
-!
-
-lename readStreamOrNil
+resourceDirectoryForPackage:aPackage
+ "given a packageID, return the path to its resource directory;
+ nil if not found."
+
+ |prjDir rsrcDir|
+
+ prjDir := self projectDirectoryForPackage:aPackage.
+
+ (prjDir notNil
+ and:[(prjDir := prjDir asFilename) exists
+ and:[(rsrcDir := prjDir construct:'resources') exists]]) ifTrue:[
+ ^ rsrcDir
+ ].
+ rsrcDir := self getSystemFileName:('resources/' , (aPackage copyReplaceAll:$: with:$/)).
+ rsrcDir notNil ifTrue:[
+ ^ rsrcDir asFilename
+ ].
+ ^ nil
+
+ "
+ Smalltalk resourceDirectoryForPackage:'stx:libbasic'
+ Smalltalk resourceDirectoryForPackage:'exept:expecco'
+ Smalltalk resourceDirectoryForPackage:'exept:smartcard'
+ "
+!
+
+resourceFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'resource' in SystemPath"
+
+ ^ self resourceFileStreamFor:aFileName forClass:nil
+!
+
+resourceFileStreamFor:aFileName forClass:aClassOrNil
+ "search aFileName in some standard places and in the classes
+ package-resource directory.
+ Return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'resource' in SystemPath"
+
+ |aString|
+
+ aString := self getResourceFileName:aFileName forClass:aClassOrNil.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
-"Modified: / 29.4.1999 / 15:06:43 / cg"
-!
-
-assNameSymbol put:aFileNameString.
+searchPath:aPath for:aFileName in:aDirName
+ "search aPath for a subdirectory named aDirectory with a file
+ named aFileName"
+
+ |f|
+
+ ((f := aFileName asFilename) isAbsolute
+ or:[f isExplicitRelative]) ifTrue:[
+ "/
+ "/ dont use path for absolute or explicit .-relative file names
+ "/
+ ^ aFileName
+ ].
+
+ aPath notNil ifTrue:[
+ aPath do:[:dirName |
+ |realName dir|
+
+ dir := dirName asFilename.
+ aDirName notNil ifTrue:[
+ realName := (dir construct:aDirName) construct:aFileName.
+ ] ifFalse:[
+ realName := dir construct:aFileName.
+ ].
+ (realName isReadable) ifTrue:[
+ ^ realName name
+ ]
+ ].
+ ].
+
+ ^ nil.
+
+ "Modified: / 29.4.1999 / 15:06:43 / cg"
+!
+
+setFilename:aFileNameString forClass:aClassNameString package:aPackageNameString
+ |classNameSymbol oldAbbrev oldPath newPath cls abbrevs|
+
+ CachedAbbreviations isNil ifTrue:[
+ CachedAbbreviations := IdentityDictionary new.
+ ].
+
+ abbrevs := CachedAbbreviations.
+ aClassNameString ~= aFileNameString ifTrue:[
+ classNameSymbol := aClassNameString asSymbol.
+ oldAbbrev := abbrevs at:classNameSymbol ifAbsent:nil.
+ oldAbbrev notNil ifTrue:[
+ oldAbbrev ~= aFileNameString ifTrue:[
+ oldAbbrev asFilename isAbsolute
+ ifTrue:[ oldPath := oldAbbrev ]
+ ifFalse:[ oldPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: oldAbbrev ].
+ aFileNameString asFilename isAbsolute
+ ifTrue:[ newPath := aFileNameString ]
+ ifFalse:[ newPath := (self projectDirectoryForPackage:aPackageNameString) asFilename constructString: aFileNameString ].
+
+ oldPath ~= newPath ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: autoload path change for: ',aClassNameString,' in package ',aPackageNameString) infoPrintCR.
+ ('Smalltalk [info]: old: ',oldPath) infoPrintCR.
+ ('Smalltalk [info]: new: ',newPath) infoPrintCR.
+ ]
+ ]
+ ].
+ "overwrite old abbreviation with new one,
+ to allow fixing of bad abbrev files"
+ ].
+
+ cls := self classNamed:aFileNameString.
+ cls notNil ifTrue:[
+ cls name ~= aClassNameString ifTrue:[
+ "/ ok, there is a class named after this abbrev ...
+ "/ this is only a conflict, if the other class has no
+ "/ abbreviation (or the same).
+ (abbrevs at:(cls name asSymbol) ifAbsent:cls name) = aFileNameString ifTrue:[
+ cls isNameSpace ifFalse:[
+ aPackageNameString = cls package ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , cls name ,
+ ' in package ' , aPackageNameString) infoPrintCR.
+ ('Smalltalk [warning]: (' , aClassNameString , ' -> ' , aFileNameString
+ , ')') infoPrintCR
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ abbrevs at:classNameSymbol put:aFileNameString.
]
!
-"Modified: 3.1.1997 / 11:26:44 / stefan"
-!
-
-lename readStreamOrNil
+sourceDirectoryNameOfClass:aClassOrClassName
+ "for a given class, return the pathname relative to TOP of the classes source code.
+ Read the files 'abbrev.stc' and 'liblist.stc' (which are created during the compilation process)
+ for an entry for aClassOrClassName.
+ Search for the className in the first col, and return the value found in
+ the 3rd col.
+ Return nil if no entry is found."
+
+ |aStream line words n aClassName|
+
+ aClassOrClassName isBehavior ifTrue:[
+ aClassName := aClassOrClassName name
+ ] ifFalse:[
+ aClassName := aClassOrClassName
+ ].
+ aClassName := aClassName asString.
+
+ #('include/abbrev.stc' 'include/liblist.stc') "/ filenames
+ with:#(3 2) "/ column
+ do:[:fileName :col |
+
+ aStream := self systemFileStreamFor:fileName.
+ aStream notNil ifTrue:[
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+ words := line asCollectionOfWords.
+ (n := words size) > 1 ifTrue:[
+ (words at:1) = aClassName ifTrue:[
+ n >= col ifTrue:[
+ aStream close.
+ ^ (words at:col) withoutSeparators
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
+ ].
+ ].
+
+ ^ nil
+
+ "
+ Smalltalk sourceDirectoryNameOfClass:'ClockView'
+ Smalltalk sourceDirectoryNameOfClass:'Bag'
+ Smalltalk sourceDirectoryNameOfClass:'GLWireCubeDemoView'
+ Smalltalk sourceDirectoryNameOfClass:'SomeNonExistingClass'
+ "
+
+ "Created: 6.11.1995 / 15:43:30 / cg"
+ "Modified: 9.12.1995 / 23:54:14 / cg"
+ "Modified: 3.1.1997 / 11:26:44 / stefan"
+!
+
+sourceFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'source' in SystemPath"
+
+ |aString|
+
+ aString := self getSourceFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
-lename readStreamOrNil
+systemFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ see comment in Smalltalk>>initSystemPath"
+
+ |aString|
+
+ aString := self getSystemFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ aString asFilename readStreamOrNil
].
^ nil
!
-h addLast:'someOtherDirectoryPath'
+systemPath
+ "return a collection of directorynames, where smalltalk
+ looks for system files
+ (usually in subdirs such as resources, bitmaps, source etc.)
+ see comment in Smalltalk>>initSystemPath."
+
+ ^ SystemPath
+
+ "
+ Smalltalk systemPath
+ Smalltalk systemPath addLast:'someOtherDirectoryPath'
+ "
+!
+
+systemPath:aPath
+ "set the collection of directorynames, where smalltalk
+ looks for system files
+ (usually in subdirs such as resources, bitmaps, source etc.)
+ see comment in Smalltalk>>initSystemPath."
+
+ SystemPath := aPath.
+ self flushPathCaches
+
+ "
+ Smalltalk systemPath
+ Smalltalk systemPath:(Smalltalk systemPath copy addLast:'someOtherDirectoryPath')
"
! !
!Smalltalk class methodsFor:'system management-packages'!
-ass methodsFor:'system management-packages'
-!
-
knownPackages
^ KnownPackages ? #()
!
-"Modified: / 18-02-2007 / 11:03:26 / cg"
-!
-
-Name).
+loadExtensionsForPackage:aPackageId
+ |mgr packageDirName inStream|
+
+ packageDirName := aPackageId copyReplaceAll:$: with:$/.
+ packageDirName := self getPackageFileName:packageDirName.
+
+ (packageDirName notNil and:[Class tryLocalSourceFirst]) ifTrue:[
+ (self loadExtensionsFromDirectory:packageDirName) ifTrue:[
+ ^ true.
+ ].
+ packageDirName := nil. "do not try again"
+ ].
+
+ "
+ if there is a sourceCodeManager, ask it first for the extensions
+ "
+ mgr := Smalltalk at:#SourceCodeManager.
+ mgr notNil ifTrue:[
+ SourceCodeManagerError handle:[:ex |
+ ] do:[
+ inStream := mgr getMostRecentSourceStreamForFile:'extensions.st' inPackage:aPackageId.
+ ].
+ inStream notNil ifTrue:[
+ Class withoutUpdatingChangeSetDo:[
+ inStream fileIn.
+ ].
+ inStream close.
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded extensions for ',aPackageId,' from repository').
+ ].
+ ^ true
+ ]
+ ].
+
+ packageDirName notNil ifTrue:[
+ ^ self loadExtensionsFromDirectory:packageDirName
+ ].
+ ^ false
+
+ "Modified: / 18-02-2007 / 11:03:26 / cg"
+!
+
+loadExtensionsFromDirectory:packageDirOrString
+ |packageDir f|
+
+ packageDir := packageDirOrString asFilename.
+
+ f := packageDir construct:'extensions.st'.
+ f exists ifTrue:[
+ Class withoutUpdatingChangeSetDo:[
+ f fileIn.
+ ].
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded extensions: ' , f pathName).
].
^ true
].
^ false
!
-Smalltalk loadPackage:'cg:rose'
- "
-!
-
-t addLoadedProject:p].
+loadPackage:aPackageIdOrPackage
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+ (aPackageIdOrPackage isString) ifTrue:[
+ ^ self loadPackageWithId:aPackageIdOrPackage asAutoloaded:false
+ ].
+ self shouldImplement.
+
+ "
+ Smalltalk loadPackage:'stx:libbasic'
+ Smalltalk loadPackage:'stx:goodies/persistency'
+ Smalltalk loadPackage:'cg:cparser'
+ Smalltalk loadPackage:'cg:rose'
+ "
+!
+
+loadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
+ "load all source files found in aDirectory and treat them like
+ a package. Allows for initial import of alien ST-code as a new package.
+ Experimental."
+
+ |p t new anyFail repeatCount|
+
+ "/ problem: dependencies.
+ "/ solution: repeat twice, so that superclasses are present the second time
+
+ Class packageQuerySignal answer:packageId asSymbol do:[
+ |any|
+
+ repeatCount := 0.
+ [
+ repeatCount := repeatCount + 1.
+ anyFail := false.
+ aDirectory directoryContents do:[:file |
+ |fn|
+
+ fn := aDirectory construct:file.
+ (fn hasSuffix:'st') ifTrue:[
+ Metaclass confirmationQuerySignal answer:false
+ do:[
+ Error
+ handle:[:ex |
+ anyFail := true
+ ]
+ do:[
+ (self fileIn:fn) ifFalse:[
+ anyFail := true
+ ] ifTrue:[
+ any := true.
+ ]
+ ]
+ ]
+ ]
+ ].
+ any ifFalse:[
+ ^ false "/ no file found
+ ]
+ ] doWhile:[anyFail and:[repeatCount<2]].
+ ].
+
+ new := (p := Project projectWithId:packageId) isNil.
+ new ifTrue:[ p := Project new].
+
+ p name:packageId.
+ p directory:aDirectory.
+ p package:packageId.
+ t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
+ p repositoryModule:(t first).
+ p repositoryDirectory:(packageId copyFrom:t first size + 2).
+ p isLoaded:true.
+
+ new ifTrue:[Project addLoadedProject:p].
^ anyFail not
!
-[Project addLoadedProject:p].
+loadPackage:packageId fromClassLibrary:aFilename
+ "load a package from a compiled classLib.
+ Experimental."
+
+ |p t new|
+
+ (self fileIn:aFilename) ifFalse:[
+ (self fileInClassLibrary:aFilename) ifFalse:[
+ self warn:'Failed to load the package ', packageId printString.
+ ^ false.
+ ]
+ ].
+
+ new := (p := Project projectWithId:packageId) isNil.
+ new ifTrue:[ p := Project new].
+
+ p name:packageId.
+ p directory:aFilename directory.
+ p package:packageId.
+ t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
+ p repositoryModule:(t first).
+ p repositoryDirectory:(packageId copyFrom:t first size + 2).
+ p isLoaded:true.
+
+ new ifTrue:[Project addLoadedProject:p].
^ true
!
-[Project addLoadedProject:p].
+loadPackage:packageId fromLoadAllFile:aFilename
+ "load a package from a loadAll - loader script.
+ Experimental."
+
+ |p t new|
+
+ Metaclass confirmationQuerySignal answer:false
+ do:[
+ (self fileIn:aFilename) ifFalse:[
+ self warn:'Failed to load the package ', packageId printString.
+ ^ false.
+ ]
+ ].
+
+ new := (p := Project projectWithId:packageId) isNil.
+ new ifTrue:[ p := Project new].
+
+ p name:packageId.
+ p directory:aFilename directory.
+ p package:packageId.
+ t := packageId asCollectionOfSubstringsSeparatedByAny:'/\:'.
+ p repositoryModule:(t first).
+ p repositoryDirectory:(packageId copyFrom:t first size + 2).
+ p isLoaded:true.
+
+ new ifTrue:[Project addLoadedProject:p].
+ ^ true
+!
+
+loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded
+ "load a package from a .zip delivery file.
+ Experimental."
+
+ "/ not yet implemented ...
+ ^ false
+!
+
+loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded
+ |abbrevFile packageDir|
+
+ packageDir := self packageDirectoryForPackageId:aPackageId.
+ packageDir isNil ifTrue:[^ false].
+
+ "/ abbrev.stc ?
+ abbrevFile := packageDir construct:'abbrev.stc'.
+ abbrevFile exists ifFalse:[^ false].
+
+ Smalltalk installAutoloadedClassesFrom:abbrevFile pathName.
+
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesInPackage:aPackageId do:[:eachClass | eachClass autoload].
+ ].
+
+ self loadExtensionsFromDirectory:packageDir.
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , abbrevFile pathName).
+ ].
^ true
-!
-
-"/ not yet implemented ...
+
+ "Modified: / 10-08-2006 / 12:17:57 / cg"
+!
+
+loadPackageWithId:aPackageId
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+ ^ self loadPackageWithId:aPackageId asAutoloaded:false
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:goodies/persistency'
+ Smalltalk loadPackageWithId:'cg:cparser'
+ Smalltalk loadPackageWithId:'cg:rose'
+ Smalltalk loadPackageWithId:'detemobil:smc'
+ "
+!
+
+loadPackageWithId:aPackageId asAutoloaded:doLoadAsAutoloaded
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+ |packageDir|
+
+ packageDir := self packageDirectoryForPackageId:aPackageId.
+ packageDir isNil ifTrue:[
+ (aPackageId includes:$:) ifFalse:[
+ "/ assume stx
+ packageDir := self packageDirectoryForPackageId:('stx:',aPackageId).
+ ].
+ ].
+
+ ^ self
+ loadPackageWithId:aPackageId
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded.
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:goodies/persistency'
+ Smalltalk loadPackageWithId:'exept:ctypes'
+ "
+
+ "Modified: / 07-12-2006 / 15:04:39 / cg"
+!
+
+loadPackageWithId:aPackageId fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
+ "load a package referenced by aPackageId - a string like 'stx:libbasic'.
+ The package is either located in packageDirOrStringOrNil, or in the current directory"
+
+ |packageDir packageName shLibName filename
+ projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded|
+
+ packageDirOrStringOrNil notNil ifTrue:[
+ packageDir := packageDirOrStringOrNil asFilename.
+ ].
+ silent := SilentLoading or:[ StandAlone ].
+
+ "For now: have to read the project definition first!!
+ The class library may contain subclasses of classes in prerequisite packages -
+ so the prerequisite packages have to be loaded first"
+
+ "normally there is a project definiton, use that one to pull in the rest"
+
+ "maybe, it is already in the image - autoloaded"
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageId.
+
+ "if not, file it in ..."
+ (projectDefinitionClass isNil and:[packageDir notNil]) ifTrue:[
+ projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageId.
+ "/ try to load the project definition class
+ filename := (packageDir construct:projectDefinitionClassName) withSuffix:'st'.
+ filename exists ifFalse:[
+ filename := ((packageDir construct:'source') construct:projectDefinitionClassName) withSuffix:'st'.
+ ].
+ filename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ filename fileIn.
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageId.
+ ].
+ ].
+
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass autoload.
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project definition').
+ ].
+ ^ true.
+ ].
+
+ "Is there a shared library (.dll or .so) ?"
+ shLibName := aPackageId asPackageId libraryName , ObjectFileLoader sharedLibraryExtension.
+
+ filename := Filename currentDirectory construct:shLibName.
+ filename exists ifFalse:[
+ packageDir notNil ifTrue:[
+ filename := packageDir construct:shLibName.
+ filename exists ifFalse:[
+ filename := (packageDir construct:'objbc') construct:shLibName.
+ ]
+ ]
+ ].
+ filename exists ifTrue:[
+ (self loadPackage:aPackageId fromClassLibrary:filename) ifTrue:[
+ silent ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , filename pathName).
+ ].
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass package == aPackageId ifTrue:[eachClass autoload].
+ ].
+ ].
+ ^ true
+ ]
+ ].
+
+ packageDir isNil ifTrue:[
+ ^ false.
+ ].
+
+
+ "/ loadAll ? - well be soon obsolete
+ filename := packageDir construct:'loadAll'.
+ filename exists ifFalse:[
+ filename := packageDir construct:'loadall'.
+ ].
+ filename exists ifTrue:[
+ (self loadPackage:aPackageId fromLoadAllFile:filename) ifTrue:[
+ silent ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , filename pathName).
+ ].
+ ^ true
+ ]
+ ].
+
+ packageName := packageDir baseName.
+
+"/ zip-file loading no longer supported
+"/ "/ .zip ?
+"/ f := (packageDir construct:packageName) withSuffix:'zip'.
+"/ f exists ifTrue:[
+"/ (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+"/ silent ifFalse:[
+"/ Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
+"/ ].
+"/ ^ true
+"/ ]
+"/ ].
+
+"/ abbrev-file loading no longer supported
+"/ "/ abbrev.stc ?
+"/ (self loadPackageFromAbbrevFile:aPackageId asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+"/ ^ true
+"/ ].
+
+"/ any .so-file loading no longer supported
+"/ "/ any .so ? -> load the first one found (maybe not a good idea)
+"/ packageDir directoryContentsAsFilenamesDo:[:aFilename |
+"/ (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
+"/ (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
+"/ silent ifFalse:[
+"/ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
+"/ ].
+"/ doLoadAsAutoloaded ifFalse:[
+"/ "/ force autoloading...
+"/ Smalltalk allClassesDo:[:eachClass |
+"/ eachClass package == aPackageId ifTrue:[ eachClass autoload].
+"/ ].
+"/ ].
+"/ ^ true
+"/ ]
+"/ ]
+"/ ].
+
+"/ source files-file loading no longer supported
+"/ "/ source files
+"/ (self loadPackage:aPackageId fromAllSourceFilesInDirectory:packageDir) ifTrue:[
+"/ silent ifFalse:[
+"/ Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
+"/ ].
+"/ ^ true
+"/ ].
+
^ false
-!
-
-"Modified: / 10-08-2006 / 12:17:57 / cg"
-!
-
-loadPackageWithId:'detemobil:smc'
- "
-!
-
-"Modified: / 07-12-2006 / 15:04:39 / cg"
-!
-
-"Modified: / 07-12-2006 / 15:08:24 / cg"
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:goodies/persistency'
+ Smalltalk loadPackageWithId:'exept:ctypes'
+ "
+
+ "Modified: / 07-12-2006 / 15:08:24 / cg"
+!
+
+packageDirectoryForPackageId:aPackageId
+ |packageDirName packageDir|
+
+ packageDirName := aPackageId copyReplaceAll:$: with:$/.
+
+ packageDir := self getPackageFileName:packageDirName.
+ packageDir isNil ifTrue:[
+ "/ for convenience: try ../../.. as well
+ "/ (when executing in thedevelopment environment)
+ packageDir := '../../..' asFilename construct:packageDirName.
+ packageDir exists ifFalse:[ ^ nil].
+ ].
+ ^ packageDir asFilename
+
+ "
+ Smalltalk packageDirectoryForPackageId:'stx:libbasic'
+ Smalltalk packageDirectoryForPackageId:'stx:goodies/persistency'
+ Smalltalk packageDirectoryForPackageId:'exept:ctypes'
+ "
! !
!Smalltalk class methodsFor:'system management-undeclared variables'!
-or:'system management-undeclared variables'
-!
-
-ll.
+clearUndeclaredVariables
+ "remove all undeclared variables"
+
+ (Smalltalk at:#Undeclared) do:[:eachKey |
+ Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
+ ].
+ (Smalltalk at:#Undeclared) removeAll.
Smalltalk removeKey:#Undeclared.
+!
+
+undeclaredPrefix
+ "the prefix used for undeclared variables"
+
+ ^ 'Undeclared:::'
+
+ "Created: / 31.10.1997 / 01:13:10 / cg"
! !
!Smalltalk class methodsFor:'time-versions'!
-!
-
-"
+configuration
+ "{ Pragma: +optSpace }"
+
+ "for developers only: return the configuration, with which
+ this smalltalk was compiled."
+
+%{ /* NOCONTEXT */
+ extern char *__getConfigurationString();
+
+ RETURN (__MKSTRING(__getConfigurationString() COMMA_SND));
+%}.
+ ^ 'unknownOS/unknownCONF:unknownPACK'
+
+ "
Smalltalk configuration
"
!
-"
+copyrightString
+ "{ Pragma: +optSpace }"
+
+ "return a copyright string"
+
+%{ /* NOCONTEXT */
+#ifndef __getCopyrightString
+ extern OBJ __getCopyrightString();
+#endif
+
+ RETURN (__getCopyrightString());
+%}.
+ ^ self primitiveFailed
+
+ "
Smalltalk copyrightString
"
!
-Smalltalk distributorString
- "
-!
-
-"
+distributorString
+ "{ Pragma: +optSpace }"
+
+ "return a string describing the distributor of this software"
+
+%{ /* NOCONTEXT */
+#ifndef __getDistributorString
+ extern OBJ __getDistributorString();
+#endif
+
+ RETURN (__getDistributorString());
+%}.
+ ^ 'eXept Software AG, Germany'
+
+ "
+ Smalltalk distributorString
+ "
+!
+
+expirationTime
+ "{ Pragma: +optSpace }"
+
+ "for developers only: return the time when the system will expire.
+ after this time it will not run any longer.
+ It returns nil, if no expiration time has been set (system runs forever :-))"
+
+ |exp|
+
+%{
+ extern unsigned int __getExpirationTime();
+
+ exp = __MKUINT(__getExpirationTime());
+%}.
+ exp == 0 ifTrue:[
+ ^ nil
+ ].
+ ^ Timestamp new fromOSTime:(exp * 1000). "OSTime is ms since 1970"
+
+ "
Smalltalk expirationTime
"
!
-"Modified: / 27.10.1997 / 17:04:02 / cg"
-!
-
-"Modified: 18.5.1996 / 14:25:13 / cg"
-!
-
-"Modified: 6.3.1996 / 11:56:35 / cg"
-!
-
-aved"
+fullVersionString
+ "{ Pragma: +optSpace }"
+
+ "return a full version string"
+
+ ^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
+
+ "
+ Smalltalk fullVersionString
+ "
+
+ "Created: / 27.10.1997 / 17:03:09 / cg"
+ "Modified: / 27.10.1997 / 17:04:02 / cg"
+!
+
+hello
+ "{ Pragma: +optSpace }"
+
+ "return a greeting string"
+
+ "stupid: this should come from a resource file ...
+ but I dont use it here, to allow mini-systems without
+ Resource-stuff."
+
+ |proto lang|
+
+ lang := Language.
+ (lang == #de) ifTrue:[
+ proto := 'Willkommen bei %1 (Version %2 von %3)'
+ ] ifFalse:[ (lang == #fr) ifTrue:[
+ proto := 'Salut, Bienvenue à %1 (version %2 de %3)'
+ ] ifFalse:[ (lang == #it) ifTrue:[
+ proto := 'Ciao, benvenuto al %1 (versione %2 di %3)'
+ ] ifFalse:[ (lang == #es) ifTrue:[
+"/ proto := 'Hola, bienvenida a %1 (versión %2 de %3)'
+ ] ifFalse:[ (lang == #es) ifTrue:[
+"/ proto := 'Oi, benvindo a %1 (versão %2 de %3)'
+ ] ifFalse:[ (lang == #no) ifTrue:[
+ proto := 'Hei, verdenmottakelse til %1 (versjon %2 av %3)'
+ ]]]]]].
+
+ "/ ... more needed here ...
+
+ proto isNil ifTrue:[
+ proto := 'Hello World - here is %1 version %2 of %3'.
+ ].
+
+ ^ proto bindWith:('SmallTalk/X' allBold)
+ with:(self versionString)
+ with:(self versionDate)
+
+ "
+ Smalltalk language:#us.
+ Smalltalk hello
+
+ Smalltalk language:#de.
+ Smalltalk hello
+
+ Smalltalk language:#no.
+ Smalltalk hello
+
+ Transcript showCR:(Smalltalk hello)
+ Stdout showCR:(Smalltalk hello)
+ "
+
+ "Modified: 18.5.1996 / 14:25:13 / cg"
+!
+
+imageRestartTime
+ "return a timestamp for the moment when this image was restarted.
+ If we do not execute from an image (i.e. fresh start), return nil."
+
+ ^ ImageRestartTime
+
+ "
+ Smalltalk imageStartTime
+ Smalltalk imageRestartTime
+ "
+
+ "Created: 13.12.1995 / 17:44:20 / cg"
+ "Modified: 6.3.1996 / 11:56:35 / cg"
+!
+
+imageSaveTime
+ "{ Pragma: +optSpace }"
+
+ "return a timestamp for the moment when this image was saved"
^ ObjectMemory imageSaveTime
!
-"Modified: 13.12.1995 / 17:45:47 / cg"
-!
-
-"Modified: 8.11.1996 / 19:59:21 / cg"
-!
-
-"Modified: / 16-08-2006 / 09:37:25 / cg"
-!
-
-Smalltalk releaseIdentification
- "
-!
-
-"Modified: / 10-02-2007 / 14:49:51 / cg"
-!
-
-"Modified: / 28-02-2007 / 23:43:51 / cg"
-!
-
-'''') paddedTo:80 with:(Character space)
-!
-
-"Created: / 18.6.1998 / 17:22:58 / cg"
-!
-
-, ' at ' , Time now printString
+imageStartTime
+ "{ Pragma: +optSpace }"
+
+ "return a timestamp for the moment when this system started the first time
+ (i.e. the first initial start without an image)"
+
+ ^ ImageStartTime
+
+ "
+ Smalltalk imageStartTime
+ Smalltalk imageRestartTime
+ "
+
+ "Created: 13.12.1995 / 17:44:14 / cg"
+ "Modified: 13.12.1995 / 17:45:47 / cg"
+!
+
+majorVersionNr
+ "{ Pragma: +optSpace }"
+
+ "return the major version number.
+ This is only incremented for very fundamental changes,
+ which make old object files totally incompatible
+ (for example, if the layout/representation of fundamental
+ classes changes).
+
+ ST/X revision Naming is:
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 5
+
+ "
+ Smalltalk majorVersionNr
+ "
+
+ "Modified: 8.11.1996 / 19:59:21 / cg"
+!
+
+minorVersionNr
+ "{ Pragma: +optSpace }"
+
+ "return the minor version number.
+ This is incremented for changes which make some old object
+ files incompatible, or the protocol changes such that some
+ classes need rework.
+
+ ST/X revision Naming is:
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 3
+
+ "
+ Smalltalk minorVersionNr
+ "
+
+ "Modified: / 16-08-2006 / 09:37:25 / cg"
+!
+
+releaseIdentification
+ "{ Pragma: +optSpace }"
+
+ "for developers only: return the release
+ (to further identify the version in case of errors)"
+
+%{ /* NOCONTEXT */
+ extern OBJ __getRel();
+
+ RETURN (__getRel());
+%}.
+ ^ 'ST/X_experimental'
+
+ "
+ Smalltalk releaseIdentification
+ "
+!
+
+releaseNr
+ "{ Pragma: +optSpace }"
+
+ "return the revision number.
+ Incremented for releases which fix bugs/add features but did not find
+ their way to the outside world.
+
+ ST/X revision Naming is:
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 1
+
+ "
+ Smalltalk releaseNr
+ "
+
+ "Created: / 10-12-1995 / 01:42:19 / cg"
+ "Modified: / 10-02-2007 / 14:49:51 / cg"
+!
+
+revisionNr
+ "{ Pragma: +optSpace }"
+
+ "return the revision number.
+ Incremented for releases which fix bugs/add features
+ and represent a stable workable version which got published
+ to the outside world.
+
+ ST/X revision Naming is:
+ <major>.<minor>.<revision>.<release>"
+
+ ^ 5
+
+ "
+ Smalltalk revisionNr
+ Smalltalk hello
+ "
+
+ "Modified: / 28-02-2007 / 23:43:51 / cg"
+!
+
+timeStamp
+ "return a string useful for timestamping a file.
+ The returned string is padded with spaces for a constant
+ length (to avoid changing a files size in fileOut with unchanged
+ class)."
+
+ ^ ('''' , self timeStampString , '''') paddedTo:80 with:(Character space)
+!
+
+timeStamp:aStream
+ "write a string useful for timestamping a file onto aStream.
+ ST80 compatibility"
+
+ aStream nextPutAll:(self timeStamp).
+
+ "Created: / 18.6.1998 / 17:22:58 / cg"
+!
+
+timeStampString
+ "return a string useful for timestamping a file."
+
+ |dateString|
+
+ dateString := String streamContents:[:s | Date today printOn:s language:#en]. "/ MUST be english !!!!
+
+ ^ ('From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
+ , dateString , ' at ' , Time now printString
)
!
-"
+versionDate
+ "{ Pragma: +optSpace }"
+
+ "return the executables build date - thats the date when the smalltalk
+ executable was built"
+
+%{ /* NOCONTEXT */
+ extern char *__getBuildDateString();
+
+ RETURN (__MKSTRING(__getBuildDateString() COMMA_SND) );
+%}.
+ ^ 'today'
+
+ "
Smalltalk versionDate
"
!
-"
+versionString
+ "{ Pragma: +optSpace }"
+
+ "return the version string"
+
+ ^ (self majorVersionNr printString ,
+ '.',
+ self minorVersionNr printString ,
+ '.',
+ self revisionNr printString)
+
+ "
Smalltalk versionString
"
+!
+
+vmMajorVersionNr
+ "{ Pragma: +optSpace }"
+
+ "return the VMs major version number."
+%{
+ RETURN (__mkSmallInteger(4));
+%}.
+ ^ 4
+
+ "
+ Smalltalk vmMajorVersionNr
+ "
! !
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.824 2007-07-04 17:03:58 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.825 2007-07-04 17:06:37 cg Exp $'
! !