70 being put on your code ;-). |
71 being put on your code ;-). |
71 On the other hand: I want every file created by myself to have the |
72 On the other hand: I want every file created by myself to have the |
72 copyright string at the beginning be preserved .... even if the |
73 copyright string at the beginning be preserved .... even if the |
73 code was edited in the browser and filedOut. |
74 code was edited in the browser and filedOut. |
74 " |
75 " |
75 (copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[ |
76 self generateHeaderWithCopyrightOn:outStream. |
|
77 |
|
78 stampIt ifTrue:[ |
|
79 "/ |
|
80 "/ first, a timestamp |
|
81 "/ |
|
82 outStream nextPutAll:(Smalltalk timeStamp). |
|
83 outStream nextPutChunkSeparator. |
|
84 outStream cr; cr. |
|
85 ]. |
|
86 |
|
87 withDefinition ifTrue:[ |
|
88 "/ |
|
89 "/ then the definition(s) |
|
90 "/ |
|
91 self fileOutAllDefinitionsOf:nonMeta on:outStream. |
|
92 "/ |
|
93 "/ a comment - if any |
|
94 "/ |
|
95 (comment := nonMeta comment) notNil ifTrue:[ |
|
96 nonMeta fileOutCommentOn:outStream. |
|
97 outStream cr. |
|
98 ]. |
|
99 "/ |
|
100 "/ ST/X primitive definitions - if any |
|
101 "/ |
|
102 nonMeta fileOutPrimitiveSpecsOn:outStream. |
|
103 ]. |
|
104 |
|
105 "/ |
|
106 "/ methods from all categories in metaclass (i.e. class methods) |
|
107 "/ EXCEPT: the version method is placed at the very end, to |
|
108 "/ avoid sourcePosition-shifts when checked out later. |
|
109 "/ (RCS expands this string, so its size is not constant) |
|
110 "/ |
|
111 collectionOfCategories := meta categories asSortedCollection. |
|
112 collectionOfCategories notNil ifTrue:[ |
|
113 "/ |
|
114 "/ documentation first (if any), but not the version method |
|
115 "/ |
|
116 (collectionOfCategories includes:'documentation') ifTrue:[ |
|
117 versionMethod := meta compiledMethodAt:(nonMeta nameOfVersionMethod). |
|
118 versionMethod notNil ifTrue:[ |
|
119 |source| |
|
120 |
|
121 source := versionMethod source. |
|
122 (source isEmptyOrNil or:[(source startsWith:nonMeta nameOfVersionMethod) not]) ifTrue:[ |
|
123 "something bad happend to the classes code" |
|
124 |
|
125 Class fileOutErrorSignal |
|
126 raiseRequestWith:aClass |
|
127 errorString:' - bad source for version method (uncompiled class file?): ', (versionMethod displayString) |
|
128 ]. |
|
129 skippedMethods := Array with:versionMethod. |
|
130 ]. |
|
131 self fileOutCategory:'documentation' of:meta except:skippedMethods only:nil methodFilter:methodFilter on:outStream. |
|
132 outStream cr. |
|
133 ]. |
|
134 |
|
135 "/ |
|
136 "/ initialization next (if any) |
|
137 "/ |
|
138 (collectionOfCategories includes:'initialization') ifTrue:[ |
|
139 self fileOutCategory:'initialization' of:meta methodFilter:methodFilter on:outStream. |
|
140 outStream cr. |
|
141 ]. |
|
142 |
|
143 "/ |
|
144 "/ instance creation next (if any) |
|
145 "/ |
|
146 (collectionOfCategories includes:'instance creation') ifTrue:[ |
|
147 self fileOutCategory:'instance creation' of:meta methodFilter:methodFilter on:outStream. |
|
148 outStream cr. |
|
149 ]. |
|
150 collectionOfCategories do:[:aCategory | |
|
151 ((aCategory ~= 'documentation') |
|
152 and:[(aCategory ~= 'initialization') |
|
153 and:[aCategory ~= 'instance creation']]) ifTrue:[ |
|
154 self fileOutCategory:aCategory of:meta methodFilter:methodFilter on:outStream. |
|
155 outStream cr |
|
156 ] |
|
157 ] |
|
158 ]. |
|
159 |
|
160 "/ if there are any primitive definitions (vw-like ffi-primitives), |
|
161 "/ file them out first in the order: defines, types. |
|
162 "/ Otherwise, we might have trouble when filing in later, because the types are needed |
|
163 "/ for the primitive calls. |
|
164 nonMeta methodDictionary keysAndValuesDo:[:sel :m | |
|
165 m isVisualWorksTypedef ifTrue:[ |
|
166 self fileOutCategory:m category of:nonMeta except:nil only:(Array with:m) methodFilter:methodFilter on:outStream. |
|
167 ]. |
|
168 ]. |
|
169 |
|
170 "/ |
|
171 "/ methods from all categories |
|
172 "/ |
|
173 collectionOfCategories := nonMeta categories asSortedCollection. |
|
174 collectionOfCategories notNil ifTrue:[ |
|
175 collectionOfCategories do:[:aCategory | |
|
176 self fileOutCategory:aCategory of:nonMeta methodFilter:methodFilter on:outStream. |
|
177 outStream cr |
|
178 ] |
|
179 ]. |
|
180 |
|
181 "/ |
|
182 "/ any private classes' methods |
|
183 "/ |
|
184 nonMeta privateClassesSorted do:[:aClass | |
|
185 self fileOutAllMethodsOf:aClass on:outStream methodFilter:methodFilter |
|
186 ]. |
|
187 |
|
188 |
|
189 "/ |
|
190 "/ finally, the previously skipped version method |
|
191 "/ |
|
192 versionMethod notNil ifTrue:[ |
|
193 self fileOutCategory:'documentation' of:meta except:nil only:skippedMethods methodFilter:methodFilter on:outStream. |
|
194 ]. |
|
195 |
|
196 initIt ifTrue:[ |
|
197 "/ |
|
198 "/ optionally an initialize message |
|
199 "/ |
|
200 classesImplementingInitialize := OrderedCollection new. |
|
201 |
|
202 (meta includesSelector:#initialize) ifTrue:[ |
|
203 classesImplementingInitialize add:nonMeta |
|
204 ]. |
|
205 nonMeta privateClassesSorted do:[:aPrivateClass | |
|
206 (aPrivateClass theMetaclass includesSelector:#initialize) ifTrue:[ |
|
207 classesImplementingInitialize add:aPrivateClass |
|
208 ] |
|
209 ]. |
|
210 classesImplementingInitialize size ~~ 0 ifTrue:[ |
|
211 classesImplementingInitialize topologicalSort:[:a :b | b isSubclassOf:a]. |
|
212 outStream cr. |
|
213 classesImplementingInitialize do:[:eachClass | |
|
214 eachClass printClassNameOn:outStream. outStream nextPutAll:' initialize'. |
|
215 outStream nextPutChunkSeparator. |
|
216 outStream cr. |
|
217 ]. |
|
218 ]. |
|
219 ] |
|
220 |
|
221 "Created: / 15-11-1995 / 12:53:06 / cg" |
|
222 "Modified: / 01-04-1997 / 16:01:05 / stefan" |
|
223 "Modified: / 04-10-2006 / 17:28:33 / cg" |
|
224 ! |
|
225 |
|
226 fileOutAllDefinitionsOf:aNonMetaClass on:aStream |
|
227 "append expressions on aStream, which defines myself and all of my private classes." |
|
228 |
|
229 aNonMetaClass fileOutDefinitionOn:aStream. |
|
230 aStream nextPutChunkSeparator. |
|
231 aStream cr; cr. |
|
232 |
|
233 "/ |
|
234 "/ optional classInstanceVariables |
|
235 "/ |
|
236 aNonMetaClass class instanceVariableString isBlank ifFalse:[ |
|
237 aNonMetaClass fileOutClassInstVarDefinitionOn:aStream. |
|
238 aStream nextPutChunkSeparator. |
|
239 aStream cr; cr |
|
240 ]. |
|
241 |
|
242 "/ here, the full nameSpace prefixes are output, |
|
243 "/ to avoid confusing stc |
|
244 "/ (which otherwise could not find the correct superclass) |
|
245 "/ |
|
246 Class fileOutNameSpaceQuerySignal answer:false do:[ |
|
247 Class forceNoNameSpaceQuerySignal answer:true do:[ |
|
248 aNonMetaClass privateClassesSorted do:[:aClass | |
|
249 self fileOutAllDefinitionsOf:aClass on:aStream |
|
250 ] |
|
251 ] |
|
252 ]. |
|
253 |
|
254 "Created: 15.10.1996 / 11:15:19 / cg" |
|
255 "Modified: 22.3.1997 / 16:11:56 / cg" |
|
256 ! |
|
257 |
|
258 fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter |
|
259 |collectionOfCategories| |
|
260 |
|
261 collectionOfCategories := aClass class categories asSortedCollection. |
|
262 collectionOfCategories notNil ifTrue:[ |
|
263 collectionOfCategories do:[:aCategory | |
|
264 self fileOutCategory:aCategory of:aClass class methodFilter:methodFilter on:aStream. |
|
265 aStream cr |
|
266 ] |
|
267 ]. |
|
268 collectionOfCategories := aClass categories asSortedCollection. |
|
269 collectionOfCategories notNil ifTrue:[ |
|
270 collectionOfCategories do:[:aCategory | |
|
271 self fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream. |
|
272 aStream cr |
|
273 ] |
|
274 ]. |
|
275 |
|
276 aClass privateClassesSorted do:[:aClass | |
|
277 self fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter |
|
278 ]. |
|
279 |
|
280 "Created: 15.10.1996 / 11:13:00 / cg" |
|
281 "Modified: 22.3.1997 / 16:12:17 / cg" |
|
282 ! |
|
283 |
|
284 fileOutCategory:aCategory of:aClass except:skippedMethods only:savedMethods methodFilter:methodFilter on:aStream |
|
285 "file out all methods belonging to aCategory, aString onto aStream. |
|
286 If skippedMethods is nonNil, those are not saved. |
|
287 If savedMethods is nonNil, only those are saved. |
|
288 If both are nil, all are saved. See version-method handling in |
|
289 fileOut for what this is needed." |
|
290 |
|
291 |sortedSelectors first prevPrivacy privacy interestingMethods cat| |
|
292 |
|
293 interestingMethods := OrderedCollection new. |
|
294 aClass methodsDo:[:aMethod | |
|
295 |wanted| |
|
296 |
|
297 (methodsAlreadySaved includes:aMethod) ifFalse:[ |
|
298 (aCategory = aMethod category) ifTrue:[ |
|
299 (methodFilter isNil or:[methodFilter value:aMethod]) ifTrue:[ |
|
300 skippedMethods notNil ifTrue:[ |
|
301 wanted := (skippedMethods includesIdentical:aMethod) not |
|
302 ] ifFalse:[ |
|
303 wanted := savedMethods isNil or:[ savedMethods includesIdentical:aMethod ]. |
|
304 ]. |
|
305 wanted ifTrue:[ |
|
306 aMethod selector isSymbol ifTrue:[ |
|
307 interestingMethods add:aMethod |
|
308 ] ifFalse:[ |
|
309 Transcript showCR:'skipping non-symbol method ',aMethod selector. |
|
310 ]. |
|
311 ]. |
|
312 ] |
|
313 ] |
|
314 ] |
|
315 ]. |
|
316 interestingMethods notEmpty ifTrue:[ |
|
317 first := true. |
|
318 prevPrivacy := nil. |
|
319 |
|
320 "/ |
|
321 "/ sort by selector |
|
322 "/ |
|
323 sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m]. |
|
324 sortedSelectors sortWith:interestingMethods. |
|
325 |
|
326 interestingMethods do:[:eachMethod | |
|
327 privacy := eachMethod privacy. |
|
328 |
|
329 first ifFalse:[ |
|
330 privacy ~~ prevPrivacy ifTrue:[ |
|
331 first := true. |
|
332 aStream space. |
|
333 aStream nextPutChunkSeparator. |
|
334 ]. |
|
335 aStream cr; cr |
|
336 ]. |
|
337 |
|
338 first ifTrue:[ |
|
339 aStream nextPutChunkSeparator. |
|
340 aClass printClassNameOn:aStream. |
|
341 privacy ~~ #public ifTrue:[ |
|
342 aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'. |
|
343 ] ifFalse:[ |
|
344 aStream nextPutAll:' methodsFor:'. |
|
345 ]. |
|
346 cat := aCategory. |
|
347 cat isNil ifTrue:[ cat := '' ]. |
|
348 aStream nextPutAll:aCategory asString storeString. |
|
349 aStream nextPutChunkSeparator; cr; cr. |
|
350 first := false. |
|
351 ]. |
|
352 self fileOutMethod:eachMethod on:aStream. |
|
353 methodsAlreadySaved add:eachMethod. |
|
354 |
|
355 prevPrivacy := privacy. |
|
356 ]. |
|
357 aStream space. |
|
358 aStream nextPutChunkSeparator. |
|
359 aStream cr |
|
360 ] |
|
361 |
|
362 "Modified: 28.8.1995 / 14:30:41 / claus" |
|
363 "Modified: 12.6.1996 / 11:37:33 / stefan" |
|
364 "Modified: 15.11.1996 / 11:32:21 / cg" |
|
365 "Created: 1.4.1997 / 16:04:33 / stefan" |
|
366 ! |
|
367 |
|
368 fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream |
|
369 "file out all methods belonging to aCategory, aString onto aStream" |
|
370 |
|
371 self fileOutCategory:aCategory of:aClass except:nil only:nil methodFilter:methodFilter on:aStream |
|
372 |
|
373 "Created: 1.4.1997 / 16:04:44 / stefan" |
|
374 ! |
|
375 |
|
376 fileOutMethod:aMethod on:aStream |
|
377 "file a single method onto aStream." |
|
378 |
|
379 |source| |
|
380 |
|
381 source := aMethod source. |
|
382 source isNil ifTrue:[ |
|
383 Class fileOutErrorSignal |
|
384 raiseRequestWith:aMethod mclass |
|
385 errorString:' - no source for method: ', (aMethod displayString) |
|
386 ] ifFalse:[ |
|
387 aStream nextChunkPut:source. |
|
388 ]. |
|
389 ! |
|
390 |
|
391 generateHeaderWithCopyrightOn:outStream |
|
392 |copyrightMethod copyrightText| |
|
393 |
|
394 "if there is a copyright method, add a copyright comment |
|
395 at the beginning, taking the string from the copyright method. |
|
396 We cannot do this unconditionally - that would lead to my copyrights |
|
397 being put on your code ;-). |
|
398 On the other hand: I want every file created by myself to have the |
|
399 copyright string at the beginning be preserved .... even if the |
|
400 code was edited in the browser and filedOut." |
|
401 |
|
402 (copyrightMethod := classBeingSaved theMetaclass compiledMethodAt:#copyright) notNil ifTrue:[ |
76 " |
403 " |
77 get the copyright method's comment-text, strip off empty and blank lines |
404 get the copyright method's comment-text, strip off empty and blank lines |
78 and insert at beginning. |
405 and insert at beginning. |
79 " |
406 " |
80 copyrightText := copyrightMethod comment. |
407 copyrightText := copyrightMethod comment. |
88 copyrightText := copyrightText asString. |
415 copyrightText := copyrightText asString. |
89 outStream nextPutAllAsChunk:copyrightText. |
416 outStream nextPutAllAsChunk:copyrightText. |
90 ]. |
417 ]. |
91 ]. |
418 ]. |
92 ]. |
419 ]. |
93 |
|
94 stampIt ifTrue:[ |
|
95 "/ |
|
96 "/ first, a timestamp |
|
97 "/ |
|
98 outStream nextPutAll:(Smalltalk timeStamp). |
|
99 outStream nextPutChunkSeparator. |
|
100 outStream cr; cr. |
|
101 ]. |
|
102 |
|
103 withDefinition ifTrue:[ |
|
104 "/ |
|
105 "/ then the definition(s) |
|
106 "/ |
|
107 self fileOutAllDefinitionsOf:nonMeta on:outStream. |
|
108 "/ |
|
109 "/ a comment - if any |
|
110 "/ |
|
111 (comment := nonMeta comment) notNil ifTrue:[ |
|
112 nonMeta fileOutCommentOn:outStream. |
|
113 outStream cr. |
|
114 ]. |
|
115 "/ |
|
116 "/ primitive definitions - if any |
|
117 "/ |
|
118 nonMeta fileOutPrimitiveSpecsOn:outStream. |
|
119 ]. |
|
120 |
|
121 "/ |
|
122 "/ methods from all categories in metaclass (i.e. class methods) |
|
123 "/ EXCEPT: the version method is placed at the very end, to |
|
124 "/ avoid sourcePosition-shifts when checked out later. |
|
125 "/ (RCS expands this string, so its size is not constant) |
|
126 "/ |
|
127 collectionOfCategories := meta categories asSortedCollection. |
|
128 collectionOfCategories notNil ifTrue:[ |
|
129 "/ |
|
130 "/ documentation first (if any), but not the version method |
|
131 "/ |
|
132 (collectionOfCategories includes:'documentation') ifTrue:[ |
|
133 versionMethod := meta compiledMethodAt:(nonMeta nameOfVersionMethod). |
|
134 versionMethod notNil ifTrue:[ |
|
135 |source| |
|
136 |
|
137 source := versionMethod source. |
|
138 (source isEmptyOrNil or:[(source startsWith:nonMeta nameOfVersionMethod) not]) ifTrue:[ |
|
139 "something bad happend to the classes code" |
|
140 |
|
141 Class fileOutErrorSignal |
|
142 raiseRequestWith:aClass |
|
143 errorString:' - bad source for version method (uncompiled class file?): ', (versionMethod displayString) |
|
144 ]. |
|
145 skippedMethods := Array with:versionMethod. |
|
146 ]. |
|
147 self fileOutCategory:'documentation' of:meta except:skippedMethods only:nil methodFilter:methodFilter on:outStream. |
|
148 outStream cr. |
|
149 ]. |
|
150 |
|
151 "/ |
|
152 "/ initialization next (if any) |
|
153 "/ |
|
154 (collectionOfCategories includes:'initialization') ifTrue:[ |
|
155 self fileOutCategory:'initialization' of:meta methodFilter:methodFilter on:outStream. |
|
156 outStream cr. |
|
157 ]. |
|
158 |
|
159 "/ |
|
160 "/ instance creation next (if any) |
|
161 "/ |
|
162 (collectionOfCategories includes:'instance creation') ifTrue:[ |
|
163 self fileOutCategory:'instance creation' of:meta methodFilter:methodFilter on:outStream. |
|
164 outStream cr. |
|
165 ]. |
|
166 collectionOfCategories do:[:aCategory | |
|
167 ((aCategory ~= 'documentation') |
|
168 and:[(aCategory ~= 'initialization') |
|
169 and:[aCategory ~= 'instance creation']]) ifTrue:[ |
|
170 self fileOutCategory:aCategory of:meta methodFilter:methodFilter on:outStream. |
|
171 outStream cr |
|
172 ] |
|
173 ] |
|
174 ]. |
|
175 |
|
176 "/ |
|
177 "/ methods from all categories |
|
178 "/ |
|
179 collectionOfCategories := nonMeta categories asSortedCollection. |
|
180 collectionOfCategories notNil ifTrue:[ |
|
181 collectionOfCategories do:[:aCategory | |
|
182 self fileOutCategory:aCategory of:nonMeta methodFilter:methodFilter on:outStream. |
|
183 outStream cr |
|
184 ] |
|
185 ]. |
|
186 |
|
187 "/ |
|
188 "/ any private classes' methods |
|
189 "/ |
|
190 nonMeta privateClassesSorted do:[:aClass | |
|
191 self fileOutAllMethodsOf:aClass on:outStream methodFilter:methodFilter |
|
192 ]. |
|
193 |
|
194 |
|
195 "/ |
|
196 "/ finally, the previously skipped version method |
|
197 "/ |
|
198 versionMethod notNil ifTrue:[ |
|
199 self fileOutCategory:'documentation' of:meta except:nil only:skippedMethods methodFilter:methodFilter on:outStream. |
|
200 ]. |
|
201 |
|
202 initIt ifTrue:[ |
|
203 "/ |
|
204 "/ optionally an initialize message |
|
205 "/ |
|
206 classesImplementingInitialize := OrderedCollection new. |
|
207 |
|
208 (meta includesSelector:#initialize) ifTrue:[ |
|
209 classesImplementingInitialize add:nonMeta |
|
210 ]. |
|
211 nonMeta privateClassesSorted do:[:aPrivateClass | |
|
212 (aPrivateClass theMetaclass includesSelector:#initialize) ifTrue:[ |
|
213 classesImplementingInitialize add:aPrivateClass |
|
214 ] |
|
215 ]. |
|
216 classesImplementingInitialize size ~~ 0 ifTrue:[ |
|
217 classesImplementingInitialize topologicalSort:[:a :b | b isSubclassOf:a]. |
|
218 outStream cr. |
|
219 classesImplementingInitialize do:[:eachClass | |
|
220 eachClass printClassNameOn:outStream. outStream nextPutAll:' initialize'. |
|
221 outStream nextPutChunkSeparator. |
|
222 outStream cr. |
|
223 ]. |
|
224 ]. |
|
225 ] |
|
226 |
|
227 "Created: / 15-11-1995 / 12:53:06 / cg" |
|
228 "Modified: / 01-04-1997 / 16:01:05 / stefan" |
|
229 "Modified: / 04-10-2006 / 17:28:33 / cg" |
|
230 ! |
|
231 |
|
232 fileOutAllDefinitionsOf:aNonMetaClass on:aStream |
|
233 "append expressions on aStream, which defines myself and all of my private classes." |
|
234 |
|
235 aNonMetaClass fileOutDefinitionOn:aStream. |
|
236 aStream nextPutChunkSeparator. |
|
237 aStream cr; cr. |
|
238 |
|
239 "/ |
|
240 "/ optional classInstanceVariables |
|
241 "/ |
|
242 aNonMetaClass class instanceVariableString isBlank ifFalse:[ |
|
243 aNonMetaClass fileOutClassInstVarDefinitionOn:aStream. |
|
244 aStream nextPutChunkSeparator. |
|
245 aStream cr; cr |
|
246 ]. |
|
247 |
|
248 "/ here, the full nameSpace prefixes are output, |
|
249 "/ to avoid confusing stc |
|
250 "/ (which otherwise could not find the correct superclass) |
|
251 "/ |
|
252 Class fileOutNameSpaceQuerySignal answer:false do:[ |
|
253 Class forceNoNameSpaceQuerySignal answer:true do:[ |
|
254 aNonMetaClass privateClassesSorted do:[:aClass | |
|
255 self fileOutAllDefinitionsOf:aClass on:aStream |
|
256 ] |
|
257 ] |
|
258 ]. |
|
259 |
|
260 "Created: 15.10.1996 / 11:15:19 / cg" |
|
261 "Modified: 22.3.1997 / 16:11:56 / cg" |
|
262 ! |
|
263 |
|
264 fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter |
|
265 |collectionOfCategories| |
|
266 |
|
267 collectionOfCategories := aClass class categories asSortedCollection. |
|
268 collectionOfCategories notNil ifTrue:[ |
|
269 collectionOfCategories do:[:aCategory | |
|
270 self fileOutCategory:aCategory of:aClass class methodFilter:methodFilter on:aStream. |
|
271 aStream cr |
|
272 ] |
|
273 ]. |
|
274 collectionOfCategories := aClass categories asSortedCollection. |
|
275 collectionOfCategories notNil ifTrue:[ |
|
276 collectionOfCategories do:[:aCategory | |
|
277 self fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream. |
|
278 aStream cr |
|
279 ] |
|
280 ]. |
|
281 |
|
282 aClass privateClassesSorted do:[:aClass | |
|
283 self fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter |
|
284 ]. |
|
285 |
|
286 "Created: 15.10.1996 / 11:13:00 / cg" |
|
287 "Modified: 22.3.1997 / 16:12:17 / cg" |
|
288 ! |
|
289 |
|
290 fileOutCategory:aCategory of:aClass except:skippedMethods only:savedMethods methodFilter:methodFilter on:aStream |
|
291 "file out all methods belonging to aCategory, aString onto aStream. |
|
292 If skippedMethods is nonNil, those are not saved. |
|
293 If savedMethods is nonNil, only those are saved. |
|
294 If both are nil, all are saved. See version-method handling in |
|
295 fileOut for what this is needed." |
|
296 |
|
297 |source sortedSelectors first privacy interestingMethods cat| |
|
298 |
|
299 interestingMethods := OrderedCollection new. |
|
300 aClass methodsDo:[:aMethod | |
|
301 |wanted| |
|
302 |
|
303 (methodFilter isNil |
|
304 or:[methodFilter value:aMethod]) ifTrue:[ |
|
305 (aCategory = aMethod category) ifTrue:[ |
|
306 skippedMethods notNil ifTrue:[ |
|
307 wanted := (skippedMethods includesIdentical:aMethod) not |
|
308 ] ifFalse:[ |
|
309 savedMethods notNil ifTrue:[ |
|
310 wanted := (savedMethods includesIdentical:aMethod). |
|
311 ] ifFalse:[ |
|
312 wanted := true |
|
313 ] |
|
314 ]. |
|
315 wanted ifTrue:[ |
|
316 aMethod selector isSymbol ifTrue:[ |
|
317 interestingMethods add:aMethod |
|
318 ] ifFalse:[ |
|
319 Transcript showCR:'skipping non-symbol method ',aMethod selector. |
|
320 ]. |
|
321 ]. |
|
322 ] |
|
323 ] |
|
324 ]. |
|
325 interestingMethods notEmpty ifTrue:[ |
|
326 first := true. |
|
327 privacy := nil. |
|
328 |
|
329 "/ |
|
330 "/ sort by selector |
|
331 "/ |
|
332 sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m]. |
|
333 sortedSelectors sortWith:interestingMethods. |
|
334 |
|
335 interestingMethods do:[:aMethod | |
|
336 first ifFalse:[ |
|
337 privacy ~~ aMethod privacy ifTrue:[ |
|
338 first := true. |
|
339 aStream space. |
|
340 aStream nextPutChunkSeparator. |
|
341 ]. |
|
342 aStream cr; cr |
|
343 ]. |
|
344 |
|
345 privacy := aMethod privacy. |
|
346 |
|
347 first ifTrue:[ |
|
348 aStream nextPutChunkSeparator. |
|
349 aClass printClassNameOn:aStream. |
|
350 privacy ~~ #public ifTrue:[ |
|
351 aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'. |
|
352 ] ifFalse:[ |
|
353 aStream nextPutAll:' methodsFor:'. |
|
354 ]. |
|
355 cat := aCategory. |
|
356 cat isNil ifTrue:[ cat := '' ]. |
|
357 aStream nextPutAll:aCategory asString storeString. |
|
358 aStream nextPutChunkSeparator; cr; cr. |
|
359 first := false. |
|
360 ]. |
|
361 source := aMethod source. |
|
362 source isNil ifTrue:[ |
|
363 Class fileOutErrorSignal |
|
364 raiseRequestWith:aClass |
|
365 errorString:' - no source for method: ', (aMethod displayString) |
|
366 ] ifFalse:[ |
|
367 aStream nextChunkPut:source. |
|
368 ]. |
|
369 ]. |
|
370 aStream space. |
|
371 aStream nextPutChunkSeparator. |
|
372 aStream cr |
|
373 ] |
|
374 |
|
375 "Modified: 28.8.1995 / 14:30:41 / claus" |
|
376 "Modified: 12.6.1996 / 11:37:33 / stefan" |
|
377 "Modified: 15.11.1996 / 11:32:21 / cg" |
|
378 "Created: 1.4.1997 / 16:04:33 / stefan" |
|
379 ! |
|
380 |
|
381 fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream |
|
382 "file out all methods belonging to aCategory, aString onto aStream" |
|
383 |
|
384 self fileOutCategory:aCategory of:aClass except:nil only:nil methodFilter:methodFilter on:aStream |
|
385 |
|
386 "Created: 1.4.1997 / 16:04:44 / stefan" |
|
387 ! ! |
420 ! ! |
388 |
421 |
389 !SmalltalkChunkFileSourceWriter class methodsFor:'documentation'! |
422 !SmalltalkChunkFileSourceWriter class methodsFor:'documentation'! |
390 |
423 |
391 version |
424 version |
392 ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.7 2009-05-14 12:29:31 cg Exp $' |
425 ^ '$Header: /cvs/stx/stx/libbasic/SmalltalkChunkFileSourceWriter.st,v 1.8 2009-08-13 15:54:45 cg Exp $' |
393 ! ! |
426 ! ! |