checkin from browser
authorClaus Gittinger <cg@exept.de>
Mon, 26 Jul 1999 16:03:12 +0200
changeset 4458 6f46b35f787c
parent 4457 001af8a9bd46
child 4459 a0466230c74b
checkin from browser
Smalltalk.st
--- a/Smalltalk.st	Mon Jul 26 16:01:44 1999 +0200
+++ b/Smalltalk.st	Mon Jul 26 16:03:12 1999 +0200
@@ -1527,6 +1527,12 @@
     "Created: 11.10.1996 / 18:10:43 / cg"
 !
 
+isTopLevelNamespace
+    ^ true
+
+    "Created: 11.10.1996 / 18:10:43 / cg"
+!
+
 numberOfGlobals
     "return the number of global variables in the system"
 
@@ -2501,6 +2507,22 @@
     "read the standard abbreviation file; install all classes found there as
      autoloaded. This takes some time ..."
 
+    |f|
+
+    "/ new scheme: look for a directory called 'packages'
+    "/ and enumerate its abbrev.stc files...
+    f := Smalltalk getSystemFileName:'packages'.
+    f notNil ifTrue:[
+        f := f asFilename.
+        f isDirectory ifTrue:[
+            self recursiveInstallAutoloadedClassesFrom:f.
+            ^ self
+        ].
+    ].
+
+    "/ old scheme: look for a single file called 'abbrev.stc' in the
+    "/ include directory. This will vanish.
+
     self installAutoloadedClassesFrom:'include/abbrev.stc'
 
     "
@@ -2515,56 +2537,16 @@
     "read the given abbreviation file; install all classes found there as
      autoloaded. This takes some time ..."
 
-    |f s s2 l clsName abbrev package cat rev cls|
+    |f s|
 
     f := self getSystemFileName:anAbbrevFilePath.
 
     f notNil ifTrue:[
-	s := f asFilename readStream.
-	s notNil ifTrue:[
-
-	    "/ yes, create any required nameSpace, without asking user.
-	    Class createNameSpaceQuerySignal answer:true do:[
-
-		[s atEnd] whileFalse:[
-		    l := s nextLine withoutSeparators.
-		    l notEmpty ifTrue:[
-			s2 := l readStream.
-			clsName := (s2 upTo:Character space) withoutSeparators asSymbol.
-			(self at:clsName) isNil ifTrue:[
-			    s2 skipSeparators.
-			    abbrev := (s2 upTo:Character space) withoutSeparators asSymbol.
-			    s2 skipSeparators.
-			    package := (s2 upTo:Character space) withoutSeparators asSymbol.
-			    s2 skipSeparators.
-
-			    rev := nil.    
-			    s2 skipSeparators.
-			    s2 atEnd ifFalse:[
-				s2 peek isDigit ifTrue:[
-				    rev := (s2 upTo:Character space) withoutSeparators.
-				    s2 skipSeparators.
-				]
-			    ].
-			    cat := s2 upToEnd withoutSeparators.
-
-			    (cat startsWith:$') ifTrue:[
-				cat := (cat copyFrom:2 to:(cat size - 1)) withoutSeparators.
-			    ].
-
-			    (cat size == 0) ifTrue:[
-				cat := 'autoloaded'
-			    ].
-
-			    "/ '  autoloaded: ' print. clsName print. ' in ' print. cat printCR.
-
-			    self installAutoloadedClassNamed:clsName category:cat package:package revision:rev.
-			]
-		    ]
-		]
-	    ].
-	    s close.
-	].
+        s := f asFilename readStream.
+        s notNil ifTrue:[
+            self installAutoloadedClassesFromStream:s.
+            s close.
+        ].
     ]
 
     "
@@ -2574,6 +2556,54 @@
     "Modified: / 5.11.1998 / 15:10:51 / cg"
 !
 
+installAutoloadedClassesFromStream:anAbbrevFileStream
+    "read the given abbreviation file; install all classes found there as
+     autoloaded. This takes some time ..."
+
+    |f s2 l clsName abbrev package cat rev cls|
+
+    "/ yes, create any required nameSpace, without asking user.
+    Class createNameSpaceQuerySignal answer:true do:[
+
+        [anAbbrevFileStream atEnd] whileFalse:[
+            l := anAbbrevFileStream nextLine withoutSeparators.
+            l notEmpty ifTrue:[
+                s2 := l readStream.
+                clsName := (s2 upTo:Character space) withoutSeparators asSymbol.
+                (self at:clsName) isNil ifTrue:[
+                    s2 skipSeparators.
+                    abbrev := (s2 upTo:Character space) withoutSeparators asSymbol.
+                    s2 skipSeparators.
+                    package := (s2 upTo:Character space) withoutSeparators asSymbol.
+                    s2 skipSeparators.
+
+                    rev := nil.    
+                    s2 skipSeparators.
+                    s2 atEnd ifFalse:[
+                        s2 peek isDigit ifTrue:[
+                            rev := (s2 upTo:Character space) withoutSeparators.
+                            s2 skipSeparators.
+                        ]
+                    ].
+                    cat := s2 upToEnd withoutSeparators.
+
+                    (cat startsWith:$') ifTrue:[
+                        cat := (cat copyFrom:2 to:(cat size - 1)) withoutSeparators.
+                    ].
+
+                    (cat size == 0) ifTrue:[
+                        cat := 'autoloaded'
+                    ].
+
+                    "/ '  autoloaded: ' print. clsName print. ' in ' print. cat printCR.
+
+                    self installAutoloadedClassNamed:clsName category:cat package:package revision:rev.
+                ]
+            ]
+        ]
+    ]
+!
+
 loadBinaries
     "return true, if binaries should be loaded into the system,
      false if this should be suppressed. The default is false (for now)."
@@ -2650,6 +2680,31 @@
     "Created: 17.10.1997 / 13:52:19 / cg"
 !
 
+recursiveInstallAutoloadedClassesFrom:aDirectory
+    "read all abbrev.stc files from and under aDirectory
+     and install autoloaded classes."
+
+    |abbrevStream dir|
+
+    dir := aDirectory asFilename.
+
+    abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+    abbrevStream notNil ifTrue:[
+        self installAutoloadedClassesFromStream:abbrevStream.
+        abbrevStream close.
+    ].
+
+    dir directoryContents do:[:aFilename |
+        |f|
+
+        f := dir construct:aFilename.
+        f isDirectory ifTrue:[
+            self recursiveInstallAutoloadedClassesFrom:f
+        ].
+    ].
+
+!
+
 saveEmergencyImage:aBoolean
     "set/clear the flag which controls if ST/X should save an
      emergency image in case of a broken display connection.
@@ -3715,16 +3770,29 @@
     "read classname to filename mappings from include/abbrev.stc.
      sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
 
-    |aStream|
+    |aStream f|
 
     CachedAbbreviations := IdentityDictionary new.
 
+    "/ new scheme: look for a directory called 'packages'
+    "/ and enumerate its abbrev.stc files...
+    f := Smalltalk getSystemFileName:'packages'.
+    f notNil ifTrue:[
+        f := f asFilename.
+        f isDirectory ifTrue:[
+            self recursiveReadAllAbbreviationsFrom:f.
+            ^ self
+        ].
+    ].
+
+    "/ 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:[
-        self readAbbreviationsFrom:aStream.
+        self readAbbreviationsFromStream:aStream.
     ] ifFalse:[
         ('Smalltalk [warning]: no ''abbrev.stc'' file found') infoPrintCR
-
     ].
     ^ CachedAbbreviations
 
@@ -3735,7 +3803,7 @@
     "Modified: / 27.7.1998 / 19:59:07 / cg"
 !
 
-readAbbreviationsFrom:aStream
+readAbbreviationsFromStream:aStream
     "read classname to filename mappings from aStream.
      sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
 
@@ -3818,6 +3886,29 @@
     ^ RealSystemPath
 !
 
+recursiveReadAllAbbreviationsFrom:aDirectory
+    "read all abbreviations from and under aDirectory."
+
+    |abbrevStream dir|
+
+    dir := aDirectory asFilename.
+
+    abbrevStream := (dir construct:'abbrev.stc') asFilename readStream.
+    abbrevStream notNil ifTrue:[
+        self readAbbreviationsFromStream:abbrevStream.
+        abbrevStream close.
+    ].
+
+    dir directoryContents do:[:aFilename |
+        |f|
+
+        f := dir construct:aFilename.
+        f isDirectory ifTrue:[
+            self recursiveReadAllAbbreviationsFrom:f
+        ].
+    ].
+!
+
 resourceFileStreamFor:aFileName
     "search aFileName in some standard places;
      return a readonly fileStream or nil if not found.
@@ -4306,5 +4397,5 @@
 !Smalltalk class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.328 1999-07-22 16:05:59 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.329 1999-07-26 14:03:12 cg Exp $'
 ! !