--- a/Smalltalk.st Tue Nov 18 10:21:53 2003 +0100
+++ b/Smalltalk.st Tue Nov 18 14:55:34 2003 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:5.1.4 on 18-nov-2003 at 02:55:04 pm' !
+
"{ Package: 'stx:libbasic' }"
Object subclass:#Smalltalk
@@ -3547,21 +3549,6 @@
"/ and enumerate its abbrev.stc files...
dirsConsulted := Set new.
-"/ no longer - only consult the packagePath ...
-"/ f := Smalltalk getSystemFileName:'packages'.
-"/ f notNil ifTrue:[
-"/ f := f asFilename.
-"/ f isDirectory ifTrue:[
-"/ ('Smalltalk [info]: installing autoloaded classes found under ''' , f pathName ,'''') infoPrintCR.
-"/ self
-"/ recursiveInstallAutoloadedClassesFrom:f
-"/ rememberIn:dirsConsulted
-"/ maxLevels:15
-"/ noAutoload:false
-"/ packageTop:f.
-"/ ].
-"/ ].
-
"/ along the package-path
(p := self packagePath) do:[:aPath |
(dirsConsulted includes:aPath) ifFalse:[
@@ -3584,12 +3571,6 @@
packageTop:'../../..'.
].
- "/ old scheme: look for a single file called 'abbrev.stc' in the
- "/ include directory. This will vanish.
-
-"/ ('Smalltalk [info]: installing autoloaded classes from ''include/abbrev.stc''') infoPrintCR.
-"/ self installAutoloadedClassesFrom:'include/abbrev.stc'
-
"
Smalltalk installAutoloadedClasses
"
@@ -3598,46 +3579,118 @@
"Modified: / 13.12.1999 / 11:56:50 / cg"
!
-dedClassesFrom:aPath
- rememberIn:dirsConsulted
- maxLevels:15
- noAutoload:false
- packageTop:aPath.
- ]
- ].
- p size == 0 ifTrue:[
- ('Smalltalk [info]: installing autoloaded classes found under ''../../..''') infoPrintCR.
- self
- recursiveInstallAutoloadedClassesFrom:'../../..'
- rememberIn:dirsConsulted
- maxLevels:15
- noAutoload:false
- packageTop:'../../..'.
- ].
-
- "/ old scheme: look for a single file called 'abbrev.stc' in the
- "/ include directory. This will vanish.
-
-"/ ('Smalltalk [info]: installing autoloaded classes from ''include/abbrev.stc''') infoPrintCR.
-"/ self installAutoloadedClassesFrom:'include/abbrev.stc'
-
- "
- Smalltalk installAutoloadedClasses
- "
-
- "Created: / 14.2.1997 / 17:32:57 / cg"
- "Modified: / 13.12.1999 / 11:56:50 / cg"
-!
-
-"
- Smalltalk installAutoloadedClasses
- "
-
- "Created: / 14.2.1997 / 17:32:57 / cg"
- "Modified: / 13.12.1999 / 11:56:50 / cg"
-!
-
-' , cls name , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
+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 clsName abbrev package cat numClassInstVars cls words w abbrevs oldAbbrev nameKey|
+
+ "/ on the fly, update the abbreviations
+
+ CachedAbbreviations isNil ifTrue:[
+ CachedAbbreviations := IdentityDictionary new.
+ ].
+ abbrevs := CachedAbbreviations.
+
+ 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
+ clsName ~= abbrev ifTrue:[
+ nameKey := clsName asSymbol.
+ oldAbbrev := abbrevs at:nameKey ifAbsent:nil.
+ (oldAbbrev notNil and:[oldAbbrev ~= abbrev]) ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , clsName , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
+ ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
+ ].
+ ] ifFalse:[
+ cls := self classNamed:abbrev.
+ cls notNil ifTrue:[
+ cls name ~= clsName 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) = abbrev ifTrue:[
+ cls isNameSpace ifFalse:[
+ package = cls package ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , cls name , ' in ' , (anAbbrevFileStream pathName)) infoPrintCR.
('Smalltalk [warning]: (' , clsName , ' -> ' , abbrev , ')') infoPrintCR
]
]
@@ -3658,43 +3711,17 @@
]
!
-, ')') infoPrintCR
- ]
- ]
- ]
- ]
- ]
- ].
- ].
- abbrevs at:nameKey put:abbrev.
- ].
-
- "/ ' autoloaded: ' print. clsName print. ' in ' print. cat printCR.
-
- self installAutoloadedClassNamed:clsName category:cat package:package revision:nil numClassInstVars:numClassInstVars.
- ]
- ]
- ]
- ]
-!
-
-oloaded: ' print. clsName print. ' in ' print. cat printCR.
-
- self installAutoloadedClassNamed:clsName category:cat package:package revision:nil numClassInstVars:numClassInstVars.
- ]
- ]
- ]
- ]
-!
-
-ies
+loadBinaries
"return true, if binaries should be loaded into the system,
false if this should be suppressed. The default is false (for now)."
^ LoadBinaries
!
-n/off loading of binary objects"
+loadBinaries:aBoolean
+ "{ Pragma: +optSpace }"
+
+ "turn on/off loading of binary objects"
aBoolean ifTrue:[
(ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles]) ifTrue:[
@@ -3708,12 +3735,117 @@
"Modified: 10.1.1997 / 15:11:00 / cg"
!
-ts := false
+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
"
!
-:[:ex| "ignore this file"].
+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
+
+!
+
+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"].
].
[
@@ -3761,36 +3893,12 @@
"
!
-e) 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
- "
-!
-
-True:[
+replaceReferencesTo:anObject with:newRef
+ |toAdd|
+
+ toAdd := OrderedCollection new.
+ self keysAndValuesDo:[:key :val |
+ (key == anObject) ifTrue:[
self shouldImplement.
].
(val == anObject ) ifTrue:[
@@ -3800,26 +3908,46 @@
toAdd do:[:each |
self at:(each key) put:(each value)
].
-! !
-
-!Smalltalk class methodsFor:'system management-fileIn'!
-
-windowManager."
+!
+
+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"
!
-in SystemOrganizer for more info."
+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"
-!
-
-This method can load almost anything which makes sense:
+! !
+
+!Smalltalk class methodsFor:'system management-fileIn'!
+
+fileIn:aFileName
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ This method can load almost anything which makes sense:
.st - source files
.cls - binary smalltalk bytecode files
.so - binary compiled machine code class libraries
@@ -3836,20 +3964,111 @@
"Created: 28.10.1995 / 17:06:28 / cg"
!
-^ false].
+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) ]
!
-acToe.st' lazy:true
+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"
!
-mFileStreamFor:fileNameString.
+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
+ ]
+ ].
+
+ (fileNameString startsWith:'source/') ifTrue:[
+ aStream := self sourceFileStreamFor:(fileNameString copyFrom:8)
+ ] ifFalse:[
+ (fileNameString startsWith:'fileIn/') ifTrue:[
+ aStream := self fileInFileStreamFor:(fileNameString copyFrom:8)
+ ] ifFalse:[
+ aStream := self systemFileStreamFor:fileNameString.
aStream isNil ifTrue:[
OperatingSystem isUNIXlike ifTrue:[
(fileNameString startsWith:'/') ifFalse:[
@@ -3877,28 +4096,20 @@
"Modified: / 16.2.1999 / 10:03:26 / cg"
!
-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.
- ]
- ]
- ].
- aStream isNil ifTrue:[^ false].
- ^ self fileInStream:aStream lazy:lazy silent:silent logged:logged addPath:morePath
-
- "
- Smalltalk fileIn:'source/TicTacToe.st' lazy:true silent:true
- "
-
- "Modified: / 16.2.1999 / 10:03:26 / cg"
-!
-
-"Modified: / 16.2.1999 / 10:03:26 / cg"
-!
-
-he system to the state it
+fileIn:aFileName logged:logged
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ The argument logged controls, if the changefile is to be updated."
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:logged
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' logged:false
+ "
+!
+
+fileInChanges
+ "read in the last changes file - bringing the system to the state it
had when left the last time.
WARNING: this method is rubbish: it should only read things after the
last '**snapshot**' - entry
@@ -3914,7 +4125,24 @@
"
!
-it into the system
+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."
@@ -3943,21 +4171,9 @@
"Modified: 10.9.1996 / 20:43:52 / cg"
!
-lentLoading 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"
-!
-
-aces trying driver-file (.ld), object-file (.o) and
+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."
@@ -3971,7 +4187,23 @@
"Modified: / 9.1.1998 / 14:42:02 / cg"
!
-ileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
+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.
@@ -3991,7 +4223,300 @@
"Modified: / 9.1.1998 / 14:42:28 / cg"
!
-].
+fileInClass:aClassName package:package initialize:doInit lazy:loadLazy silent:beSilent
+ "find a source/object file for aClassName and -if found - load it.
+ 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."
+
+ |shortName longName libName newClass ok wasLazy wasSilent sharedLibExtension inStream mgr
+ fn packageDir packageFile bos|
+
+ wasLazy := Compiler compileLazy:loadLazy.
+ beSilent notNil ifTrue:[
+ wasSilent := self silentLoading:beSilent.
+ ].
+
+ longName := Smalltalk fileNameForClass:aClassName.
+ longName := longName copyReplaceAll:$: with:$_.
+
+ [
+ Class withoutUpdatingChangesDo:
+ [
+ |zarFn zar entry|
+
+ ok := false.
+
+ shortName := self fileNameForClass:aClassName.
+ package notNil ifTrue:[
+ packageDir := package asString.
+ packageDir := packageDir copyReplaceAll:$: with:$/.
+ ].
+
+ Class packageQuerySignal answer:package
+ do:[
+
+ "
+ first, look for a loader-driver file (in fileIn/xxx.ld)
+ "
+ (ok := self fileIn:('fileIn/' , shortName , '.ld') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ "
+ try abbreviated driver-file (in fileIn/xxx.ld)
+ "
+ shortName ~= aClassName ifTrue:[
+ ok := self fileIn:('fileIn/' , longName , '.ld') lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ 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:(shortName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(shortName, '.o')
+ ].
+ ok ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ (ok := self fileInClass:aClassName fromObject:(longName, sharedLibExtension))
+ ifFalse:[
+ sharedLibExtension ~= '.o' ifTrue:[
+ ok := self fileInClass:aClassName fromObject:(longName, '.o')
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ "
+ if that did not work, look for a compiled-bytecode file ...
+ "
+ ok ifFalse:[
+ (ok := self fileIn:(shortName , '.cls') lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ ok := self fileIn:(longName , '.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/' , shortName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , shortName , '.cls').
+ ].
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/classes/' , longName , '.cls').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/classes/' , longName , '.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:(shortName , '.cls').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(longName , '.cls').
+ ].
+ entry notNil ifTrue:[
+ bos := BinaryObjectStorage onOld:(entry asByteArray readStream).
+ bos next.
+ bos close.
+ ok := true
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ fn := shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= longName ifTrue:[
+ fn := longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= longName ifTrue:[
+ fn := 'source/' , longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for an st-source file
+ in a package subdir of the source-directory ...
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , shortName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , shortName , '.st').
+ ].
+ fn := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/source/' , longName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/source/' , longName , '.st').
+ ].
+ fn := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+
+ packageFile := self getPackageFileName:(packageDir , '/' , shortName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , shortName , '.st').
+ ].
+ fn := packageFile.
+ (ok := self fileIn:packageFile lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ packageFile := self getPackageFileName:(packageDir , '/' , longName , '.st').
+ packageFile isNil ifTrue:[
+ packageFile := (packageDir , '/' , longName , '.st').
+ ].
+ fn := packageFile.
+ ok := self fileIn:packageFile lazy:loadLazy silent:beSilent
+ ].
+ ok ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ fn := 'source/' , packageDir , '/' , shortName , '.st'.
+ (ok := self fileIn:fn lazy:loadLazy silent:beSilent)
+ ifFalse:[
+ shortName ~= aClassName ifTrue:[
+ fn := 'source/' , packageDir , '/' , longName , '.st'.
+ ok := self fileIn:fn lazy:loadLazy silent:beSilent
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+ ]
+ ].
+ "
+ if that did not work, and the classes package is known,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ packageDir notNil ifTrue:[
+ zarFn := self getPackageFileName:(packageDir , '/source.zip').
+ zarFn isNil ifTrue:[
+ zarFn := packageDir asFilename withSuffix:'zip'.
+ zarFn := self getSourceFileName:zarFn.
+ ].
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(shortName , '.st').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(longName , '.st').
+ ].
+ entry notNil ifTrue:[
+ fn := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ]
+ ].
+
+ "
+ if that did not work,
+ look for a zipArchive containing a class entry.
+ "
+ ok ifFalse:[
+ zarFn := self getSourceFileName:'source.zip'.
+ zarFn notNil ifTrue:[
+ zar := ZipArchive oldFileNamed:zarFn.
+ zar notNil ifTrue:[
+ entry := zar extract:(zarFn := shortName , '.st').
+ (entry isNil and:[shortName ~= longName]) ifTrue:[
+ entry := zar extract:(zarFn := longName , '.st').
+ ].
+ entry notNil ifTrue:[
+ fn := zarFn.
+ ok := self
+ fileInStream:(entry asString readStream)
+ lazy:loadLazy
+ silent:beSilent
+ logged:false
+ addPath:nil
+ ].
+ ]
+ ]
+ ].
+ ok ifFalse:[
+ "
+ new: if there is a sourceCodeManager, ask it for the classes sourceCode
+ "
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ inStream := mgr getMostRecentSourceStreamForClassNamed:aClassName.
+ inStream notNil ifTrue:[
+ fn := nil.
+ ok := self fileInStream:inStream lazy:loadLazy silent:beSilent logged:false addPath:nil.
+ ]
+ ].
].
].
].
@@ -4026,7 +4551,9 @@
"Modified: / 5.6.1999 / 14:53:01 / cg"
!
-and load it. This install all of its contained classes.
+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
@@ -4055,7 +4582,11 @@
"Modified: 8.1.1997 / 17:58:56 / cg"
!
-an extension (by purpose);
+fileInClassLibrary:aClassLibraryName inPackage:packageID
+ "find an object file containing a binary class library in some standard places
+ and load it. This install all of its contained classes.
+ Return true if ok, false if not.
+ 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."
@@ -4082,7 +4613,26 @@
"Modified: 8.1.1997 / 17:58:56 / cg"
!
-silent notNil ifTrue:[wasSilent := self silentLoading:silent].
+fileInStream:aStream 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."
+
+ |wasLazy wasSilent oldSystemPath oldRealPath|
+
+ aStream isNil ifTrue:[^ false].
+
+ lazy notNil ifTrue:[wasLazy := Compiler compileLazy:lazy].
+ silent notNil ifTrue:[wasSilent := self silentLoading:silent].
[
Class updateChangeFileQuerySignal answer:logged do:[
Class updateChangeListQuerySignal answer:logged do:[
@@ -4116,27 +4666,17 @@
"Modified: 5.11.1996 / 20:03:35 / cg"
!
-stemPath := oldSystemPath.
- RealSystemPath := oldRealPath.
- ].
- ].
- ]
- ]
- ] ensure:[
- lazy notNil ifTrue:[Compiler compileLazy:wasLazy].
- silent notNil ifTrue:[self silentLoading:wasSilent].
- aStream 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
@@ -4147,7 +4687,11 @@
"
!
-called without system specific filename
+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 ..."
@@ -4161,26 +4705,57 @@
"
"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:AbortSignal with:Process terminateSignal)
+ 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'!
-LibraryIfAbsent:'libbasic'
- Smalltalk loadClassLibraryIfAbsent:'libwidg3'
- "
-
- "Modified: 31.10.1996 / 16:57:24 / cg"
-!
-
-retVal := self fileIn:aFileName
- ].
- ^ retVal
-!
-
-ment-files'
-!
-
-pFromFileNamed:aFileName forClass:aClass
+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
"search aFileName in some standard places:
first in the redefinable bitmaps path,
then in the classes own package directory if existing.
@@ -4193,12 +4768,28 @@
"
!
-malltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
+bitmapFromFileNamed: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."
+
+ ^ self imageFromFileNamed:aFileName inPackage:aPackage
+
+ "
+ Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libview'
Smalltalk bitmapFromFileNamed:'SmalltalkX.xbm' inPackage:'stx:libtool'
"
!
-aFileName asFilename hasSuffix:'st') ifTrue:[
+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
@@ -4215,13 +4806,84 @@
"Modified: 11.12.1995 / 14:51:10 / cg"
!
-classNameForFile:'ArrColl.chg'
- "
-
- "Modified: 11.12.1995 / 14:51:10 / cg"
-!
-
-fTrue:[^ abbrev].
+constructPathFor:aDirectoryName
+ "search for aDirectory in SystemPath;
+ return a collection of pathes which include that directory."
+
+ ^ self realSystemPath select:[:dirName |
+ |fullPath|
+
+ fullPath := dirName asFilename construct:aDirectoryName.
+ "/ fullPath exists and:[fullPath isDirectory and:[fullPath isReadable]]
+ fullPath isDirectory and:[fullPath isReadable]
+ ].
+!
+
+fileInFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ 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
+!
+
+fileNameForClass:aClassOrClassName
+ "return a filename for aClassOrClassName"
+
+ |cls nm1 nm2|
+
+ aClassOrClassName isBehavior ifTrue:[
+ nm1 := aClassOrClassName theNonMetaclass name.
+ nm2 := aClassOrClassName theNonMetaclass nameWithoutPrefix.
+ ] ifFalse:[
+ cls := Smalltalk classNamed:aClassOrClassName.
+ cls notNil ifTrue:[
+ nm1 := cls theNonMetaclass name.
+ nm2 := cls theNonMetaclass 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
+ ].
+ nm2 notNil ifTrue:[
+ ^ CachedAbbreviations at:nm2 ifAbsent:nm1
+ ].
+ ].
+ ^ nm1
+
+"/ "return a good filename for aClassOrClassName -
+"/ using the abbreviation file if there is one"
+"/
+"/ |fileName abbrev cls fullClassName shortClassName|
+"/
+"/ aClassOrClassName isBehavior ifTrue:[
+"/ cls := aClassOrClassName theNonMetaclass.
+"/ fullClassName := cls name.
+"/ shortClassName := cls nameWithoutPrefix.
+"/ ] ifFalse:[
+"/ fullClassName := shortClassName := aClassOrClassName.
+"/ shortClassName := shortClassName copyFrom:(shortClassName lastIndexOf:$:)+1.
+"/ ].
+"/
+"/ fileName := fullClassName asSymbol.
+"/
+"/ "look for abbreviation"
+"/
+"/ abbrev := self filenameAbbreviations at:fileName ifAbsent:[nil].
+"/ abbrev notNil ifTrue:[^ abbrev].
"/
"/ "no abbreviation found - if its a short name, take it"
"/
@@ -4245,22 +4907,9 @@
"Modified: / 5.11.2001 / 16:49:17 / cg"
!
-l.
-"/ ^ fileName asString
- "
- Smalltalk fileNameForClass:#Complex
- Smalltalk fileNameForClass:'SmallInteger'
- Smalltalk fileNameForClass:'UnixOperatingSystem'
- Smalltalk fileNameForClass:'Launcher'
- Smalltalk fileNameForClass:'SomeUnknownClass'
- Smalltalk fileNameForClass:OSI::FTAMOperation
- Smalltalk fileNameForClass:'OSI::Foobar'
- "
-
- "Modified: / 5.11.2001 / 16:49:17 / cg"
-!
-
-sys5.3 users, where filenames are limited
+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:[
@@ -4277,7 +4926,10 @@
"
!
-names,
+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
@@ -4291,7 +4943,13 @@
"
!
-BinaryPath := self constructPathFor:BinaryDirName
+getBinaryFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'binary' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ BinaryPath isNil ifTrue:[
+ BinaryPath := self constructPathFor:BinaryDirName
].
^ self searchPath:BinaryPath for:aFileName in:BinaryDirName
@@ -4299,7 +4957,14 @@
"Modified: 18.7.1996 / 15:53:49 / cg"
!
-ifTrue:[
+getBitmapFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'bitmaps' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ |f|
+
+ BitmapPath isNil ifTrue:[
BitmapPath := self constructPathFor:BitmapDirName
].
@@ -4318,7 +4983,22 @@
"Modified: 18.7.1996 / 15:53:55 / cg"
!
-search for a particular package; return its directory, or nil"
+getFileInFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'fileIn' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ FileInPath isNil ifTrue:[
+ FileInPath := self constructPathFor:FileInDirName
+ ].
+
+ ^ self searchPath:FileInPath for:aFileName in:FileInDirName
+
+ "Modified: 18.7.1996 / 15:53:59 / cg"
+!
+
+getPackageDirectoryForPackage:aPackageID
+ "search for a particular package; return its directory, or nil"
|packageDir|
@@ -4346,7 +5026,12 @@
"
!
-|f|
+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.
@@ -4376,13 +5061,19 @@
"
!
-"
- Smalltalk getPackageFileName:'stx/libview/resources/normal.style'
- Smalltalk getPackageFileName:'stx/libview/source.zip'
- "
-!
-
-f := self searchPath:ResourcePath for:aFileName in:ResourceDirName.
+getResourceFileName:aFileName
+ "search aFileName in some standard places
+ (subdirectories named 'resource' in SystemPath);
+ return the absolute filename or nil if none is found."
+
+ |f|
+
+ ResourcePath isNil ifTrue:[
+ ResourcePath := self constructPathFor:ResourceDirName
+ ].
+
+ "/ first, try a resource subdir along the path.
+ f := self searchPath:ResourcePath for:aFileName in:ResourceDirName.
f isNil ifTrue:[
"/ then, try it itself along the path.
f := self searchPath:self realSystemPath for:aFileName in:nil
@@ -4396,7 +5087,38 @@
"Modified: 18.7.1996 / 15:54:03 / cg"
!
-ackagePath do:[:aPath |
+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."
+
+ |f dir packageDir|
+
+ f := self getResourceFileName:aFileName.
+ f notNil ifTrue:[^ f].
+
+ aPackageIDOrNil notNil ifTrue:[
+ packageDir := aPackageIDOrNil copyReplaceAll:$: with:$/.
+ self packagePath do:[:aPath |
|pD|
pD := aPath asFilename construct:packageDir.
@@ -4432,7 +5154,7 @@
"
!
-aFileName
+getSourceFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'source' in SystemPath);
return the absolute filename or nil if none is found.
@@ -4463,7 +5185,19 @@
"Modified: 18.7.1996 / 15:54:07 / cg"
!
-ng asFilename.
+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"
@@ -4497,7 +5231,10 @@
"Modified: / 6.5.1999 / 10:40:37 / cg"
!
-ge directory if existing.
+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."
|package nm img|
@@ -4530,7 +5267,10 @@
"
!
-xisting.
+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."
|i f dir|
@@ -4561,7 +5301,26 @@
"
!
-sName := aClassOrClassName
+libraryFileNameOfClass:aClassOrClassName
+ "for a given class, return the name of a classLibrary which contains
+ binary code for it.
+ Read the libinfo file 'liblist.stc' (which is created during the compilation process)
+ 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.
@@ -4601,32 +5360,8 @@
"Modified: 6.11.1995 / 15:41:39 / cg"
!
-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"
-!
-
-llection of additional directorynames, where smalltalk
+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"
@@ -4640,11 +5375,28 @@
"
!
-packagePath addFirst:'/usr/local/otherPackages'
- "
-!
-
-il].
+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.
@@ -4654,7 +5406,60 @@
"
!
-iations found under ''' , aPath ,'''') infoPrintCR.
+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'
+ "
+!
+
+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
"/ ]
@@ -4680,7 +5485,53 @@
"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 ..."
+
+ |abbrevs line words nm abbrev pkg key oldAbbrev cls s w|
+
+ abbrevs := CachedAbbreviations.
+
+ [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.
+ nm ~= abbrev ifTrue:[
+ key := nm asSymbol.
+ oldAbbrev := abbrevs at:key ifAbsent:nil.
+ oldAbbrev notNil ifTrue:[
+ oldAbbrev ~= abbrev ifTrue:[
+ StandAlone ifFalse:[
+ ('Smalltalk [warning]: conflict for: ' , nm , ' in ' , (aStream pathName)) infoPrintCR.
+ ('Smalltalk [warning]: (' , oldAbbrev , ' <-> ' , abbrev , ')') infoPrintCR
+ ]
+ ].
+ ] ifFalse:[
+ cls := self classNamed:abbrev.
+
+ cls notNil ifTrue:[
cls name ~= nm ifTrue:[
"/ ok, there is a class named after this abbrev ...
"/ this is only a conflict, if the other class has no
@@ -4710,7 +5561,15 @@
"Modified: / 13.12.1999 / 11:54:17 / cg"
!
-mporary kludge: since we cannot currently
+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 |
@@ -4748,43 +5607,17 @@
^ RealSystemPath
!
-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
-!
-
-'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
+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
].
@@ -4822,51 +5655,86 @@
].
!
-Stream: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
- ]
- ].
- ].
-!
-
-me.
- f isDirectory ifTrue:[
- self recursiveReadAllAbbreviationsFrom:f maxLevels:maxLevels-1
- ]
- ].
- ].
-!
-
-Name forClass:aClassOrNil.
+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
!
-fileName.
+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"
+!
+
+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.
@@ -4902,40 +5770,10 @@
"Modified: 3.1.1997 / 11:26:44 / stefan"
!
-houtSeparators
- ]
- ]
- ]
- ]
- ]
- ].
- 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"
-!
-
-lass'
- "
-
- "Created: 6.11.1995 / 15:43:30 / cg"
- "Modified: 9.12.1995 / 23:54:14 / cg"
- "Modified: 3.1.1997 / 11:26:44 / stefan"
-!
-
-Path"
+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|
@@ -4944,16 +5782,24 @@
^ aString asFilename readStreamOrNil
].
^ nil
-! !
-
-!Smalltalk class methodsFor:'system management-packages'!
-
-mOrNil
+!
+
+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
!
-return a collection of directorynames, where smalltalk
+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."
@@ -4966,18 +5812,87 @@
"
!
-OtherDirectoryPath'
- "
-!
-
-alk systemPath
+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')
"
-!
-
-!
-
-t:[
+! !
+
+!Smalltalk class methodsFor:'system management-packages'!
+
+knownPackages
+ ^ KnownPackages ? #()
+!
+
+loadExtensionsForPackage:aPackageId
+ |packageDirName|
+
+ packageDirName := aPackageId copyReplaceAll:$: with:$/.
+
+ packageDirName := self getPackageFileName:packageDirName.
+ packageDirName isNil ifTrue:[
+ ^ false
+ ].
+ ^ self loadExtensionsFromDirectory:packageDirName
+!
+
+loadExtensionsFromDirectory:packageDirOrString
+ |packageDir f|
+
+ packageDir := packageDirOrString asFilename.
+
+ f := packageDir construct:'extensions.st'.
+ f exists ifTrue:[
+ f fileIn.
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded extensions: ' , f pathName).
+ ].
+ ^ true
+ ].
+ ^ false
+!
+
+loadPackage:aPackageIdOrPackage
+ "make certain, that some particular package is loaded into the system.
+ Experimental."
+
+ (aPackageIdOrPackage isSymbol
+ or:[aPackageIdOrPackage isString]) ifTrue:[
+ ^ self loadPackageWithId:aPackageIdOrPackage asAutoloaded:false
+ ].
+ self shouldImplement.
+
+ "
+ Smalltalk loadPackage:'stx:libbasic'
+ Smalltalk loadPackage:'stx:goodies/persistency'
+ Smalltalk loadPackage:'cg:cparser'
+ Smalltalk loadPackage:'cg:rose'
+ "
+!
+
+loadPackage:packageId fromAllSourceFilesInDirectory:aDirectory
+ "load all source files found in aDirectory and treat them like
+ a package. Allows for initial import of alien ST-code as a new package.
+ Experimental."
+
+ |p t new anyFail|
+
+ "/ problem: dependencies.
+ "/ solution: repeat twice, so that superclasses are present the second time
+
+ Class packageQuerySignal answer:packageId asSymbol do:[
+ |any|
+
+ 2 timesRepeat:[
anyFail := false.
aDirectory directoryContents do:[:file |
|fn|
@@ -5015,19 +5930,90 @@
!
-p isLoaded:true.
-
- new ifTrue:[Project addLoadedProject:p].
- ^ anyFail not
-
-!
-
-oaded:true.
+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
!
+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 fromProjectFile:f asAutoloaded:doLoadAsAutoloaded
+ "load a package from a .prj spec.
+ Experimental."
+
+
+ "/ not yet implemented ...
+ ^ false.
+
+"/ |prj fn|
+"/
+"/ prj := Project new loadFromProjectFile:f asFilename pathName.
+"/ "/ no - also allow for applications to be loaded this way
+"/ "/ prj type == #library ifFalse:[ ^ false].
+"/ self halt.
+"/ "/ load all prerequisites ...
+"/ prj prerequisites do:[:aRequiredPackage |
+"/ self halt.
+"/ ].
+"/
+"/ "/ see if there is a class library ...
+"/ fn := prj directory asFilename construct:(prj name , ObjectFileLoader sharedLibraryExtension).
+"/ fn exists ifTrue:[
+"/ "/ load that classLibrary ...
+"/ self fileIn:fn pathName.
+"/ ].
+"/
+"/ "/ now, for all other classes, file-them in
"/ "/ or declare as autoloaded ...
"/
"/ prj classes do:[:aClassOrName | |ns|
@@ -5056,43 +6042,51 @@
"
!
-ame) not
-"/ and:[(ns := prj defaultNameSpace) isNil
-"/ or:[ns == self
-"/ or:[(ns includesKey:aClassOrName) not]]])
-"/ ifTrue:[
-"/ "/ must load a corresponding source or cls-file
-"/ self halt.
-"/ ]
-"/ ]
-"/ ].
-"/ prj isLoaded:true.
-"/ prj directory:f asFilename directoryName.
-"/ Project addLoadedProject:prj.
-"/ ^ true
-
-"
- Smalltalk loadPackage:'exept:osi/asn1'
- Smalltalk
- loadPackage:'exept:osi/asn1'
- fromProjectFile:'../../../exept/osi/asn1/asn1.prj'
- asAutoloaded:false
-"
-!
-
-t:prj.
-"/ ^ true
-
-"
- Smalltalk loadPackage:'exept:osi/asn1'
- Smalltalk
- loadPackage:'exept:osi/asn1'
- fromProjectFile:'../../../exept/osi/asn1/asn1.prj'
- asAutoloaded:false
-"
-!
-
-aceAll:$: with:$/.
+loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded
+ "load a package from a .zip delivery file.
+ Experimental."
+
+ "/ not yet implemented ...
+ ^ false
+!
+
+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."
+
+ |pkg packageDirName packageBaseName packageDir|
+
+ pkg := Project projectWithId:aPackageId.
+ (pkg notNil and:[pkg isLoaded]) ifTrue:[
+ "/ ('Smalltalk [info]: Package ' , aPackageId , ' already loaded.') infoPrintCR.
+ (doLoadAsAutoloaded
+ or:[pkg areAllClassesLoaded]) ifTrue:[
+ ^ true
+ ].
+ ].
+
+ "/ ok; not yet loaded.
+ "/ try to locate the package; try the following:
+ "/ $(packagePath)/<packageDir>/...
+ "/ $(SYSPATH)/packages/<packageDir>
+
+ packageDirName := aPackageId copyReplaceAll:$: with:$/.
packageBaseName := packageDirName asFilename baseName.
packageDir := self getPackageFileName:packageDirName.
@@ -5121,11 +6115,110 @@
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
-! !
-
-!Smalltalk class methodsFor:'system management-undeclared variables'!
-
-CR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
+!
+
+loadPackageWithId:aPackageId name:packageName fromDirectory:packageDirOrString asAutoloaded:doLoadAsAutoloaded
+ |f s packageDir shLibName|
+
+ packageDir := packageDirOrString asFilename.
+
+ "/ .prj ?
+ f := (packageDir construct:packageName) withSuffix:'prj'.
+ f exists ifTrue:[
+ (self loadPackage:aPackageId fromProjectFile:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageId , ' from project file: ' , f pathName).
+ ].
+ ^ true
+ ]
+ ].
+ "/ loadAll ?
+ f := packageDir construct:'loadAll'.
+ f exists ifTrue:[
+ (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
+ ].
+ ^ true
+ ]
+ ].
+ "/ .zip ?
+ f := (packageDir construct:packageName) withSuffix:'zip'.
+ f exists ifTrue:[
+ (self loadPackage:aPackageId fromZIPArchive:f asAutoloaded:doLoadAsAutoloaded) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from zip file: ' , f pathName).
+ ].
+ ^ true
+ ]
+ ].
+
+ shLibName := packageName , ObjectFileLoader sharedLibraryExtension.
+
+ "/ .so ?
+ f := packageDir construct:shLibName.
+ f exists ifTrue:[
+ (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
+ ].
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass package == aPackageId ifTrue:[ eachClass autoload].
+ ].
+ ].
+ ^ true
+ ]
+ ].
+
+ "/ abbrev.stc ?
+ f := packageDir construct:'abbrev.stc'.
+ f exists ifTrue:[
+ Smalltalk installAutoloadedClassesFrom:f pathName.
+
+ doLoadAsAutoloaded ifFalse:[
+ "/ force autoloading...
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass package == aPackageId ifTrue:[ eachClass autoload].
+ ].
+ ].
+
+ self loadExtensionsFromDirectory:packageDirOrString.
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from abbrev file: ' , f pathName).
+ ].
+ ^ true
+ ].
+
+"/ "/ lib/loadAll ? (will vanish)
+"/ f := (packageDir construct:'lib') construct:'loadAll'.
+"/ f exists ifTrue:[
+"/ (self loadPackage:aPackageId fromLoadAllFile:f) ifTrue:[
+"/ SilentLoading ifFalse:[
+"/ Transcript showCR:('loaded package: ' , aPackageId , ' from loadAll file: ' , f pathName).
+"/ ].
+"/ ^ true
+"/ ]
+"/ ].
+"/
+"/ "/ /lib/.so ? (will vanish)
+"/ f := (packageDir construct:'lib') construct:shLibName.
+"/ f exists ifTrue:[
+"/ (self loadPackage:aPackageId fromClassLibrary:f) ifTrue:[
+"/ SilentLoading ifFalse:[
+"/ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , f pathName).
+"/ ].
+"/ ^ true
+"/ ]
+"/ ].
+
+ "/ any .so ? -> load the first one found (maybe not a good idea)
+ packageDir directoryContentsAsFilenamesDo:[:aFilename |
+ (aFilename hasSuffix:ObjectFileLoader sharedLibrarySuffix) ifTrue:[
+ (self loadPackage:aPackageId fromClassLibrary:aFilename) ifTrue:[
+ SilentLoading ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageId , ' from binary classLib file: ' , aFilename pathName).
].
doLoadAsAutoloaded ifFalse:[
"/ force autoloading...
@@ -5152,59 +6245,38 @@
Smalltalk loadPackageWithId:'stx:goodies/persistency'
Smalltalk loadPackageWithId:'exept:ctypes'
"
-!
-
-.
- ].
- ].
- ^ true
- ]
- ]
- ].
-
- "/ source files
- (self loadPackage:aPackageId fromAllSourceFilesInDirectory:packageDir) ifTrue:[
- SilentLoading ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
- ].
- ^ true
- ].
- ^ false
-
- "
- Smalltalk loadPackageWithId:'stx:libbasic'
- Smalltalk loadPackageWithId:'stx:goodies/persistency'
- Smalltalk loadPackageWithId:'exept:ctypes'
- "
! !
-!Smalltalk class methodsFor:'time-versions'!
-
-ript showCR:('loaded package: ' , aPackageId , ' from source files in:' , packageDir pathName).
- ].
- ^ true
- ].
- ^ false
-
- "
- Smalltalk loadPackageWithId:'stx:libbasic'
- Smalltalk loadPackageWithId:'stx:goodies/persistency'
- Smalltalk loadPackageWithId:'exept:ctypes'
- "
-!
-
-iables'
-!
-
-x
+!Smalltalk class methodsFor:'system management-undeclared variables'!
+
+clearUndeclaredVariables
+ "remove all undeclared variables"
+
+ (Smalltalk at:#Undeclared) do:[:eachKey |
+ Smalltalk removeKey:(self undeclaredPrefix , eachKey) asSymbol.
+ ].
+ (Smalltalk at:#Undeclared) removeAll.
+ Smalltalk removeKey:#Undeclared.
+!
+
+undeclaredPrefix
"the prefix used for undeclared variables"
^ 'Undeclared:::'
"Created: / 31.10.1997 / 01:13:10 / cg"
-!
-
-char *__getConfigurationString();
+! !
+
+!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));
%}.
@@ -5215,7 +6287,27 @@
"
!
-tSpace }"
+copyrightString
+ "{ Pragma: +optSpace }"
+
+ "return a copyright string"
+
+%{ /* NOCONTEXT */
+#ifndef __getCopyrightString
+ extern OBJ __getCopyrightString();
+#endif
+
+ RETURN (__getCopyrightString());
+%}.
+ ^ self primitiveFailed
+
+ "
+ Smalltalk copyrightString
+ "
+!
+
+distributorString
+ "{ Pragma: +optSpace }"
"return a string describing the distributor of this software"
@@ -5233,9 +6325,64 @@
"
!
-!
-
-ang == #es) ifTrue:[
+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
+ ].
+ ^ AbsoluteTime new fromOSTime:(exp * 1000). "OSTime is ms since 1970"
+
+ "
+ Smalltalk expirationTime
+ "
+!
+
+fullVersionString
+ "{ Pragma: +optSpace }"
+
+ "return a full version string"
+
+ ^ 'Smalltalk/X release ' , self versionString , ' of ' , self versionDate
+
+ "
+ Smalltalk fullVersionString
+ "
+
+ "Created: / 27.10.1997 / 17:03:09 / cg"
+ "Modified: / 27.10.1997 / 17:04:02 / cg"
+!
+
+hello
+ "{ Pragma: +optSpace }"
+
+ "return a greeting string"
+
+ "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 vom %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)'
@@ -5270,51 +6417,8 @@
"Modified: 18.5.1996 / 14:25:13 / cg"
!
-:[
- 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"
-!
-
-:(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"
-!
-
-stamp for the moment when this image was restarted.
+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
@@ -5328,10 +6432,33 @@
"Modified: 6.3.1996 / 11:56:35 / cg"
!
-me
-!
-
-ce }"
+imageSaveTime
+ "{ Pragma: +optSpace }"
+
+ "return a timestamp for the moment when this image was saved"
+
+ ^ ObjectMemory imageSaveTime
+!
+
+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,
@@ -5351,44 +6478,53 @@
"Modified: 8.11.1996 / 19:59:21 / cg"
!
-e>"
-
- ^ 5
-
- "
- Smalltalk majorVersionNr
- "
-
- "Modified: 8.11.1996 / 19:59:21 / cg"
-!
-
-revisionNr
+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>"
+
+ ^ 1
+
+ "
+ Smalltalk minorVersionNr
+ "
+
+ "Modified: / 3.11.1997 / 14:49:48 / 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
- and represent a stable workable version which got published
- to the outside world.
+ 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>"
-
- ^ 5
-
- "
- Smalltalk revisionNr
- Smalltalk hello
- "
-
- "Modified: / 19.6.1998 / 04:29:10 / cg"
-!
-
-"
- Smalltalk releaseIdentification
- "
-!
-
-on>.<release>"
+ <major>.<minor>.<revision>.<release>"
^ 1
@@ -5399,7 +6535,11 @@
"Created: 10.12.1995 / 01:42:19 / cg"
!
-ed for releases which fix bugs/add features
+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.
@@ -5416,22 +6556,83 @@
"Modified: / 19.6.1998 / 04:29:10 / cg"
!
-"
- Smalltalk revisionNr
- Smalltalk hello
- "
-
- "Modified: / 19.6.1998 / 04:29:10 / cg"
-!
-
-('''' , self timeStampString , '''') paddedTo:80 with:(Character space)
-!
-
-/ 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."
+
+ ^ ('From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
+ , Date today printString , ' 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 (__MKSMALLINT(4));
+%}.
+ ^ 4
+
+ "
+ Smalltalk vmMajorVersionNr
+ "
+
! !
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.619 2003-11-18 09:21:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.620 2003-11-18 13:55:34 penk Exp $'
! !