class: Smalltalk
authorClaus Gittinger <cg@exept.de>
Thu, 01 Aug 2013 17:09:25 +0200
changeset 15596 6e05c159e789
parent 15595 fa5010435cda
child 15597 c2ad68dad8b1
class: Smalltalk added: #installAutoloadedClassFromSourceFile: changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
Smalltalk.st
--- 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