"
COPYRIGHT (c) 1991-93 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.
"
Object subclass:#Autoload
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes'
!
Autoload comment:'
COPYRIGHT (c) 1991-93 by Claus Gittinger
All Rights Reserved
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 cought message
is resent to the (now existing) class.
$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.3 1993-10-13 00:14:42 claus Exp $
written fall 91 by claus
'!
!Autoload class methodsFor:'queries'!
isLoaded
"return true, if the class has been loaded; redefined in Autoload;
see comment there. this allows testing for a class been already loaded."
^ false
! !
!Autoload class methodsFor:'loading'!
autoload
"use this to force loading
- it is defined a noop in all non-autoloading clases"
|mySelf myName mySym newClass|
mySelf := self.
myName := self name.
mySym := myName asSymbol.
"remove myself - to avoid recompilation"
Smalltalk at:mySym put:nil.
"load it"
Transcript showCr:('autoloading ', myName , ' ...').
Smalltalk fileInClass:myName.
"did it work ?"
newClass := Smalltalk at:mySym.
Smalltalk at:mySym put:mySelf. "will be undone by become:"
newClass isNil ifTrue:[
"no - forget it"
self warn:('autoload of ' , myName , ' failed').
^ nil
].
"wow - it did. now the big trick ..."
self become:newClass.
^ self
! !
!Autoload class methodsFor:'message catching'!
doesNotUnderstand:aMessage
"cought a message; load class and retry"
|newClass|
newClass := self autoload.
newClass notNil ifTrue:[
^ newClass perform:(aMessage selector)
withArguments:(aMessage arguments)
].
super doesNotUnderstand:aMessage
!
new
"catch new"
^ self doesNotUnderstand:(Message selector:#new)
!
basicNew
"catch basicNew"
^ self doesNotUnderstand:(Message selector:#basicew)
!
new:arg
"catch new:"
^ self doesNotUnderstand:(Message selector:#new: with:arg)
!
basicNew:arg
"catch basicNew:"
^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)
!
subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5
"catch subclass creation - this forces missing superclasses to be
loaded first"
|newClass|
"take care: subclassing Autoload must still be possible"
(self == Autoload) ifTrue:[
^ super subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5
].
newClass := self autoload.
newClass notNil ifTrue:[
^ newClass perform:(thisContext selector)
withArguments:(thisContext args)
].
^ nil
! !