"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

nil subclass:#Autoload
	instanceVariableNames:''
	classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses'
	poolDictionaries:''
	category:'Kernel-Classes'
!

!Autoload class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    In memory limited systems (as my 8Mb 386 is) all seldom-used classes are made
    subclasses of this class. 
    Autoload catches all messages and files-In the corresponding code
    when first used. 
    Then the caught message is resent to the (now existing) class.

    Class files are searched along the searchPath (see Smalltalk),
    and any of binary-classFile, byteCode-classFile or sourceFile are
    loaded, whichever is found first. For binaries to be loaded,
    these must be found in the 'bin' directory. Sources must be found
    in the 'source' directory.
    (Usually, Autoload classes finds the source file and loads that one).

    When started, the patches startup script arranges for the abbreviation
    file 'include/abbrev.stc' to be read and installs autoload stubs for
    all classes listed in that file, which do not exists already.
    The abbreviation file is maintained by the production environment
    and updated by makefile rules - therefore, it should not be edited
    manually.

    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 
						methods will NOT be compiled at 
						autoload time, but instead when 
						first called. This allows for a 
						faster load. However, expect short 
						pauses later when the methods are
						first executed.
                                     
	AutoloadFailedSignal    <Signal>        signal raised if an autoloaded 
						classes source is not available.

	LoadedClasses           <Collection>    set of classes that heve been
						autoloaded (for later unload)

    [see also:]
	Smalltalk

    [author:]
	Claus Gittinger
"
! !

!Autoload class methodsFor:'initialization'!

initialize
    "initialize the failure-signal"

    AutoloadFailedSignal isNil ifTrue:[
	LazyLoading := false.

	AutoloadFailedSignal := Object errorSignal newSignalMayProceed:true.
	AutoloadFailedSignal nameClass:self message:#autoloadFailedSignal.
	AutoloadFailedSignal notifierString:'autoload failed '.

	self setSuperclass:nil.
	ObjectMemory flushCaches.
    ]

    "Modified: 20.5.1997 / 19:06:25 / cg"
! !

!Autoload class methodsFor:'Signal constants'!

autoloadFailedSignal
    "return the signal raised when an autoload fails"

    ^ AutoloadFailedSignal
! !

!Autoload class methodsFor:'adding/removing autoloaded classes'!

addClass:aClassName
    "given a name, install a corresponding autoload class stub for it.
     Return the (autoload-) stubClass or nil, if no new class was created."

    ^ self addClass:aClassName inCategory:'autoloaded-Classes'

    "
     Autoload addClass:'Clock'
    "

    "Modified: 24.4.1996 / 19:54:16 / cg"
!

addClass:aClassName inCategory:aCategory
    "given a name, install a corresponding autoload class stub for it.
     Return the (autoload-) stubClass or nil, if no new class was created."

    |nameSymbol cls|

    nameSymbol := aClassName asSymbol.
    (Smalltalk at:nameSymbol) isNil ifTrue:[
        cls := Autoload 
                subclass:nameSymbol
                instanceVariableNames:''
                classVariableNames:''
                poolDictionaries:''
                category:aCategory.
    ].
    ^ cls

    "
     Autoload addClass:'Clock' inCategory:'autoloaded-Demos'
    "

    "Modified: 24.4.1996 / 19:54:20 / cg"
!

removeClass:aClass
    "remove a class from the list of loaded classes"

    LoadedClasses remove:aClass ifAbsent:[]

    "Modified: 24.4.1996 / 19:54:35 / cg"
! !

!Autoload class methodsFor:'fileout'!

basicFileOutDefinitionOn:aStream withNameSpace:forceNameSpace
    "print an expression to define myself on aStream.
     Since autoloaded classes dont know their real definition, simply
     output some comment string making things clear in the browser."

    |myName fileName nm mgr classFileName packageDir package|

    (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.
    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 ...
     actually, its a hack & kludge - there ought to be a method for this
     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 := nm , ' (a classLibrary, possibly including more classes)'
        ] ifFalse:[
            nm := Smalltalk getBinaryFileName:(fileName , '.so').
            nm isNil ifTrue:[
                nm := Smalltalk getBinaryFileName:(fileName , '.o')
            ].
            nm notNil ifTrue:[
                nm := nm , ' (a classBinary)'
            ]
        ].
    ].
    nm isNil ifTrue:[
        package := self package.
        package notNil ifTrue:[
            nm := Smalltalk getSourceFileName:((package copyReplaceAll:$: with:$/) , '/' , fileName , '.st').
        ].
        nm isNil ifTrue:[
            nm := Smalltalk getSourceFileName:(fileName , '.st').
        ].
    ].
    nm notNil ifTrue:[
        aStream cr; nextPutLine:'When accessed, ' , myName , ' will automatically be loaded'.
        aStream nextPutLine:'from: '; spaces:4; nextPutAll:nm.
        nm asFilename isSymbolicLink ifTrue:[
            aStream cr; cr.
            aStream nextPutLine:'which is a link to: '; spaces:4; 
                    nextPutAll:(nm asFilename linkInfo path).
        ]
    ] ifFalse:[
        aStream cr; nextPutLine:'There is currently no file to load ' , myName , ' from.'; cr.

        (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
            classFileName := Smalltalk fileNameForClass:myName.
            packageDir := Smalltalk sourceDirectoryNameOfClass:myName.
        ].
        (classFileName notNil and:[packageDir notNil]) ifTrue:[
            aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code 
from "' , classFileName , '.st" in the "' , packageDir , '" package.'.
        ] ifFalse:[
            aStream nextPutAll:'When accessed, an error will be reported.'.
        ]
    ].
    aStream cr; nextPutAll:'"'.

    "Created: / 5.1.1997 / 14:31:33 / cg"
    "Modified: / 5.3.1999 / 12:56:57 / cg"
! !

!Autoload class methodsFor:'lazy compilation'!

compileLazy
    "return the lazy loading flag - if on, fileIn is much faster,
     but pauses are to be expected later, since methods are compiled
     when first executed."

    ^ LazyLoading
!

compileLazy:aBoolean
    "turn on/off lazy loading - if on, fileIn is much faster,
     but pauses are to be expected later, since methods are compiled
     when first executed.
     If you like it, add a line to your startup file."

    LazyLoading := aBoolean
! !

!Autoload class methodsFor:'loading'!

autoload
    "use this to force loading
     - it is defined a noop in all non-autoloading classes"

    |mySelf myName myNameSpace newClass oldMeta project prevMode 
     package newPackage|

    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.
    ].

    [
        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),
        "/ temporarily set the currentProject to nil.
        "/ we will later set the classes package to something useful
        "/
        Project notNil ifTrue:[
            project := Project current.
            Project setProject:nil.
        ].

        Class nameSpaceQuerySignal answer:myNameSpace "Smalltalk" 
        do:[
            package := self package.
            package notNil ifTrue:[
                (package includes:$:) ifTrue:[
                    package := package asString copyReplaceAll:$: with:$/
                ] ifFalse:[
                    package := 'stx/' , package
                ]
            ].

            (Smalltalk 
                fileInClass:myName
                package:package
                initialize:false 
                lazy:LazyLoading
                silent:nil) isNil ifTrue:[
                "/ temporary: try without stx/package prefix
                "/ this will vanishas soon as source-directory
                "/ is always guaranteed to contain an stx-subtree
                (package startsWith:'stx/') ifTrue:[
                    package := package copyFrom:5.
                    Smalltalk 
                        fileInClass:myName
                        package:package
                        initialize:false 
                        lazy:LazyLoading
                        silent:nil.
                ]
            ]
        ].
        ClassCategoryReader sourceMode:prevMode.
        project notNil ifTrue:[
            Project setProject:project.
        ].
    ] valueOnUnwindDo:[
        ClassCategoryReader sourceMode:prevMode.
        project notNil ifTrue:[
            Project setProject:project.
        ].
        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
         cannot be loaded. Usually, this happends when
         some sourcefile is missing, not readable or if 
         an entry is missing in the abbreviation file.
         Check for a readable file named <myName>.st 
         in the 'source' directory and (if its a long fileName) 
         for a corresponding entry in the abbreviation file
         'include/abbrev.stc'.
         Finally, your searchpath could be set wrong -
         both 'source' and 'include' directories must be found in
         one of the directories named in systemPath.

         In the debugger, press 'abort' to continue execution.
        " 
        AutoloadFailedSignal
            raiseRequestWith:self
            errorString:('autoload of ' , myName , ' failed').
        ^ nil
    ].

    "/
    "/ autoloaded classes get their package from the revision (if present)
    "/ this only happens with autoloaded sourceFiles which have no package
    "/ info encoded. (binary classes have it)
    "/ If there is no such information, give it my package (if I have one)
    "/
    newClass setPackageFromRevision.

    newPackage := newClass package.
    (newPackage isNil or:[newPackage = 'no package']) ifTrue:[
        (package notNil and:[package ~= 'no package']) ifTrue:[
            newClass setPackage:package.
        ].
    ].

    LoadedClasses isNil ifTrue:[
        LoadedClasses := IdentitySet new.
    ].
    LoadedClasses add:newClass.

    "wow - it worked. now the big trick ..."

"/    newClass class setSoleInstance:self.   "/ will be undone by become ...
    oldMeta := self class.

"/ self setName:(self name , ' (auto)').

    self becomeSameAs:newClass.
    oldMeta becomeSameAs:newClass class.

    ObjectMemory flushCaches.
    LoadedClasses rehash.

    newClass initializeWithAllPrivateClasses.
    newClass postAutoload.
    ^ newClass

    "Modified: / 5.3.1999 / 12:59:13 / cg"
! !

!Autoload class methodsFor:'message catching'!

basicNew
    "catch basicNew - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#basicNew)

    "Modified: 24.4.1996 / 19:53:10 / cg"
!

basicNew:arg
    "catch basicNew: - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)

    "Modified: 24.4.1996 / 19:53:16 / cg"
!

comment
    "return the classes comment.
     Autoloaded classes have no comment; but I myself have one"

    (self == Autoload) ifTrue:[^ super comment].
    ^ 'not yet loaded'
!

doesNotUnderstand:aMessage
    "caught a message; load the class and retry the message"

    |newClass|

    self ~~ Autoload ifTrue:[
	newClass := self autoload.
	newClass notNil ifTrue:[
	    ^ newClass perform:(aMessage selector)
		 withArguments:(aMessage arguments)
	]
    ].
    ^ super doesNotUnderstand:aMessage

    "Modified: 24.4.1996 / 19:53:27 / cg"
!

new
    "catch new - load the class and resend #new to the real one"

    ^ self doesNotUnderstand:(Message selector:#new)

    "Modified: 26.5.1997 / 14:59:52 / cg"
!

new:arg
    "catch new: - load the class and resend #new: it to the real one"

    ^ self doesNotUnderstand:(Message selector:#new: with:arg)

    "Modified: 26.5.1997 / 14:59:58 / cg"
!

readFrom:aStream 
    "catch  - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#readFrom: with:aStream)

    "Created: 22.5.1996 / 23:44:23 / stefan"
!

readFrom:aStream onError:exceptionBlock
    "catch  - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#readFrom:onError: with:aStream with:exceptionBlock)

    "Created: 22.5.1996 / 23:03:39 / stefan"
!

readFromString:aString
    "catch  - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#readFromString: with:aString)

    "Created: 22.5.1996 / 23:46:15 / stefan"
!

readFromString:aString onError:exceptionBlock
    "catch  - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#readFromString:onError: with:aString with:exceptionBlock)

    "Created: 22.5.1996 / 23:04:49 / stefan"
!

respondsTo:aSelector
    "catch respondsTo: - load the class and resend #respondsTo: it to the real one"

    self == Autoload ifTrue:[
	^ super respondsTo:aSelector
    ].
    ^ self doesNotUnderstand:(Message selector:#respondsTo: with:aSelector)

    "Modified: 26.5.1997 / 14:59:58 / 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     
	instanceVariableNames:instVarNames 
	classVariableNames:cVarNames 
	poolDictionaries:pools 
	category:cat
	inEnvironment:(Class nameSpaceQuerySignal raise)

    "Modified: 8.2.1997 / 20:06:22 / cg"
!

subclass:nameSymbol instanceVariableNames:instVarNames classVariableNames:cVarNames poolDictionaries:poolDicts category:cat inEnvironment:aNameSpace
    "catch subclass creation - this forces missing superclasses to be 
     loaded first"

    |newClass sel args|

    "take care: subclassing Autoload must still be possible"
    (self == Autoload) ifTrue:[
	^ super 
	    subclass:nameSymbol 
	    instanceVariableNames:instVarNames
	    classVariableNames:cVarNames
	    poolDictionaries:poolDicts
	    category:cat
	    inEnvironment:aNameSpace
    ].

    newClass := self autoload.
    sel := thisContext selector.
    args := thisContext args.
    newClass notNil ifTrue:[
	^ newClass perform:sel withArguments:args
    ].
    ^ nil

    "Created: 8.2.1997 / 19:42:47 / cg"
!

subclass:nameSymbol instanceVariableNames:instVarNames classVariableNames:cVarNames poolDictionaries:poolDicts privateIn:owningClass
    "catch subclass creation - this forces missing superclasses to be 
     loaded first"

    |newClass sel args|

    "take care: subclassing Autoload must still be possible"
    (self == Autoload) ifTrue:[
	^ super 
	    subclass:nameSymbol 
	    instanceVariableNames:instVarNames 
	    classVariableNames:cVarNames 
	    poolDictionaries:poolDicts 
	    privateIn:owningClass
    ].

    newClass := self autoload.
    sel := thisContext selector.
    args := thisContext args.
    newClass notNil ifTrue:[
	^ newClass perform:sel withArguments:args
    ].
    ^ nil

    "Created: 8.2.1997 / 19:42:47 / cg"
! !

!Autoload class methodsFor:'queries'!

allPrivateClassesDo:aBlock
    "an autoloaded class has none"
!

isBehavior
    "return true if the recevier is some kind of class.
     Autoloaded classes are definitely; therefore return true."

    ^ true
!

isBuiltInClass
    "return true if this class is known by the run-time-system.
     Returns false here."

    ^ false

    "Created: 10.12.1995 / 00:28:22 / cg"
    "Modified: 23.4.1996 / 15:55:36 / cg"
!

isLoaded
    "return true, if the class has been loaded.
     Autoload itself is loaded, subclasses are not.
     This allows testing wether a class has already been loaded."

    ^ (self == Autoload)

    "Modified: / 16.2.1998 / 11:57:35 / stefan"
!

loadedClasses
    "return the set of classes that were autoloaded"

    ^ LoadedClasses
!

privateClasses
    "an autoloaded class has none"

    ^ #()
!

wasAutoloaded:aClass
    "return true, if aClass was autoloaded"

    ^ LoadedClasses notNil and:[LoadedClasses includes:aClass]
! !

!Autoload class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.88 1999-03-18 16:26:20 cg Exp $'
! !
Autoload initialize!