author | Claus Gittinger <cg@exept.de> |
Thu, 07 Mar 1996 19:32:41 +0100 | |
changeset 1086 | 7b0641a2e1ef |
parent 975 | 716245c81bc0 |
child 1295 | 83f594f05c52 |
permissions | -rw-r--r-- |
1 | 1 |
" |
5 | 2 |
COPYRIGHT (c) 1989 by Claus Gittinger |
159 | 3 |
All Rights Reserved |
1 | 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 |
||
57 | 13 |
PeekableStream subclass:#PositionableStream |
973 | 14 |
instanceVariableNames:'collection position readLimit writeLimit' |
15 |
classVariableNames:'ErrorDuringFileInSignal ChunkSeparator' |
|
16 |
poolDictionaries:'' |
|
17 |
category:'Streams' |
|
1 | 18 |
! |
19 |
||
88 | 20 |
!PositionableStream class methodsFor:'documentation'! |
21 |
||
22 |
copyright |
|
23 |
" |
|
24 |
COPYRIGHT (c) 1989 by Claus Gittinger |
|
159 | 25 |
All Rights Reserved |
1 | 26 |
|
88 | 27 |
This software is furnished under a license and may be used |
28 |
only in accordance with the terms of that license and with the |
|
29 |
inclusion of the above copyright notice. This software may not |
|
30 |
be provided or otherwise made available to, or used by, any |
|
31 |
other person. No title to or ownership of the software is |
|
32 |
hereby transferred. |
|
33 |
" |
|
34 |
! |
|
10 | 35 |
|
88 | 36 |
documentation |
37 |
" |
|
38 |
Instances of PositionableStream allow positioning the read pointer. |
|
39 |
The PositionableStream class also adds methods for source-chunk reading |
|
40 |
and writing, and for filing-in/out of source code. |
|
41 |
This is an abstract class. |
|
42 |
" |
|
43 |
! ! |
|
1 | 44 |
|
10 | 45 |
!PositionableStream class methodsFor:'initialization'! |
1 | 46 |
|
10 | 47 |
initialize |
44 | 48 |
"setup the signal used to handle errors during fileIn" |
49 |
||
10 | 50 |
ErrorDuringFileInSignal isNil ifTrue:[ |
302 | 51 |
ErrorDuringFileInSignal := ErrorSignal newSignalMayProceed:true. |
159 | 52 |
ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal. |
53 |
ErrorDuringFileInSignal notifierString:'error during fileIn'. |
|
276 | 54 |
|
55 |
ChunkSeparator := $!! |
|
10 | 56 |
] |
57 |
! ! |
|
1 | 58 |
|
59 |
!PositionableStream class methodsFor:'instance creation'! |
|
60 |
||
61 |
on:aCollection |
|
62 |
"return a new PositionableStream streaming on aCollection" |
|
63 |
||
64 |
^ (self basicNew) on:aCollection |
|
65 |
! |
|
66 |
||
67 |
on:aCollection from:first to:last |
|
68 |
"return a new PositionableStream streaming on aCollection |
|
69 |
from first to last" |
|
70 |
||
369 | 71 |
^ (self basicNew) on:aCollection from:first to:last |
57 | 72 |
! |
73 |
||
74 |
with:aCollection |
|
75 |
"return a new PositionableStream streaming on aCollection, |
|
76 |
the stream is positioned to the end of the collection." |
|
77 |
||
362 | 78 |
^ (self basicNew) with:aCollection |
1 | 79 |
! ! |
80 |
||
611 | 81 |
!PositionableStream class methodsFor:'constants'! |
1 | 82 |
|
611 | 83 |
chunkSeparator |
84 |
"return the chunk-separation character" |
|
57 | 85 |
|
611 | 86 |
^ ChunkSeparator |
360 | 87 |
! ! |
88 |
||
1 | 89 |
!PositionableStream methodsFor:'accessing'! |
90 |
||
91 |
contents |
|
92 |
"return the entire contents of the stream" |
|
93 |
||
94 |
^ collection |
|
95 |
! |
|
96 |
||
97 |
peek |
|
98 |
"look ahead for and return the next element" |
|
99 |
||
100 |
|peekObject| |
|
101 |
||
102 |
peekObject := self next. |
|
10 | 103 |
self backStep. |
1 | 104 |
^ peekObject |
105 |
! |
|
106 |
||
107 |
peekFor:something |
|
10 | 108 |
"return true and move past if next == something; |
109 |
otherwise stay and let position unchanged" |
|
1 | 110 |
|
111 |
self next == something ifTrue:[ |
|
159 | 112 |
^ true |
1 | 113 |
]. |
10 | 114 |
self backStep. |
1 | 115 |
^ false |
116 |
! |
|
117 |
||
118 |
readLimit:aNumber |
|
369 | 119 |
"set the read-limit; thats the position at which EOF is returned" |
1 | 120 |
|
121 |
readLimit := aNumber |
|
369 | 122 |
! |
123 |
||
124 |
writeLimit:aNumber |
|
125 |
"set the writeLimit; thats the position after which writing is prohibited" |
|
126 |
||
127 |
writeLimit := aNumber |
|
1 | 128 |
! ! |
129 |
||
44 | 130 |
!PositionableStream methodsFor:'chunk input/output'! |
1 | 131 |
|
132 |
nextChunk |
|
133 |
"return the next chunk, i.e. all characters up to the next |
|
217 | 134 |
exclamation mark. Within the chunk, exclamation marks have to be doubled, |
135 |
they are undoubled here. |
|
136 |
Except for primitive code, in which doubling is not needed (allowed). |
|
137 |
This exception was added to make it easier to edit primitive code with |
|
138 |
external editors. However, this means, that other Smalltalks cannot always |
|
139 |
read chunks containing primitive code |
|
140 |
- but that doesnt really matter, since C-primitives are an ST/X feature anyway." |
|
1 | 141 |
|
142 |
|theString sep newString done thisChar nextChar inPrimitive |
|
143 |
index "{ Class:SmallInteger }" |
|
144 |
currSize "{ Class:SmallInteger }" | |
|
145 |
||
276 | 146 |
sep := ChunkSeparator. |
1 | 147 |
theString := String new:500. |
148 |
currSize := 500. |
|
149 |
thisChar := self skipSeparators. |
|
150 |
thisChar := self next. |
|
151 |
index := 0. |
|
152 |
done := false. |
|
153 |
inPrimitive := false. |
|
154 |
||
155 |
[done] whileFalse:[ |
|
159 | 156 |
((index + 2) <= currSize) ifFalse:[ |
157 |
newString := String new:(currSize * 2). |
|
158 |
newString replaceFrom:1 to:currSize with:theString. |
|
159 |
currSize := currSize * 2. |
|
160 |
theString := newString |
|
161 |
]. |
|
162 |
thisChar isNil ifTrue:[ |
|
163 |
done := true |
|
164 |
] ifFalse:[ |
|
165 |
(thisChar == $% ) ifTrue:[ |
|
166 |
nextChar := self peek. |
|
167 |
(nextChar == ${ ) ifTrue:[ |
|
168 |
inPrimitive := true. |
|
169 |
index := index + 1. |
|
170 |
theString at:index put:thisChar. |
|
171 |
thisChar := self next |
|
172 |
] ifFalse:[ |
|
173 |
(nextChar == $} ) ifTrue:[ |
|
174 |
inPrimitive := false. |
|
175 |
index := index + 1. |
|
176 |
theString at:index put:thisChar. |
|
177 |
thisChar := self next |
|
178 |
] |
|
179 |
] |
|
180 |
] ifFalse:[ |
|
181 |
inPrimitive ifFalse:[ |
|
182 |
(thisChar == sep) ifTrue:[ |
|
183 |
(self peek == sep) ifFalse:[ |
|
184 |
done := true |
|
185 |
] ifTrue:[ |
|
186 |
self next |
|
187 |
] |
|
188 |
] |
|
189 |
] |
|
190 |
] |
|
191 |
]. |
|
192 |
done ifFalse:[ |
|
193 |
index := index + 1. |
|
194 |
theString at:index put:thisChar. |
|
195 |
thisChar := self next |
|
196 |
] |
|
1 | 197 |
]. |
198 |
(index == 0) ifTrue:[^ '']. |
|
57 | 199 |
^ theString copyTo:index |
1 | 200 |
! |
201 |
||
202 |
nextChunkPut:aString |
|
203 |
"put aString as a chunk onto the receiver; |
|
217 | 204 |
double all exclamation marks except within primitives and append a |
276 | 205 |
single delimiting exclamation mark at the end. |
718
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
206 |
This modification of the chunk format (not doubling exclas in primitive code) |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
207 |
was done to have primitive code more readable and easier be edited in the fileBrowser |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
208 |
or other editors. |
276 | 209 |
Its no incompatibility, since inline primitives are an ST/X special |
718
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
210 |
and code containing ST/X primitives cannot be loaded into other smalltalks anyway." |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
211 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
212 |
self nextPutAllAsChunk:aString. |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
213 |
self nextPut:ChunkSeparator |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
214 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
215 |
"Modified: 9.12.1995 / 15:56:54 / cg" |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
216 |
! |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
217 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
218 |
nextPutAllAsChunk:aString |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
219 |
"put aString as a chunk onto the receiver; |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
220 |
double all exclamation marks except within primitives. |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
221 |
This modification of the chunk format (not doubling exclas in primitive code) |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
222 |
was done to have primitive code more readable and easier be edited in the fileBrowser |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
223 |
or other editors. |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
224 |
Its no incompatibility, since inline primitives are an ST/X special |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
225 |
and code containing ST/X primitives cannot be loaded into other smalltalks anyway." |
1 | 226 |
|
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
227 |
|sep stopChars inPrimitive character |
1 | 228 |
index "{ Class:SmallInteger }" |
229 |
endIndex "{ Class:SmallInteger }" |
|
217 | 230 |
stop "{ Class:SmallInteger }" |
253 | 231 |
next "{ Class:SmallInteger }"| |
1 | 232 |
|
276 | 233 |
sep := ChunkSeparator. |
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
234 |
stopChars := '{}' copyWith:sep. |
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
235 |
|
1 | 236 |
inPrimitive := false. |
237 |
index := 1. |
|
238 |
endIndex := aString size. |
|
217 | 239 |
stop := endIndex + 1. |
1 | 240 |
|
241 |
[index <= endIndex] whileTrue:[ |
|
759
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
242 |
" |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
243 |
find position of next interesting character; |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
244 |
output stuff up to that one in one piece |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
245 |
" |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
246 |
next := aString indexOfAny:stopChars startingAt:index ifAbsent:stop. |
1 | 247 |
|
759
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
248 |
((index == 1) and:[next == stop]) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
249 |
self nextPutAll:aString |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
250 |
] ifFalse:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
251 |
self nextPutAll:aString startingAt:index to:(next - 1) |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
252 |
]. |
1 | 253 |
|
759
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
254 |
index := next. |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
255 |
(index <= endIndex) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
256 |
character := aString at:index. |
276 | 257 |
|
759
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
258 |
(character == ${ ) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
259 |
"/ starts a primitive |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
260 |
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
261 |
inPrimitive := true |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
262 |
] |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
263 |
] ifFalse:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
264 |
"/ ends a primitive |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
265 |
(character == $} ) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
266 |
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
267 |
inPrimitive := false |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
268 |
] |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
269 |
] ifFalse:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
270 |
"/ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
271 |
"/ exclas have to be doubled - except if within a primitive |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
272 |
"/ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
273 |
inPrimitive ifFalse:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
274 |
(character == sep) ifTrue:[ |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
275 |
self nextPut:sep |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
276 |
] |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
277 |
] |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
278 |
] |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
279 |
]. |
276 | 280 |
|
759
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
281 |
self nextPut:character. |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
282 |
index := index + 1 |
908363ce8a32
interest is written with one 'r' (shame on me)
Claus Gittinger <cg@exept.de>
parents:
718
diff
changeset
|
283 |
] |
1 | 284 |
]. |
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
285 |
|
718
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
286 |
"Modified: 9.12.1995 / 15:56:47 / cg" |
611 | 287 |
! |
288 |
||
289 |
nextPutChunkSeparator |
|
290 |
"append a chunk separator character" |
|
291 |
||
292 |
self nextPut:ChunkSeparator |
|
293 |
||
294 |
"Created: 13.9.1995 / 17:39:26 / claus" |
|
44 | 295 |
! ! |
296 |
||
297 |
!PositionableStream methodsFor:'fileIn'! |
|
298 |
||
611 | 299 |
askForDebug:message |
300 |
"launch a box asking if a debugger is wanted - used when an error |
|
301 |
occurs while filing in" |
|
302 |
||
303 |
Smalltalk isInitialized ifFalse:[ |
|
1086 | 304 |
'POSSTREAM: fileIn error during startup: ' errorPrint. message errorPrintNL. |
975 | 305 |
^ #debug |
611 | 306 |
]. |
875
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
307 |
"/ |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
308 |
"/ are we in the startup sequence of an image restart ? |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
309 |
"/ |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
310 |
Processor activeProcessIsSystemProcess ifTrue:[ |
1086 | 311 |
'POSSTREAM: fileIn error during startup: ' errorPrint. message errorPrintNL. |
975 | 312 |
^ #continue |
875
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
313 |
]. |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
314 |
|
611 | 315 |
^ OptionBox |
975 | 316 |
request:message |
317 |
label:'Error in fileIn' |
|
318 |
form:(WarningBox iconBitmap) |
|
319 |
buttonLabels:#('cancel' 'debug' 'continue') |
|
320 |
values:#(#abort #debug #continue) |
|
321 |
default:#continue. |
|
322 |
||
1086 | 323 |
"Modified: 7.3.1996 / 19:21:36 / cg" |
611 | 324 |
! |
325 |
||
44 | 326 |
fileIn |
327 |
"file in from the receiver, i.e. read chunks and evaluate them - |
|
328 |
return the value of the last chunk." |
|
329 |
||
283 | 330 |
^ self fileInNotifying:(SourceFileLoader on:self) passChunk:true |
44 | 331 |
! |
332 |
||
1 | 333 |
fileInNextChunkNotifying:someone |
334 |
"read next chunk, evaluate it and return the result; |
|
276 | 335 |
someone (which is usually some codeView) is notified of errors. |
336 |
Filein is done as follows: |
|
337 |
read a chunk |
|
338 |
if it started with an excla, evaluate it, and let the resulting object |
|
339 |
fileIn more chunks. |
|
340 |
This is a nice trick, since the methodsFor: expression evaluates to |
|
341 |
a ClassCategoryReader which reads and compiles chunks for its class. |
|
342 |
However, other than methodsFor expressions are possible - you can |
|
343 |
(in theory) create readers for any syntax. |
|
344 |
" |
|
1 | 345 |
|
282 | 346 |
^ self fileInNextChunkNotifying:someone passChunk:false |
347 |
! |
|
348 |
||
349 |
fileInNextChunkNotifying:someone passChunk:passChunk |
|
350 |
"read next chunk, evaluate it and return the result; |
|
351 |
someone (which is usually some codeView) is notified of errors. |
|
352 |
Filein is done as follows: |
|
353 |
read a chunk |
|
354 |
if it started with an excla, evaluate it, and let the resulting object |
|
355 |
fileIn more chunks. |
|
356 |
This is a nice trick, since the methodsFor: expression evaluates to |
|
357 |
a ClassCategoryReader which reads and compiles chunks for its class. |
|
358 |
However, other than methodsFor expressions are possible - you can |
|
359 |
(in theory) create readers for any syntax. |
|
360 |
" |
|
361 |
||
276 | 362 |
|aString sawExcla rslt done| |
1 | 363 |
|
364 |
self skipSeparators. |
|
365 |
self atEnd ifFalse:[ |
|
276 | 366 |
sawExcla := self peekFor:ChunkSeparator. |
159 | 367 |
aString := self nextChunk. |
368 |
aString size ~~ 0 ifTrue:[ |
|
282 | 369 |
passChunk ifTrue:[ |
370 |
someone source:aString |
|
371 |
]. |
|
372 |
sawExcla ifFalse:[ |
|
373 |
rslt := Compiler evaluate:aString notifying:someone. |
|
374 |
] ifTrue:[ |
|
375 |
rslt := Compiler evaluate:aString notifying:someone compile:false. |
|
376 |
||
159 | 377 |
" |
378 |
usually, the above chunk consists of some methodsFor:-expression |
|
379 |
in this case, the returned value is a ClassCategoryReader, |
|
380 |
which is used to load & compile the methods ... |
|
381 |
" |
|
253 | 382 |
rslt isNil ifTrue:[ |
383 |
" |
|
384 |
however, if that was nil (i.e. some error), we skip chunks |
|
385 |
up to the next empty chunk. |
|
386 |
" |
|
387 |
Transcript showCr:'skipping chunks ...'. |
|
388 |
done := false. |
|
389 |
[done] whileFalse:[ |
|
390 |
aString := self nextChunk. |
|
276 | 391 |
done := (aString size == 0) or:[aString isEmpty]. |
253 | 392 |
] |
393 |
] ifFalse:[ |
|
329 | 394 |
rslt := rslt fileInFrom:self notifying:someone passChunk:passChunk |
253 | 395 |
] |
159 | 396 |
] |
397 |
] |
|
1 | 398 |
]. |
159 | 399 |
^ rslt |
1 | 400 |
! |
401 |
||
611 | 402 |
fileInNotifying:someone passChunk:passChunk |
403 |
"file in from the receiver, i.e. read chunks and evaluate them - |
|
404 |
return the value of the last chunk. |
|
405 |
Someone (which is usually some codeView) is notified of errors." |
|
406 |
||
407 |
|lastValue| |
|
408 |
||
409 |
" |
|
410 |
catch any errors during fileIn |
|
411 |
- offer debug/abort/continue choice |
|
412 |
" |
|
973 | 413 |
ErrorSignal handle:[:ex | |
414 |
|action what sender| |
|
611 | 415 |
|
973 | 416 |
what := ex errorString. |
417 |
what isNil ifTrue:[ |
|
418 |
what := ex signal notifierString. |
|
419 |
]. |
|
611 | 420 |
|
973 | 421 |
"handle the case where no GUI has been built in, |
422 |
just abort the fileIn with a notification" |
|
41 | 423 |
|
973 | 424 |
Display isNil ifTrue:[ |
425 |
sender := ex suspendedContext sender. |
|
426 |
self notify:(what , |
|
427 |
' in ' , sender receiver class name , |
|
428 |
'>>>' , sender selector). |
|
429 |
ex return |
|
430 |
]. |
|
611 | 431 |
|
973 | 432 |
"otherwise ask what should be done now and either |
433 |
continue or abort the fileIn" |
|
611 | 434 |
|
973 | 435 |
action := self askForDebug:('error in fileIn: ' , what) withCRs. |
436 |
action == #continue ifTrue:[ |
|
437 |
ex proceed |
|
438 |
]. |
|
439 |
action == #abort ifTrue:[ |
|
440 |
ex return |
|
441 |
]. |
|
611 | 442 |
"/ Debugger enter:ex suspendedContext |
973 | 443 |
(ex signal) enterDebuggerWith:ex message:what. |
444 |
ex reject |
|
611 | 445 |
] do:[ |
973 | 446 |
[self atEnd] whileFalse:[ |
447 |
lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk |
|
448 |
] |
|
180 | 449 |
]. |
611 | 450 |
^ lastValue |
973 | 451 |
|
452 |
"Modified: 20.2.1996 / 20:24:49 / cg" |
|
611 | 453 |
! ! |
454 |
||
455 |
!PositionableStream methodsFor:'positioning'! |
|
456 |
||
457 |
backStep |
|
458 |
"move backward read position by one" |
|
459 |
||
460 |
position <= 0 ifTrue: [^ self positionError]. |
|
461 |
position := position - 1 |
|
462 |
! |
|
463 |
||
464 |
position |
|
465 |
"return the read position" |
|
466 |
||
467 |
^ position |
|
468 |
! |
|
469 |
||
470 |
position:index |
|
471 |
"set the read position" |
|
472 |
||
473 |
"/ FIX: allow positioning right after last element of stream |
|
474 |
"/ ((index > readLimit) or:[index < 0]) ifTrue: [^ self positionError]. |
|
475 |
||
476 |
((index > (readLimit+1)) or:[index < 0]) ifTrue: [^ self positionError]. |
|
477 |
position := index |
|
478 |
! |
|
479 |
||
480 |
reset |
|
481 |
"set the read position to the beginning of the collection" |
|
482 |
||
483 |
position := "0" 1 |
|
484 |
! |
|
485 |
||
486 |
setToEnd |
|
487 |
"set the read position to the end of the collection" |
|
488 |
||
489 |
position := readLimit |
|
490 |
! |
|
491 |
||
492 |
skip:numberToSkip |
|
493 |
"skip the next numberToSkip elements" |
|
494 |
||
495 |
self position:(position + numberToSkip) |
|
44 | 496 |
! ! |
611 | 497 |
|
498 |
!PositionableStream methodsFor:'private'! |
|
499 |
||
500 |
contentsSpecies |
|
501 |
"return a class of which instances will be returned, when |
|
502 |
parts of the collection are asked for. |
|
503 |
(see upTo-kind of methods in subclasses)" |
|
504 |
||
505 |
^ collection species |
|
506 |
! |
|
507 |
||
508 |
on:aCollection |
|
509 |
"setup for streaming on aCollection" |
|
510 |
||
511 |
collection := aCollection. |
|
512 |
readLimit := aCollection size. |
|
513 |
position := "0" 1 |
|
514 |
! |
|
515 |
||
516 |
on:aCollection from:first to:last |
|
517 |
"setup for streaming on aCollection from first to last" |
|
518 |
||
519 |
collection := aCollection. |
|
520 |
position := first. |
|
521 |
readLimit := last |
|
522 |
! |
|
523 |
||
524 |
positionError |
|
525 |
"report an error when positioning past the end" |
|
526 |
||
527 |
^ self error:'cannot position past end of collection' |
|
528 |
! |
|
529 |
||
530 |
with:aCollection |
|
531 |
"setup for streaming to the end of aCollection" |
|
532 |
||
533 |
collection := aCollection. |
|
534 |
self setToEnd |
|
535 |
! ! |
|
536 |
||
537 |
!PositionableStream methodsFor:'queries'! |
|
538 |
||
539 |
isPositionable |
|
540 |
"return true, if the stream supports positioning (this one is)" |
|
541 |
||
542 |
^ true |
|
543 |
! ! |
|
544 |
||
545 |
!PositionableStream methodsFor:'testing'! |
|
546 |
||
547 |
atEnd |
|
548 |
"return true, if the read-position is at the end" |
|
549 |
||
550 |
^ position > readLimit |
|
551 |
! |
|
552 |
||
553 |
isEmpty |
|
554 |
"return true, if the contents of the stream is empty" |
|
555 |
||
556 |
^ readLimit == 0 |
|
557 |
! ! |
|
558 |
||
701 | 559 |
!PositionableStream class methodsFor:'documentation'! |
560 |
||
561 |
version |
|
1086 | 562 |
^ '$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.41 1996-03-07 18:32:41 cg Exp $' |
701 | 563 |
! ! |
611 | 564 |
PositionableStream initialize! |