class: Smalltalk
added: #installAutoloadedClassFromSourceFile:
changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
--- a/Smalltalk.st Thu Aug 01 14:44:55 2013 +0200
+++ b/Smalltalk.st Thu Aug 01 17:09:25 2013 +0200
@@ -4796,6 +4796,32 @@
"Created: 17.10.1997 / 13:00:56 / cg"
!
+installAutoloadedClassFromSourceFile:aFilename
+ "install aFilename (which must be a smalltalk source file) as autoloaded class
+ (extract the class definition chunk from the file and create an autoloaded
+ class stub for it)"
+
+ |chunks filename|
+
+ filename := aFilename asFilename.
+
+ ChangeSet::InvalidChangeChunkError handle:[:ex |
+ ^ self
+ ] do:[
+ filename readingFileDo:[:s|
+ chunks := ChangeSet fromStream:s while:[:chunk | chunk isMethodChange not].
+ ].
+ ].
+
+ chunks
+ select:[:eachChunk | eachChunk isClassDefinitionChange]
+ thenDo:[:eachClassChunk |
+ eachClassChunk installAsAutoloadedClassIfPublicWithFilename:filename asAbsoluteFilename "withoutSuffix" name "baseName"
+ ].
+
+ "Created: / 01-08-2013 / 16:57:26 / cg"
+!
+
installAutoloadedClassNamed:clsName category:cat package:package revision:revisionOrNil
"create & install an autoload stub for a class named: clsName,
to be loaded from package.
@@ -5138,117 +5164,127 @@
(however, the directories are searched for packages)
If a file called NOPACKAGES is found, no further searching is done in that directory or below."
- |dir noAutoloadHere dirName pkgName directoryContents|
+ |dir noAutoloadHere dirName pkgName directoryContents haveAbbrevDotSTC|
maxLevels == 0 ifTrue:[
"/ 'Smalltalk [warning]: max directory nesting reached.' infoPrintCR.
- ^ self
+ ^ self
].
dir := aDirectory asFilename.
dirName := dir pathName.
(dirsConsulted includes:dirName) ifTrue:[
- ^ self
+ ^ self
].
dirsConsulted add:dirName.
(dir / 'NOPACKAGES') exists ifTrue:[
- ^ self.
+ ^ self.
].
(dir / 'NOSUBAUTOLOAD') exists ifTrue:[
- ^ self.
+ ^ self.
].
noAutoloadHere := noAutoloadIn.
noAutoloadHere ifFalse:[
- (dir / 'NOAUTOLOAD') exists ifTrue:[
- noAutoloadHere := true.
- ].
+ (dir / 'NOAUTOLOAD') exists ifTrue:[
+ noAutoloadHere := true.
+ ].
] ifTrue:[
- (dir / 'AUTOLOAD') exists ifTrue:[
- noAutoloadHere := false.
- ].
+ (dir / 'AUTOLOAD') exists ifTrue:[
+ noAutoloadHere := false.
+ ].
].
((dir / 'loadAll') exists or:[(dir / 'abbrev.stc') exists]) ifTrue:[
- packageTopPath notNil ifTrue:[
- KnownPackages isNil ifTrue:[
- KnownPackages := Set new.
- ].
- pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
- KnownPackages add:pkgName
- ].
+ packageTopPath notNil ifTrue:[
+ KnownPackages isNil ifTrue:[
+ KnownPackages := Set new.
+ ].
+ pkgName := dirName copyFrom:(packageTopPath asFilename pathName) size + 1 + 1.
+ KnownPackages add:pkgName
+ ].
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes found under "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"/
"/ suppress installation as autoloaded in this and everything
"/ below; however, still traverse the directories to find packages ...
"/
+ haveAbbrevDotSTC := false.
noAutoloadHere ifFalse:[
- [
- self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
- ] on:FileStream openErrorSignal do:[:ex| "ignore this file"].
+ [
+ self installAutoloadedClassesFromAbbrevFile:(dir / 'abbrev.stc').
+ haveAbbrevDotSTC := true.
+ ] on:FileStream openErrorSignal
+ do:[:ex|
+ "ignore this file"
+ ].
].
[
- directoryContents := dir directoryContents asSet. "asSet to speed up remove"
+ directoryContents := dir directoryContents asSet. "asSet to speed up remove"
] on:FileStream openErrorSignal do:[:ex|
- "non-accessable directory: we are done"
- ^ self
+ "non-accessable directory: we are done"
+ ^ self
].
directoryContents removeAllFoundIn:#(
- 'objbc'
- 'objvc'
- 'doc'
- 'CVS'
- 'bitmaps'
- 'resources'
- 'source'
- 'not_delivered'
- 'not_ported'
- ).
+ 'objbc' 'objvc' 'objmingw'
+ 'doc'
+ 'CVS'
+ 'bitmaps'
+ 'resources'
+ 'source'
+ 'not_delivered'
+ 'not_ported'
+ ).
dir baseName = 'stx' ifTrue:[
- directoryContents removeAllFoundIn:#(
- 'configurations'
- 'include'
- 'rules'
- 'stc'
- 'support'
- ).
+ directoryContents removeAllFoundIn:#(
+ 'configurations'
+ 'include'
+ 'rules'
+ 'stc'
+ 'support'
+ ).
].
directoryContents do:[:eachFilenameString |
- |f|
-
- f := dir / eachFilenameString.
- f isDirectory ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:f
- rememberIn:dirsConsulted
- maxLevels:maxLevels-1
- noAutoload:noAutoloadHere
- packageTop:packageTopPath
- showSplashInLevels:showSplashInLevels - 1.
- ]
+ |f|
+
+ f := dir / eachFilenameString.
+ f isDirectory ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:f
+ rememberIn:dirsConsulted
+ maxLevels:maxLevels-1
+ noAutoload:noAutoloadHere
+ packageTop:packageTopPath
+ showSplashInLevels:showSplashInLevels - 1.
+ ] ifFalse:[
+ (noAutoloadHere not and:[haveAbbrevDotSTC not]) ifTrue:[
+ f suffix = 'st' ifTrue:[
+ self installAutoloadedClassFromSourceFile:f
+ ]
+ ].
+ ]
].
showSplashInLevels >= 0 ifTrue:[
- self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
- bindWith:(dirName contractAtBeginningTo:35)).
+ self showSplashMessage:('Smalltalk [info]: installing autoloaded classes from "%1"...'
+ bindWith:(dirName contractAtBeginningTo:35)).
].
"
Smalltalk installAutoloadedClasses
"
- "Modified: / 31-07-2012 / 15:26:54 / cg"
+ "Modified: / 01-08-2013 / 16:57:49 / cg"
!
replaceReferencesTo:anObject with:newRef
@@ -7914,11 +7950,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1032 2013-08-01 10:56:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1033 2013-08-01 15:09:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1032 2013-08-01 10:56:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1033 2013-08-01 15:09:25 cg Exp $'
!
version_SVN