1"======================================================================
2|
3|   File autoloading mechanism
4|
5|
6 ======================================================================"
7
8"======================================================================
9|
10| Copyright 1991,1992,94,95,99,2000,2001,2002,2008
11| Free Software Foundation, Inc.
12| Written by Steve Byrne.
13|
14| This file is part of the GNU Smalltalk class library.
15|
16| The GNU Smalltalk class library is free software; you can redistribute it
17| and/or modify it under the terms of the GNU Lesser General Public License
18| as published by the Free Software Foundation; either version 2.1, or (at
19| your option) any later version.
20|
21| The GNU Smalltalk class library is distributed in the hope that it will be
22| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
24| General Public License for more details.
25|
26| You should have received a copy of the GNU Lesser General Public License
27| along with the GNU Smalltalk class library; see the file COPYING.LIB.
28| If not, write to the Free Software Foundation, 59 Temple Place - Suite
29| 330, Boston, MA 02110-1301, USA.
30|
31 ======================================================================"
32
33
34
35Kernel.PackageInfo extend [
36    autoload [
37        <category: 'private-autoloading'>
38
39        self fileIn
40    ]
41]
42
43FilePath extend [
44    autoload [
45        <category: 'private-autoloading'>
46
47        self withReadStreamDo: [:rs | rs fileIn ]
48    ]
49]
50
51Namespace current: Kernel [
52
53nil subclass: AutoloadClass [
54    "Warning: instance variable indices appear below in #class:in:from:"
55    | superClass methodDictionary instanceSpec subClasses instanceVariables environment name loader |
56
57    <comment: 'I represent the metaclass of an autoloaded class before it is autoloaded.
58Having a proxy for the metaclass as well allows one to send messages to
59the metaclass (such as #methodsFor: to extend it with class-side methods)
60and have the class autoloaded.'>
61    <category: 'Examples-Useful tools'>
62
63    AutoloadClass class >> class: nameSymbol in: aNamespace loader: anObject [
64	| autoload behavior newClass |
65	"Create the metaclass and its sole instance"
66	behavior := Behavior new superclass: Autoload.
67
68	"Turn the metaclass into an instance of AutoloadClass.  To do
69	 this we create a `prototype' in the form of an array..."
70	newClass := Array new: Kernel.AutoloadClass allInstVarNames size.
71	1 to: behavior class instSize
72	    do: [:i | newClass at: i put: (behavior instVarAt: i)].
73
74	newClass
75            at: 6 put: aNamespace;
76            at: 7 put: nameSymbol;
77            at: 8 put: anObject.
78
79	"... and change its class magically after it is initialized."
80	newClass changeClassTo: Kernel.AutoloadClass.
81
82	"Now create the instance.  We go through some hops because of
83	 the very limited set of messages that these classes know
84	 about."
85	autoload := behavior new.
86	behavior become: newClass.
87        ^autoload
88    ]
89
90    name [
91	"Answer the name of the class to be autoloaded"
92
93	<category: 'accessing'>
94	^name
95    ]
96
97    environment [
98	"Answer the namespace in which the class will be autoloaded"
99
100	<category: 'accessing'>
101	^environment
102    ]
103
104    doesNotUnderstand: aMessage [
105	"Load the class and resend the message to its metaclass."
106
107	<category: 'accessing'>
108	^aMessage reinvokeFor: self loadedMetaclass_
109    ]
110
111    loadedMetaclass_ [
112	"File-in the file and answer the metaclass for the new value of the
113	 association which held the receiver"
114
115	<category: 'accessing'>
116	^self loadedClass_ class
117    ]
118
119    loadedClass_ [
120	"File-in the file and answer the new value of the association which
121	 held the receiver"
122
123	<category: 'accessing'>
124	| class saveLoader |
125	loader isNil
126	    ifFalse:
127		[saveLoader := loader.
128		loader := nil.
129		environment at: name put: nil.
130		saveLoader autoload].
131	class := environment at: name ifAbsent: [nil].
132	class isNil ifTrue: [
133            ^Autoload error: '%1 should have defined class %2.%3 but didn''t'
134                % {saveLoader. environment. name asString}].
135	^class
136    ]
137]
138
139]
140
141
142
143nil subclass: Autoload [
144
145    <comment: 'I am not a part of the normal Smalltalk kernel class system.  I provide the
146ability to do late ("on-demand") loading of class definitions.  Through me,
147you can define any class to be loaded when any message is sent to
148the class itself (such as to create an instance) or to its metaclass (such
149as #methodsFor: to extend it with class-side methods).'>
150    <category: 'Examples-Useful tools'>
151
152    Autoload class >> class: nameSymbol from: fileNameString [
153	"Make Smalltalk automatically load the class named nameSymbol
154	 from fileNameString when needed"
155
156	<category: 'instance creation'>
157	^self
158	    class: nameSymbol
159	    in: Namespace current
160	    from: fileNameString
161    ]
162
163    Autoload class >> class: nameSymbol loader: anObject [
164	"Make Smalltalk automatically load the class named nameSymbol.
165	 When the class is needed, anObject will be sent #autoload.
166	 By default, instances of FilePath and Package can be used."
167
168	<category: 'instance creation'>
169	^self
170	    class: nameSymbol
171	    in: Namespace current
172	    loader: anObject
173    ]
174
175    Autoload class >> class: nameSymbol in: aNamespace from: fileNameString [
176	"Make Smalltalk automatically load the class named nameSymbol
177	 and residing in aNamespace from fileNameString when needed"
178
179	<category: 'instance creation'>
180	| file |
181	"Check if the file exists."
182        file := fileNameString asFile.
183	file withReadStreamDo: [ :rs | ].
184
185	"Turn the metaclass into an instance of AutoloadClass.  To do
186	 this we create a `prototype' in the form of an array and then..."
187        ^self class: nameSymbol in: aNamespace loader: file
188    ]
189
190    Autoload class >> class: nameSymbol in: aNamespace loader: anObject [
191	"Make Smalltalk automatically load the class named nameSymbol
192	 and residing in aNamespace.  When the class is needed, anObject
193         will be sent #autoload.  By default, instances of FilePath and
194         Package can be used."
195
196	<category: 'instance creation'>
197	| autoload |
198        autoload := Kernel.AutoloadClass class: nameSymbol in: aNamespace loader: anObject.
199	^aNamespace at: nameSymbol put: autoload
200    ]
201
202    class [
203	"We need it to access the metaclass instance, because that's what
204	 will load the file."
205
206	<category: 'accessing'>
207	<primitive: VMPrimitives.VMpr_Object_class>
208    ]
209
210    doesNotUnderstand: aMessage [
211	"Load the class and resend the message to it"
212
213	<category: 'accessing'>
214	^aMessage reinvokeFor: self class loadedClass_
215    ]
216]
217
218