hg/stx-libbasic: comparison Autoload.st

equal deleted inserted replaced

-:7e1d4efc5ba5
+:7d677a5ced41
 Late addition: above comment is no longer true - I have made now almost
 all Demos & Goodies be autoloaded ... even for big systems.
 [class variables:]
-LazyLoading             <Boolean>       if true, the loaded classes
+	LazyLoading             <Boolean>       if true, the loaded classes
-methods will NOT be compiled at
+						methods will NOT be compiled at
-autoload time, but instead when
+						autoload time, but instead when
-first called. This allows for a
+						first called. This allows for a
-faster load. However, expect short
+						faster load. However, expect short
-pauses later when the methods are
+						pauses later when the methods are
-first executed.
+						first executed.
-AutoloadFailedSignal    <Signal>        signal raised if an autoloaded
+	AutoloadFailedSignal    <Signal>        signal raised if an autoloaded
-classes source is not available.
+						classes source is not available.
-LoadedClasses           <Collection>    set of classes that heve been
+	LoadedClasses           <Collection>    set of classes that heve been
-autoloaded (for later unload)
+						autoloaded (for later unload)
 [see also:]
-Smalltalk
+	Smalltalk
 [author:]
-Claus Gittinger
+	Claus Gittinger
 "
 ! !
 !Autoload class methodsFor:'initialization'!
 initialize
 "initialize the failure-signal"
 AutoloadFailedSignal isNil ifTrue:[
-LazyLoading := false.
+	LazyLoading := false.
-AutoloadFailedSignal := Object errorSignal newSignalMayProceed:true.
+	AutoloadFailedSignal := Object errorSignal newSignalMayProceed:true.
-AutoloadFailedSignal nameClass:self message:#autoloadFailedSignal.
+	AutoloadFailedSignal nameClass:self message:#autoloadFailedSignal.
-AutoloadFailedSignal notifierString:'autoload failed '.
+	AutoloadFailedSignal notifierString:'autoload failed '.
-self setSuperclass:nil.
+	self setSuperclass:nil.
-ObjectMemory flushCaches.
+	ObjectMemory flushCaches.
 ]
 "Modified: 20.5.1997 / 19:06:25 / cg"
 ! !
 |nameSymbol|
 nameSymbol := aClassName asSymbol.
 (Smalltalk at:nameSymbol) isNil ifTrue:[
-Autoload subclass:nameSymbol
+	Autoload subclass:nameSymbol
-instanceVariableNames:''
+	     instanceVariableNames:''
-classVariableNames:''
+	     classVariableNames:''
-poolDictionaries:''
+	     poolDictionaries:''
-category:aCategory.
+	     category:aCategory.
 ]
 "
 Autoload addClass:'Clock' inCategory:'autoloaded-Demos'
 "
 (self == Autoload) ifTrue:[^ super basicFileOutDefinitionOn:aStream withNameSpace:forceNameSpace].
 myName := self name.
 aStream nextPutAll:'"' ; nextPutLine:'Notice from Autoload:'; cr;
-spaces:4; nextPutLine:myName , ' is not yet loaded.'; cr.
+	    spaces:4; nextPutLine:myName , ' is not yet loaded.'; cr.
 aStream nextPutAll:'to load, execute: '.
 aStream cr; cr; spaces:4; nextPutLine:myName  , ' autoload'.
 aStream cr; nextPutLine:'or use the browsers load-function (in the class menu).'.
 "
 the following is simply informative ...
 in Smalltalk
 (knowing the details of loading here is no good coding style)
 "
 fileName := Smalltalk fileNameForClass:myName.
 (ObjectFileLoader notNil and:[Smalltalk loadBinaries]) ifTrue:[
-(nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
+	(nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
-nm := nm , ' (a classLibrary, possibly including more classes)'
+	    nm := nm , ' (a classLibrary, possibly including more classes)'
-] ifFalse:[
+	] ifFalse:[
-nm := Smalltalk getBinaryFileName:(fileName , '.so').
+	    nm := Smalltalk getBinaryFileName:(fileName , '.so').
-nm isNil ifTrue:[
+	    nm isNil ifTrue:[
-nm := Smalltalk getBinaryFileName:(fileName , '.o')
+		nm := Smalltalk getBinaryFileName:(fileName , '.o')
-].
+	    ].
-nm notNil ifTrue:[
+	    nm notNil ifTrue:[
-nm := nm , ' (a classBinary)'
+		nm := nm , ' (a classBinary)'
-]
+	    ]
-].
+	].
 ].
 nm isNil ifTrue:[
-nm := Smalltalk getFileInFileName:(fileName , '.st').
+	nm := Smalltalk getFileInFileName:(fileName , '.st').
-nm isNil ifTrue:[
+	nm isNil ifTrue:[
-nm := Smalltalk getSourceFileName:(fileName , '.st').
+	    nm := Smalltalk getSourceFileName:(fileName , '.st').
-].
+	].
 ].
 nm notNil ifTrue:[
-aStream cr; nextPutLine:'When accessed, ' , myName , ' will automatically be loaded'.
+	aStream cr; nextPutLine:'When accessed, ' , myName , ' will automatically be loaded'.
-aStream nextPutLine:'from: '; spaces:4; nextPutAll:nm.
+	aStream nextPutLine:'from: '; spaces:4; nextPutAll:nm.
-nm asFilename isSymbolicLink ifTrue:[
+	nm asFilename isSymbolicLink ifTrue:[
-aStream cr; cr.
+	    aStream cr; cr.
-aStream nextPutLine:'which is a link to: '; spaces:4;
+	    aStream nextPutLine:'which is a link to: '; spaces:4;
-nextPutAll:(nm asFilename linkInfo path).
+		    nextPutAll:(nm asFilename linkInfo path).
-]
+	]
 ] ifFalse:[
-aStream cr; nextPutLine:'There is currently no file to load ' , myName , ' from.'; cr.
+	aStream cr; nextPutLine:'There is currently no file to load ' , myName , ' from.'; cr.
-(mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+	(mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
-classFileName := Smalltalk fileNameForClass:myName.
+	    classFileName := Smalltalk fileNameForClass:myName.
-packageDir := Smalltalk sourceDirectoryNameOfClass:myName.
+	    packageDir := Smalltalk sourceDirectoryNameOfClass:myName.
-].
+	].
-(classFileName notNil and:[packageDir notNil]) ifTrue:[
+	(classFileName notNil and:[packageDir notNil]) ifTrue:[
-aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code
+	    aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code
 from "' , classFileName , '.st" in the "' , packageDir , '" package.'.
-] ifFalse:[
+	] ifFalse:[
-aStream nextPutAll:'When accessed, an error will be reported.'.
+	    aStream nextPutAll:'When accessed, an error will be reported.'.
-]
+	]
 ].
 aStream cr; nextPutAll:'"'.
 "Modified: 30.12.1996 / 17:25:15 / cg"
 "Created: 5.1.1997 / 14:31:33 / cg"
 autoload
 "use this to force loading
 - it is defined a noop in all non-autoloading classes"
-|mySelf myName newClass oldMeta project prevMode package|
+|mySelf myName myNameSpace newClass oldMeta project prevMode package|
 mySelf := self.
 myName := self name asSymbol.
+myNameSpace := self nameSpace.
 "remove myself - to avoid recompilation"
 Smalltalk at:myName put:nil.
 "load it"
 (Object infoPrinting and:[Smalltalk silentLoading ~~ true]) ifTrue:[
-Transcript showCR:('autoloading ', myName , ' ...'); endEntry.
+	Transcript showCR:('autoloading ', myName , ' ...'); endEntry.
 ].
 [
-prevMode := ClassCategoryReader sourceMode.
+	prevMode := ClassCategoryReader sourceMode.
 "/
 "/ no- do not do this; it may lead to trouble ...
 "/        ClassCategoryReader sourceMode:#reference.
-"/
+	"/
-"/ in order to not get a package of private (or whatever),
+	"/ in order to not get a package of private (or whatever),
-"/ temporarily set the currentProject to nil.
+	"/ temporarily set the currentProject to nil.
-"/ we will later set the classes package to something useful
+	"/ we will later set the classes package to something useful
-"/
+	"/
-Project notNil ifTrue:[
+	Project notNil ifTrue:[
-project := Project current.
+	    project := Project current.
-Project setProject:nil.
+	    Project setProject:nil.
-].
+	].
-Class nameSpaceQuerySignal answer:Smalltalk
+	Class nameSpaceQuerySignal answer:myNameSpace "Smalltalk"
-do:[
+	do:[
-Smalltalk fileInClass:myName initialize:false lazy:LazyLoading.
+	    Smalltalk fileInClass:myName initialize:false lazy:LazyLoading.
-].
+	].
-ClassCategoryReader sourceMode:prevMode.
+	ClassCategoryReader sourceMode:prevMode.
-project notNil ifTrue:[
+	project notNil ifTrue:[
-Project setProject:project.
+	    Project setProject:project.
-].
+	].
 ] valueOnUnwindDo:[
-ClassCategoryReader sourceMode:prevMode.
+	ClassCategoryReader sourceMode:prevMode.
-project notNil ifTrue:[
+	project notNil ifTrue:[
-Project setProject:project.
+	    Project setProject:project.
-].
+	].
-Smalltalk at:myName put:mySelf.
+	Smalltalk at:myName put:mySelf.
 ].
 "did it work ?"
 newClass := Smalltalk at:myName.
 Smalltalk at:myName put:mySelf.   "will be undone by become:"
 "no - report the error"
 newClass isNil ifTrue:[
-"
+	"
-this signal is raised, if an autoloaded class
+	 this signal is raised, if an autoloaded class
-cannot be loaded. Usually, this happends when
+	 cannot be loaded. Usually, this happends when
-some sourcefile is missing, not readable or if
+	 some sourcefile is missing, not readable or if
-an entry is missing in the abbreviation file.
+	 an entry is missing in the abbreviation file.
-Check for a readable file named <myName>.st
+	 Check for a readable file named <myName>.st
-in the 'source' directory and (if its a long fileName)
+	 in the 'source' directory and (if its a long fileName)
-for a corresponding entry in the abbreviation file
+	 for a corresponding entry in the abbreviation file
-'include/abbrev.stc'.
+	 'include/abbrev.stc'.
-Finally, your searchpath could be set wrong -
+	 Finally, your searchpath could be set wrong -
-both 'source' and 'include' directories must be found in
+	 both 'source' and 'include' directories must be found in
-one of the directories named in systemPath.
+	 one of the directories named in systemPath.
-In the debugger, press 'abort' to continue execution.
+	 In the debugger, press 'abort' to continue execution.
-"
+	"
-AutoloadFailedSignal
+	AutoloadFailedSignal
-raiseRequestWith:self
+	    raiseRequestWith:self
-errorString:('autoload of ' , myName , ' failed').
+	    errorString:('autoload of ' , myName , ' failed').
-^ nil
+	^ nil
 ].
 "/
 "/ autoloaded classes get their package from the revision (if present)
 "/ this only happens with autoloaded sourceFiles which have no package
 "/ If there is no such information, give it my package (if I have one)
 "/
 newClass setPackageFromRevision.
 (newClass package isNil
 or:[newClass package = 'no package']) ifTrue:[
-package := self package.
+	package := self package.
-(package notNil and:[package ~= 'no package'])
+	(package notNil and:[package ~= 'no package'])
-ifTrue:[
+	ifTrue:[
-newClass setPackage:package.
+	    newClass setPackage:package.
-].
+	].
 ].
 LoadedClasses isNil ifTrue:[
-LoadedClasses := IdentitySet new.
+	LoadedClasses := IdentitySet new.
 ].
 LoadedClasses add:newClass.
 "wow - it worked. now the big trick ..."
 ObjectMemory flushCaches.
 LoadedClasses rehash.
 (newClass class implements:#initialize) ifTrue:[
-newClass initialize.
+	newClass initialize.
 ].
 newClass privateClassesDo:[:aPrivateClass |
-(aPrivateClass class implements:#initialize) ifTrue:[
+	(aPrivateClass class implements:#initialize) ifTrue:[
-aPrivateClass initialize.
+	    aPrivateClass initialize.
-]
+	]
 ].
 newClass postAutoload.
 ^ newClass
-"Modified: 12.4.1997 / 15:42:29 / cg"
+"Modified: 15.10.1997 / 03:44:25 / cg"
 ! !
 !Autoload class methodsFor:'message catching'!
 basicNew
 "caught a message; load the class and retry the message"
 |newClass|
 self ~~ Autoload ifTrue:[
-newClass := self autoload.
+	newClass := self autoload.
-newClass notNil ifTrue:[
+	newClass notNil ifTrue:[
-^ newClass perform:(aMessage selector)
+	    ^ newClass perform:(aMessage selector)
-withArguments:(aMessage arguments)
+		 withArguments:(aMessage arguments)
-]
+	]
 ].
 ^ super doesNotUnderstand:aMessage
 "Modified: 24.4.1996 / 19:53:27 / cg"
 !
 subclass:nameSymbol instanceVariableNames:instVarNames classVariableNames:cVarNames poolDictionaries:pools category:cat
 "catch subclass creation - this forces missing superclasses to be
 loaded first"
 ^ self
-subclass:nameSymbol
+	subclass:nameSymbol
-instanceVariableNames:instVarNames
+	instanceVariableNames:instVarNames
-classVariableNames:cVarNames
+	classVariableNames:cVarNames
-poolDictionaries:pools
+	poolDictionaries:pools
-category:cat
+	category:cat
-inEnvironment:(Class nameSpaceQuerySignal raise)
+	inEnvironment:(Class nameSpaceQuerySignal raise)
 "Modified: 8.2.1997 / 20:06:22 / cg"
 !
 subclass:nameSymbol instanceVariableNames:instVarNames classVariableNames:cVarNames poolDictionaries:poolDicts category:cat inEnvironment:aNameSpace
 |newClass sel args|
 "take care: subclassing Autoload must still be possible"
 (self == Autoload) ifTrue:[
-^ super
+	^ super
-subclass:nameSymbol
+	    subclass:nameSymbol
-instanceVariableNames:instVarNames
+	    instanceVariableNames:instVarNames
-classVariableNames:cVarNames
+	    classVariableNames:cVarNames
-poolDictionaries:poolDicts
+	    poolDictionaries:poolDicts
-category:cat
+	    category:cat
-inEnvironment:aNameSpace
+	    inEnvironment:aNameSpace
 ].
 newClass := self autoload.
 sel := thisContext selector.
 args := thisContext args.
 newClass notNil ifTrue:[
-^ newClass perform:sel withArguments:args
+	^ newClass perform:sel withArguments:args
 ].
 ^ nil
 "Created: 8.2.1997 / 19:42:47 / cg"
 !
 |newClass sel args|
 "take care: subclassing Autoload must still be possible"
 (self == Autoload) ifTrue:[
-^ super
+	^ super
-subclass:nameSymbol
+	    subclass:nameSymbol
-instanceVariableNames:instVarNames
+	    instanceVariableNames:instVarNames
-classVariableNames:cVarNames
+	    classVariableNames:cVarNames
-poolDictionaries:poolDicts
+	    poolDictionaries:poolDicts
-privateIn:owningClass
+	    privateIn:owningClass
 ].
 newClass := self autoload.
 sel := thisContext selector.
 args := thisContext args.
 newClass notNil ifTrue:[
-^ newClass perform:sel withArguments:args
+	^ newClass perform:sel withArguments:args
 ].
 ^ nil
 "Created: 8.2.1997 / 19:42:47 / cg"
 ! !
 ! !
 !Autoload class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.75 1997-06-17 08:22:49 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.76 1997-10-15 12:30:19 cg Exp $'
 ! !
 Autoload initialize!

changeset 3027	7d677a5ced41
parent 2691	33221e233f79
child 3151	018115a34d6f