|
1 " |
|
2 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 Stream subclass:#PositionableStream |
|
14 instanceVariableNames:'collection position readLimit continueBlock abortBlock' |
|
15 classVariableNames:'' |
|
16 poolDictionaries:'' |
|
17 category:'Streams' |
|
18 ! |
|
19 |
|
20 PositionableStream comment:' |
|
21 |
|
22 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
23 All Rights Reserved |
|
24 |
|
25 Instances of myself allow positioning the read pointer. |
|
26 I also add methods for source-chunk reading and writing |
|
27 and for filing-in/out of source code. |
|
28 |
|
29 %W% %E% |
|
30 |
|
31 TODO |
|
32 change to use signals for error handling during fileIn |
|
33 (get rid of continue/abort blocks) |
|
34 '! |
|
35 |
|
36 !PositionableStream class methodsFor:'constants'! |
|
37 |
|
38 chunkSeparator |
|
39 "return the chunk-separation character" |
|
40 |
|
41 ^ $!! |
|
42 ! ! |
|
43 |
|
44 !PositionableStream class methodsFor:'instance creation'! |
|
45 |
|
46 on:aCollection |
|
47 "return a new PositionableStream streaming on aCollection" |
|
48 |
|
49 ^ (self basicNew) on:aCollection |
|
50 ! |
|
51 |
|
52 on:aCollection from:first to:last |
|
53 "return a new PositionableStream streaming on aCollection |
|
54 from first to last" |
|
55 |
|
56 |newStream| |
|
57 |
|
58 newStream := (self basicNew) on:aCollection. |
|
59 newStream position:first. |
|
60 newStream readLimit:last. |
|
61 ^ newStream |
|
62 ! ! |
|
63 |
|
64 !PositionableStream methodsFor:'private'! |
|
65 |
|
66 on:aCollection |
|
67 "setup for streaming on aCollection" |
|
68 |
|
69 collection := aCollection. |
|
70 readLimit := aCollection size. |
|
71 position := 1 |
|
72 ! |
|
73 |
|
74 positionError |
|
75 "report an error when positioning past the end" |
|
76 |
|
77 ^ self error:'cannot position past end of collection' |
|
78 ! ! |
|
79 |
|
80 !PositionableStream methodsFor:'accessing'! |
|
81 |
|
82 contents |
|
83 "return the entire contents of the stream" |
|
84 |
|
85 ^ collection |
|
86 ! |
|
87 |
|
88 peek |
|
89 "look ahead for and return the next element" |
|
90 |
|
91 |peekObject| |
|
92 |
|
93 peekObject := self next. |
|
94 self position:(self position - 1). |
|
95 ^ peekObject |
|
96 ! |
|
97 |
|
98 peekFor:something |
|
99 "return true and move past if next == something" |
|
100 |
|
101 self next == something ifTrue:[ |
|
102 ^ true |
|
103 ]. |
|
104 self position:(self position - 1). |
|
105 ^ false |
|
106 ! |
|
107 |
|
108 readLimit:aNumber |
|
109 "set the read-limit" |
|
110 |
|
111 readLimit := aNumber |
|
112 ! |
|
113 |
|
114 upTo:element |
|
115 "return a collection of the elements up-to |
|
116 (but excluding) the argument, element. |
|
117 Return nil if the stream-end is reached before." |
|
118 |
|
119 |newColl e| |
|
120 |
|
121 newColl := collection species new. |
|
122 e := self next. |
|
123 [e = element] whileFalse:[ |
|
124 newColl := newColl copyWith:e. |
|
125 e := self next. |
|
126 self atEnd ifTrue:[^ nil] |
|
127 ]. |
|
128 ^ newColl |
|
129 |
|
130 "(ReadStream on:'1234567890') upTo:$5" |
|
131 "(ReadStream on:'123456') upTo:$7" |
|
132 ! ! |
|
133 |
|
134 !PositionableStream methodsFor:'testing'! |
|
135 |
|
136 atEnd |
|
137 "return true, if the read-position is at the end" |
|
138 |
|
139 ^ position > readLimit |
|
140 ! |
|
141 |
|
142 isEmpty |
|
143 "return true, if the contents of the stream is empty" |
|
144 |
|
145 ^ readLimit == 0 |
|
146 ! ! |
|
147 |
|
148 !PositionableStream methodsFor:'positioning'! |
|
149 |
|
150 position |
|
151 "return the read position" |
|
152 |
|
153 ^ position |
|
154 ! |
|
155 |
|
156 position:index |
|
157 "set the read position" |
|
158 |
|
159 (index > (readLimit + 1)) ifTrue: [^ self positionError]. |
|
160 position := index |
|
161 ! |
|
162 |
|
163 reset |
|
164 "set the read position to the beginning of the collection" |
|
165 |
|
166 position := 1 |
|
167 ! |
|
168 |
|
169 setToEnd |
|
170 "set the read position to the end of the collection" |
|
171 |
|
172 position := readLimit |
|
173 ! |
|
174 |
|
175 skip:numberToSkip |
|
176 "skip the next numberToSkip elements" |
|
177 |
|
178 self position:(position + numberToSkip) |
|
179 ! ! |
|
180 |
|
181 !PositionableStream methodsFor:'fileIn-Out'! |
|
182 |
|
183 skipSeparators |
|
184 "skip all whitespace; so that next will return next non-white-space |
|
185 element" |
|
186 |
|
187 |nextOne| |
|
188 |
|
189 nextOne := self peek. |
|
190 [(nextOne notNil) and:[nextOne isSeparator]] whileTrue:[ |
|
191 self next. |
|
192 nextOne := self peek |
|
193 ]. |
|
194 ^ nextOne |
|
195 ! |
|
196 |
|
197 skipSeparatorsExceptCR |
|
198 "skip all whitespace except newlines; |
|
199 next will return next non-white-space element" |
|
200 |
|
201 |nextOne| |
|
202 |
|
203 nextOne := self peek. |
|
204 [(nextOne notNil) and:[nextOne isSeparator]] whileTrue:[ |
|
205 nextOne isEndOfLineCharacter ifTrue:[^ nextOne]. |
|
206 self next. |
|
207 nextOne := self peek |
|
208 ]. |
|
209 ^ nextOne |
|
210 ! |
|
211 |
|
212 skipFor:anObject |
|
213 "skip all objects up-to and including anObject; return the element |
|
214 after" |
|
215 |
|
216 |nextOne| |
|
217 |
|
218 nextOne := self next. |
|
219 [nextOne ~~ anObject] whileTrue:[ |
|
220 self atEnd ifTrue:[^ nil]. |
|
221 self next. |
|
222 nextOne := self peek |
|
223 ]. |
|
224 ^ self next |
|
225 ! |
|
226 |
|
227 nextChunk |
|
228 "return the next chunk, i.e. all characters up to the next |
|
229 non-doubled exclamation mark; undouble doubled exclamation marks" |
|
230 |
|
231 |theString sep newString done thisChar nextChar inPrimitive |
|
232 index "{ Class:SmallInteger }" |
|
233 currSize "{ Class:SmallInteger }" | |
|
234 |
|
235 sep := self class chunkSeparator. |
|
236 theString := String new:500. |
|
237 currSize := 500. |
|
238 thisChar := self skipSeparators. |
|
239 thisChar := self next. |
|
240 index := 0. |
|
241 done := false. |
|
242 inPrimitive := false. |
|
243 |
|
244 [done] whileFalse:[ |
|
245 ((index + 2) <= currSize) ifFalse:[ |
|
246 newString := String new:(currSize * 2). |
|
247 newString replaceFrom:1 to:currSize with:theString. |
|
248 currSize := currSize * 2. |
|
249 theString := newString |
|
250 ]. |
|
251 thisChar isNil ifTrue:[ |
|
252 done := true |
|
253 ] ifFalse:[ |
|
254 (thisChar == $% ) ifTrue:[ |
|
255 nextChar := self peek. |
|
256 (nextChar == ${ ) ifTrue:[ |
|
257 inPrimitive := true. |
|
258 index := index + 1. |
|
259 theString at:index put:thisChar. |
|
260 thisChar := self next |
|
261 ] ifFalse:[ |
|
262 (nextChar == $} ) ifTrue:[ |
|
263 inPrimitive := false. |
|
264 index := index + 1. |
|
265 theString at:index put:thisChar. |
|
266 thisChar := self next |
|
267 ] |
|
268 ] |
|
269 ] ifFalse:[ |
|
270 inPrimitive ifFalse:[ |
|
271 (thisChar == sep) ifTrue:[ |
|
272 (self peek == sep) ifFalse:[ |
|
273 done := true |
|
274 ] ifTrue:[ |
|
275 self next |
|
276 ] |
|
277 ] |
|
278 ] |
|
279 ] |
|
280 ]. |
|
281 done ifFalse:[ |
|
282 index := index + 1. |
|
283 theString at:index put:thisChar. |
|
284 thisChar := self next |
|
285 ] |
|
286 ]. |
|
287 (index == 0) ifTrue:[^ '']. |
|
288 ^ theString copyFrom:1 to:index |
|
289 ! |
|
290 |
|
291 nextChunkPut:aString |
|
292 "put aString as a chunk onto the receiver; |
|
293 double all exclamation marks and append an exclamation mark" |
|
294 |
|
295 |sep gotPercent inPrimitive character |
|
296 index "{ Class:SmallInteger }" |
|
297 endIndex "{ Class:SmallInteger }" |
|
298 next "{ Class:SmallInteger }" | |
|
299 |
|
300 sep := self class chunkSeparator. |
|
301 inPrimitive := false. |
|
302 gotPercent := false. |
|
303 index := 1. |
|
304 endIndex := aString size. |
|
305 |
|
306 [index <= endIndex] whileTrue:[ |
|
307 next := aString indexOf:$% startingAt:index ifAbsent:[endIndex + 1]. |
|
308 next := next min: |
|
309 (aString indexOf:${ startingAt:index ifAbsent:[endIndex + 1]). |
|
310 next := next min: |
|
311 (aString indexOf:$} startingAt:index ifAbsent:[endIndex + 1]). |
|
312 next := next min: |
|
313 (aString indexOf:sep startingAt:index ifAbsent:[endIndex + 1]). |
|
314 |
|
315 ((index == 1) and:[next == (endIndex + 1)]) ifTrue:[ |
|
316 self nextPutAll:aString |
|
317 ] ifFalse:[ |
|
318 self nextPutAll:(aString copyFrom:index to:(next - 1)) |
|
319 ]. |
|
320 |
|
321 index := next. |
|
322 (index <= endIndex) ifTrue:[ |
|
323 character := aString at:index. |
|
324 (character == $% ) ifTrue:[ |
|
325 gotPercent := true |
|
326 ] ifFalse:[ |
|
327 (character == ${ ) ifTrue:[ |
|
328 gotPercent ifTrue:[ |
|
329 inPrimitive := true |
|
330 ] |
|
331 ] ifFalse:[ |
|
332 (character == $} ) ifTrue:[ |
|
333 gotPercent ifTrue:[ |
|
334 inPrimitive := false |
|
335 ] |
|
336 ] ifFalse:[ |
|
337 inPrimitive ifFalse:[ |
|
338 (character == sep) ifTrue:[ |
|
339 self nextPut:sep |
|
340 ] |
|
341 ] |
|
342 ] |
|
343 ]. |
|
344 gotPercent := false |
|
345 ]. |
|
346 self nextPut:character. |
|
347 index := index + 1 |
|
348 ] |
|
349 ]. |
|
350 self nextPut:sep |
|
351 ! |
|
352 |
|
353 fileInNextChunkNotifying:someone |
|
354 "read next chunk, evaluate it and return the result; |
|
355 someone is notified of errors" |
|
356 |
|
357 |aString sawExcla sep| |
|
358 |
|
359 sep := self class chunkSeparator. |
|
360 self skipSeparators. |
|
361 self atEnd ifFalse:[ |
|
362 sawExcla := self peekFor:sep. |
|
363 aString := self nextChunk. |
|
364 aString size ~~ 0 ifTrue:[ |
|
365 sawExcla ifFalse:[ |
|
366 ^ Compiler evaluate:aString notifying:someone |
|
367 ]. |
|
368 ^ (Compiler evaluate:aString notifying:someone) |
|
369 fileInFrom:self notifying:someone |
|
370 ] |
|
371 ]. |
|
372 ^ nil |
|
373 ! |
|
374 |
|
375 fileInNextChunk |
|
376 "read next chunk, evaluate it and return the result" |
|
377 |
|
378 ^ self fileInNextChunkNotifying:nil |
|
379 ! |
|
380 |
|
381 fileInNotifying:someone |
|
382 "file in from the receiver, i.e. read chunks and evaluate them - |
|
383 return the value of the last chunk; someone is notified of errors" |
|
384 |
|
385 |lastValue| |
|
386 |
|
387 self position:1. |
|
388 abortBlock := [^ nil]. |
|
389 continueBlock := []. |
|
390 Smalltalk at:#ErrorHandler put:self. |
|
391 [self atEnd] whileFalse:[ |
|
392 lastValue := self fileInNextChunkNotifying:someone |
|
393 ]. |
|
394 Smalltalk at:#ErrorHandler put:nil. |
|
395 ^ lastValue |
|
396 ! |
|
397 |
|
398 fileIn |
|
399 "file in from the receiver, i.e. read chunks and evaluate them - |
|
400 return the value of the last chunk" |
|
401 |
|
402 ^ self fileInNotifying:self |
|
403 ! |
|
404 |
|
405 askForDebug:message |
|
406 |box| |
|
407 |
|
408 box := OptionBox title:message numberOfOptions:3. |
|
409 box actions:(Array with:[^ #abort] |
|
410 with:[^ #debug] |
|
411 with:[^ #continue]). |
|
412 box buttonTitles:#('abort' 'debug' 'continue'). |
|
413 box showAtPointer. |
|
414 ^ #abort |
|
415 ! |
|
416 |
|
417 catch:aSymbol with:aMessage for:anObject |
|
418 "this one is sent when an error occurs while filing in - |
|
419 we dont want a debugger to come up but simply notify |
|
420 the error (also on the Transcript so you have a trace of it)" |
|
421 |
|
422 |message action| |
|
423 |
|
424 Smalltalk at:#ErrorHandler put:nil. |
|
425 (aSymbol == #doesNotUnderstand:) ifTrue:[ |
|
426 anObject isNil ifTrue:[ |
|
427 "try to give a bit more detail on what went wrong" |
|
428 (Metaclass respondsTo:(aMessage selector)) ifTrue:[ |
|
429 ('subclass:*' match:(aMessage selector)) ifTrue:[ |
|
430 message := 'no superclass for ' , (aMessage arguments at:1) |
|
431 ] ifFalse:[ |
|
432 message := 'definitions for nonexisting class' |
|
433 ] |
|
434 ] ifFalse:[ |
|
435 message := 'bad message: ' , aMessage selector, ' to UndefinedObject' |
|
436 ] |
|
437 ] ifFalse:[ |
|
438 message := 'bad message: ' , aMessage selector , |
|
439 ' to ' , anObject classNameWithArticle |
|
440 ] |
|
441 ] ifFalse:[ |
|
442 (aSymbol == #error:) ifTrue:[ |
|
443 message := aMessage |
|
444 ] ifFalse:[ |
|
445 message := 'during fileIn' |
|
446 ] |
|
447 ]. |
|
448 message := 'Error: ' , message. |
|
449 Transcript showCr:message. |
|
450 |
|
451 YesNoBox notNil ifTrue:[ |
|
452 action := self askForDebug:message. |
|
453 action == #debug ifTrue:[ |
|
454 Debugger enterWithMessage:message |
|
455 ]. |
|
456 action == #continue ifTrue:[ |
|
457 continueBlock value |
|
458 ]. |
|
459 ] ifFalse:[ |
|
460 self notify:message |
|
461 ]. |
|
462 |
|
463 abortBlock value. |
|
464 ^ nil |
|
465 ! |
|
466 |
|
467 error:aMessage position:position to:endPos |
|
468 "error notification during fileIn with no requestor" |
|
469 |
|
470 position printOn:Transcript. |
|
471 Transcript show:' '. |
|
472 Transcript showCr:aMessage. |
|
473 ^ false |
|
474 ! |
|
475 |
|
476 correctableError:aMessage position:position to:endPos |
|
477 "error notification during fileIn with no requestor" |
|
478 |
|
479 ^ self error:aMessage position:position to:endPos |
|
480 ! |
|
481 |
|
482 warning:aMessage position:position to:endPos |
|
483 "warning notification during fileIn with no requestor - ignore it" |
|
484 |
|
485 ^ self |
|
486 ! ! |