author | Claus Gittinger <cg@exept.de> |
Mon, 15 Jun 1998 21:41:00 +0200 | |
changeset 3584 | 099a64bc9b63 |
parent 3580 | 47534257f9e5 |
child 3592 | ac5e8c09ff42 |
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' |
2966 | 15 |
classVariableNames:'InvalidPositionErrorSignal ErrorDuringFileInSignal ChunkSeparator' |
973 | 16 |
poolDictionaries:'' |
17 |
category:'Streams' |
|
1 | 18 |
! |
19 |
||
1897 | 20 |
!PositionableStream class methodsFor:'documentation'! |
88 | 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. |
|
3249
8401c3e42165
checkin to force re-checkout.
Claus Gittinger <cg@exept.de>
parents:
3184
diff
changeset
|
41 |
|
88 | 42 |
This is an abstract class. |
1295 | 43 |
|
44 |
[author:] |
|
1998 | 45 |
Claus Gittinger |
88 | 46 |
" |
47 |
! ! |
|
1 | 48 |
|
1897 | 49 |
!PositionableStream class methodsFor:'initialization'! |
1 | 50 |
|
10 | 51 |
initialize |
44 | 52 |
"setup the signal used to handle errors during fileIn" |
53 |
||
10 | 54 |
ErrorDuringFileInSignal isNil ifTrue:[ |
302 | 55 |
ErrorDuringFileInSignal := ErrorSignal newSignalMayProceed:true. |
159 | 56 |
ErrorDuringFileInSignal nameClass:self message:#errorDuringFileInSignal. |
57 |
ErrorDuringFileInSignal notifierString:'error during fileIn'. |
|
276 | 58 |
|
2966 | 59 |
InvalidPositionErrorSignal := PositionErrorSignal newSignalMayProceed:true. |
60 |
InvalidPositionErrorSignal nameClass:self message:#invalidPositionErrorSignal. |
|
61 |
InvalidPositionErrorSignal notifierString:'invalid position'. |
|
62 |
||
276 | 63 |
ChunkSeparator := $!! |
10 | 64 |
] |
65 |
! ! |
|
1 | 66 |
|
1897 | 67 |
!PositionableStream class methodsFor:'instance creation'! |
1 | 68 |
|
69 |
on:aCollection |
|
70 |
"return a new PositionableStream streaming on aCollection" |
|
71 |
||
72 |
^ (self basicNew) on:aCollection |
|
73 |
! |
|
74 |
||
75 |
on:aCollection from:first to:last |
|
76 |
"return a new PositionableStream streaming on aCollection |
|
77 |
from first to last" |
|
78 |
||
369 | 79 |
^ (self basicNew) on:aCollection from:first to:last |
57 | 80 |
! |
81 |
||
82 |
with:aCollection |
|
83 |
"return a new PositionableStream streaming on aCollection, |
|
84 |
the stream is positioned to the end of the collection." |
|
85 |
||
362 | 86 |
^ (self basicNew) with:aCollection |
1 | 87 |
! ! |
88 |
||
3032
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
89 |
!PositionableStream class methodsFor:'Signal constants'! |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
90 |
|
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
91 |
invalidPositionErrorSignal |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
92 |
"return the signal raised if positioning is attempted to an |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
93 |
invalid position (i.e. before the begin of the stream or after |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
94 |
the end)" |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
95 |
|
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
96 |
^ InvalidPositionErrorSignal |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
97 |
! ! |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
98 |
|
1897 | 99 |
!PositionableStream class methodsFor:'constants'! |
1 | 100 |
|
611 | 101 |
chunkSeparator |
102 |
"return the chunk-separation character" |
|
57 | 103 |
|
611 | 104 |
^ ChunkSeparator |
360 | 105 |
! ! |
106 |
||
1 | 107 |
!PositionableStream methodsFor:'accessing'! |
108 |
||
109 |
contents |
|
110 |
"return the entire contents of the stream" |
|
111 |
||
112 |
^ collection |
|
113 |
! |
|
114 |
||
115 |
peek |
|
116 |
"look ahead for and return the next element" |
|
117 |
||
118 |
|peekObject| |
|
119 |
||
120 |
peekObject := self next. |
|
10 | 121 |
self backStep. |
1 | 122 |
^ peekObject |
123 |
! |
|
124 |
||
125 |
peekFor:something |
|
10 | 126 |
"return true and move past if next == something; |
127 |
otherwise stay and let position unchanged" |
|
1 | 128 |
|
129 |
self next == something ifTrue:[ |
|
159 | 130 |
^ true |
1 | 131 |
]. |
10 | 132 |
self backStep. |
1 | 133 |
^ false |
134 |
! |
|
135 |
||
2432 | 136 |
peekForAll:aCollection |
137 |
"return true and advance if the next elements are the same |
|
138 |
as aCollection. |
|
139 |
otherwise stay and let the position unchanged" |
|
140 |
||
141 |
|oldPos| |
|
142 |
||
143 |
oldPos := self position. |
|
144 |
(self next:(aCollection size)) = aCollection ifTrue:[ |
|
145 |
^ true |
|
146 |
]. |
|
147 |
self position:oldPos. |
|
148 |
^ false |
|
149 |
||
150 |
"Created: 1.3.1997 / 15:11:25 / cg" |
|
151 |
! |
|
152 |
||
1 | 153 |
readLimit:aNumber |
369 | 154 |
"set the read-limit; thats the position at which EOF is returned" |
1 | 155 |
|
156 |
readLimit := aNumber |
|
369 | 157 |
! |
158 |
||
159 |
writeLimit:aNumber |
|
160 |
"set the writeLimit; thats the position after which writing is prohibited" |
|
161 |
||
162 |
writeLimit := aNumber |
|
1 | 163 |
! ! |
164 |
||
44 | 165 |
!PositionableStream methodsFor:'chunk input/output'! |
1 | 166 |
|
167 |
nextChunk |
|
168 |
"return the next chunk, i.e. all characters up to the next |
|
217 | 169 |
exclamation mark. Within the chunk, exclamation marks have to be doubled, |
170 |
they are undoubled here. |
|
171 |
Except for primitive code, in which doubling is not needed (allowed). |
|
172 |
This exception was added to make it easier to edit primitive code with |
|
173 |
external editors. However, this means, that other Smalltalks cannot always |
|
174 |
read chunks containing primitive code |
|
175 |
- but that doesnt really matter, since C-primitives are an ST/X feature anyway." |
|
1 | 176 |
|
177 |
|theString sep newString done thisChar nextChar inPrimitive |
|
178 |
index "{ Class:SmallInteger }" |
|
179 |
currSize "{ Class:SmallInteger }" | |
|
180 |
||
276 | 181 |
sep := ChunkSeparator. |
1 | 182 |
theString := String new:500. |
183 |
currSize := 500. |
|
184 |
thisChar := self skipSeparators. |
|
185 |
thisChar := self next. |
|
186 |
index := 0. |
|
187 |
done := false. |
|
188 |
inPrimitive := false. |
|
189 |
||
190 |
[done] whileFalse:[ |
|
159 | 191 |
((index + 2) <= currSize) ifFalse:[ |
192 |
newString := String new:(currSize * 2). |
|
193 |
newString replaceFrom:1 to:currSize with:theString. |
|
194 |
currSize := currSize * 2. |
|
195 |
theString := newString |
|
196 |
]. |
|
197 |
thisChar isNil ifTrue:[ |
|
198 |
done := true |
|
199 |
] ifFalse:[ |
|
200 |
(thisChar == $% ) ifTrue:[ |
|
201 |
nextChar := self peek. |
|
202 |
(nextChar == ${ ) ifTrue:[ |
|
203 |
inPrimitive := true. |
|
204 |
index := index + 1. |
|
205 |
theString at:index put:thisChar. |
|
206 |
thisChar := self next |
|
207 |
] ifFalse:[ |
|
208 |
(nextChar == $} ) ifTrue:[ |
|
209 |
inPrimitive := false. |
|
210 |
index := index + 1. |
|
211 |
theString at:index put:thisChar. |
|
212 |
thisChar := self next |
|
213 |
] |
|
214 |
] |
|
215 |
] ifFalse:[ |
|
216 |
inPrimitive ifFalse:[ |
|
217 |
(thisChar == sep) ifTrue:[ |
|
218 |
(self peek == sep) ifFalse:[ |
|
219 |
done := true |
|
220 |
] ifTrue:[ |
|
221 |
self next |
|
222 |
] |
|
223 |
] |
|
224 |
] |
|
225 |
] |
|
226 |
]. |
|
227 |
done ifFalse:[ |
|
228 |
index := index + 1. |
|
229 |
theString at:index put:thisChar. |
|
230 |
thisChar := self next |
|
231 |
] |
|
1 | 232 |
]. |
233 |
(index == 0) ifTrue:[^ '']. |
|
57 | 234 |
^ theString copyTo:index |
1 | 235 |
! |
236 |
||
237 |
nextChunkPut:aString |
|
238 |
"put aString as a chunk onto the receiver; |
|
217 | 239 |
double all exclamation marks except within primitives and append a |
276 | 240 |
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
|
241 |
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
|
242 |
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
|
243 |
or other editors. |
276 | 244 |
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
|
245 |
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
|
246 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
247 |
self nextPutAllAsChunk:aString. |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
248 |
self nextPut:ChunkSeparator |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
249 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
250 |
"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
|
251 |
! |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
252 |
|
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
253 |
nextPutAllAsChunk:aString |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
254 |
"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
|
255 |
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
|
256 |
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
|
257 |
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
|
258 |
or other editors. |
6f8222ff2ff0
extra entry to store a chunk without appending a chunk-separator
Claus Gittinger <cg@exept.de>
parents:
701
diff
changeset
|
259 |
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
|
260 |
and code containing ST/X primitives cannot be loaded into other smalltalks anyway." |
1 | 261 |
|
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
262 |
|sep stopChars inPrimitive character |
1 | 263 |
index "{ Class:SmallInteger }" |
264 |
endIndex "{ Class:SmallInteger }" |
|
217 | 265 |
stop "{ Class:SmallInteger }" |
253 | 266 |
next "{ Class:SmallInteger }"| |
1 | 267 |
|
3386 | 268 |
endIndex := aString size. |
269 |
endIndex == 0 ifTrue:[^ self]. |
|
270 |
||
276 | 271 |
sep := ChunkSeparator. |
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
272 |
stopChars := '{}' copyWith:sep. |
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
273 |
|
1 | 274 |
inPrimitive := false. |
275 |
index := 1. |
|
217 | 276 |
stop := endIndex + 1. |
1 | 277 |
|
278 |
[index <= endIndex] whileTrue:[ |
|
3386 | 279 |
" |
280 |
find position of next interesting character; |
|
281 |
output stuff up to that one in one piece |
|
282 |
" |
|
283 |
next := aString indexOfAny:stopChars startingAt:index ifAbsent:stop. |
|
1 | 284 |
|
3386 | 285 |
((index == 1) and:[next == stop]) ifTrue:[ |
286 |
self nextPutAll:aString |
|
287 |
] ifFalse:[ |
|
288 |
self nextPutAll:aString startingAt:index to:(next - 1) |
|
289 |
]. |
|
1 | 290 |
|
3386 | 291 |
index := next. |
292 |
(index <= endIndex) ifTrue:[ |
|
293 |
character := aString at:index. |
|
276 | 294 |
|
3386 | 295 |
(character == ${ ) ifTrue:[ |
296 |
"/ starts a primitive |
|
297 |
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[ |
|
298 |
inPrimitive := true |
|
299 |
] |
|
300 |
] ifFalse:[ |
|
301 |
"/ ends a primitive |
|
302 |
(character == $} ) ifTrue:[ |
|
303 |
((index > 1) and:[(aString at:index-1) == $%]) ifTrue:[ |
|
304 |
inPrimitive := false |
|
305 |
] |
|
306 |
] ifFalse:[ |
|
307 |
"/ |
|
308 |
"/ exclas have to be doubled - except if within a primitive |
|
309 |
"/ |
|
310 |
inPrimitive ifFalse:[ |
|
311 |
(character == sep) ifTrue:[ |
|
312 |
self nextPut:sep |
|
313 |
] |
|
314 |
] |
|
315 |
] |
|
316 |
]. |
|
276 | 317 |
|
3386 | 318 |
self nextPut:character. |
319 |
index := index + 1 |
|
320 |
] |
|
1 | 321 |
]. |
517
c8fae50c2cc5
fixed nextChunkPut: which sometimes doubled exclas within primitives
Claus Gittinger <cg@exept.de>
parents:
432
diff
changeset
|
322 |
|
3386 | 323 |
"Modified: / 21.4.1998 / 17:22:47 / cg" |
611 | 324 |
! |
325 |
||
326 |
nextPutChunkSeparator |
|
327 |
"append a chunk separator character" |
|
328 |
||
329 |
self nextPut:ChunkSeparator |
|
330 |
||
331 |
"Created: 13.9.1995 / 17:39:26 / claus" |
|
44 | 332 |
! ! |
333 |
||
334 |
!PositionableStream methodsFor:'fileIn'! |
|
335 |
||
611 | 336 |
askForDebug:message |
337 |
"launch a box asking if a debugger is wanted - used when an error |
|
338 |
occurs while filing in" |
|
339 |
||
340 |
Smalltalk isInitialized ifFalse:[ |
|
2130
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
341 |
'PositionableStream [warning]: fileIn error during startup: ' errorPrint. message errorPrintCR. |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
342 |
^ #debug |
611 | 343 |
]. |
875
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
344 |
"/ |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
345 |
"/ 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
|
346 |
"/ |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
347 |
Processor activeProcessIsSystemProcess ifTrue:[ |
2130
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
348 |
'PositionableStream [warning]: fileIn error during startup: ' errorPrint. message errorPrintCR. |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
349 |
^ #continue |
875
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
350 |
]. |
2bb6fea4cb55
dont launch box when fileIn errors occur during startup
Claus Gittinger <cg@exept.de>
parents:
759
diff
changeset
|
351 |
|
611 | 352 |
^ OptionBox |
2130
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
353 |
request:message |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
354 |
label:'Error in fileIn' |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
355 |
form:(WarningBox iconBitmap) |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
356 |
buttonLabels:#('cancel' 'debug' 'continue') |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
357 |
values:#(#abort #debug #continue) |
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
358 |
default:#continue. |
975 | 359 |
|
2130
b9e7e1cf98bd
newStyle info & error messages
Claus Gittinger <cg@exept.de>
parents:
2005
diff
changeset
|
360 |
"Modified: 10.1.1997 / 18:00:56 / cg" |
611 | 361 |
! |
362 |
||
44 | 363 |
fileIn |
364 |
"file in from the receiver, i.e. read chunks and evaluate them - |
|
365 |
return the value of the last chunk." |
|
366 |
||
283 | 367 |
^ self fileInNotifying:(SourceFileLoader on:self) passChunk:true |
44 | 368 |
! |
369 |
||
1 | 370 |
fileInNextChunkNotifying:someone |
371 |
"read next chunk, evaluate it and return the result; |
|
276 | 372 |
someone (which is usually some codeView) is notified of errors. |
373 |
Filein is done as follows: |
|
374 |
read a chunk |
|
375 |
if it started with an excla, evaluate it, and let the resulting object |
|
376 |
fileIn more chunks. |
|
377 |
This is a nice trick, since the methodsFor: expression evaluates to |
|
378 |
a ClassCategoryReader which reads and compiles chunks for its class. |
|
379 |
However, other than methodsFor expressions are possible - you can |
|
380 |
(in theory) create readers for any syntax. |
|
381 |
" |
|
1 | 382 |
|
282 | 383 |
^ self fileInNextChunkNotifying:someone passChunk:false |
384 |
! |
|
385 |
||
386 |
fileInNextChunkNotifying:someone passChunk:passChunk |
|
387 |
"read next chunk, evaluate it and return the result; |
|
388 |
someone (which is usually some codeView) is notified of errors. |
|
389 |
Filein is done as follows: |
|
3032
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
390 |
read a chunk |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
391 |
if it started with an excla, evaluate it, and let the resulting object |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
392 |
fileIn more chunks. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
393 |
This is a nice trick, since the methodsFor: expression evaluates to |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
394 |
a ClassCategoryReader which reads and compiles chunks for its class. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
395 |
However, other than methodsFor expressions are possible - you can |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
396 |
(in theory) create readers for any syntax. |
282 | 397 |
" |
398 |
||
276 | 399 |
|aString sawExcla rslt done| |
1 | 400 |
|
401 |
self skipSeparators. |
|
402 |
self atEnd ifFalse:[ |
|
3032
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
403 |
sawExcla := self peekFor:ChunkSeparator. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
404 |
aString := self nextChunk. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
405 |
"/ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
406 |
"/ handle empty chunks; |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
407 |
"/ this allows for Squeak code to be filedIn |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
408 |
"/ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
409 |
[aString size == 0 |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
410 |
and:[self atEnd not]] whileTrue:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
411 |
aString := self nextChunk. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
412 |
]. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
413 |
aString size ~~ 0 ifTrue:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
414 |
passChunk ifTrue:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
415 |
someone source:aString |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
416 |
]. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
417 |
sawExcla ifFalse:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
418 |
rslt := Smalltalk::Compiler evaluate:aString notifying:someone. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
419 |
] ifTrue:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
420 |
Smalltalk::Compiler emptySourceNotificationSignal handle:[:ex | |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
421 |
^ nil |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
422 |
] do:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
423 |
rslt := Smalltalk::Compiler evaluate:aString notifying:someone compile:false. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
424 |
]. |
282 | 425 |
|
3032
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
426 |
" |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
427 |
usually, the above chunk consists of some methodsFor:-expression |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
428 |
in this case, the returned value is a ClassCategoryReader, |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
429 |
which is used to load & compile the methods ... |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
430 |
" |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
431 |
rslt isNil ifTrue:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
432 |
" |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
433 |
however, if that was nil (i.e. some error), we skip chunks |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
434 |
up to the next empty chunk. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
435 |
" |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
436 |
Transcript showCR:'skipping chunks ...'. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
437 |
done := false. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
438 |
[done] whileFalse:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
439 |
aString := self nextChunk. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
440 |
done := (aString size == 0) or:[aString isEmpty]. |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
441 |
] |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
442 |
] ifFalse:[ |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
443 |
rslt := rslt fileInFrom:self notifying:someone passChunk:passChunk |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
444 |
] |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
445 |
] |
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
446 |
] |
1 | 447 |
]. |
159 | 448 |
^ rslt |
1420 | 449 |
|
3032
d267a0b1b48d
handle empty chunks when filing in
Claus Gittinger <cg@exept.de>
parents:
2966
diff
changeset
|
450 |
"Modified: 14.10.1997 / 17:10:35 / cg" |
1 | 451 |
! |
452 |
||
611 | 453 |
fileInNotifying:someone passChunk:passChunk |
454 |
"file in from the receiver, i.e. read chunks and evaluate them - |
|
455 |
return the value of the last chunk. |
|
456 |
Someone (which is usually some codeView) is notified of errors." |
|
457 |
||
2893 | 458 |
|lastValue pkg spc spaces |
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
459 |
packageQuerySignal nameSpaceQuerySignal usedNameSpaceQuerySignal |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
460 |
changeDefaultApplicationNotificationSignal |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
461 |
defaultApplicationQuerySignal defaultApplication |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
462 |
handledSignals| |
611 | 463 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
464 |
"/ support for V'Age applications |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
465 |
defaultApplicationQuerySignal := Class defaultApplicationQuerySignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
466 |
changeDefaultApplicationNotificationSignal := Class changeDefaultApplicationNotificationSignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
467 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
468 |
"/ support for ST/X's namespaces & packages |
2343 | 469 |
packageQuerySignal := Class packageQuerySignal. |
470 |
nameSpaceQuerySignal := Class nameSpaceQuerySignal. |
|
471 |
usedNameSpaceQuerySignal := Class usedNameSpaceQuerySignal. |
|
472 |
||
2893 | 473 |
(someone respondsTo:#packageToInstall) ifFalse:[ |
474 |
pkg := packageQuerySignal raise. |
|
475 |
] ifTrue:[ |
|
476 |
pkg := someone packageToInstall |
|
477 |
]. |
|
478 |
(someone respondsTo:#currentNameSpace) ifFalse:[ |
|
479 |
spc := nameSpaceQuerySignal raise. |
|
480 |
] ifTrue:[ |
|
481 |
spc := someone currentNameSpace |
|
482 |
]. |
|
483 |
(someone respondsTo:#usedNameSpaces) ifFalse:[ |
|
484 |
spaces := usedNameSpaceQuerySignal raise. |
|
485 |
] ifTrue:[ |
|
486 |
spaces := someone usedNameSpaces |
|
487 |
]. |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
488 |
(someone respondsTo:#defaultApplication) ifFalse:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
489 |
defaultApplication := defaultApplicationQuerySignal raise. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
490 |
] ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
491 |
defaultApplication := someone defaultApplication |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
492 |
]. |
2893 | 493 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
494 |
handledSignals := SignalSet new. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
495 |
handledSignals add:changeDefaultApplicationNotificationSignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
496 |
handledSignals add:packageQuerySignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
497 |
handledSignals add:usedNameSpaceQuerySignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
498 |
handledSignals add:nameSpaceQuerySignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
499 |
handledSignals add:defaultApplicationQuerySignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
500 |
handledSignals add:ErrorSignal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
501 |
handledSignals handle:[:ex | |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
502 |
|sig action what sender msg param oldPackage newPackage| |
1902 | 503 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
504 |
sig := ex signal. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
505 |
sig == changeDefaultApplicationNotificationSignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
506 |
"/ invoked via #becomeDefault to set the defaultApp and the package. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
507 |
"/ (only when filing in V'Age code) |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
508 |
defaultApplication := ex parameter. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
509 |
pkg := defaultApplication name asSymbol. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
510 |
ex proceed |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
511 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
512 |
sig == defaultApplicationQuerySignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
513 |
"/ query for the application to add classes & methods into |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
514 |
"/ (only when filing in V'Age code) |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
515 |
ex proceedWith:defaultApplication |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
516 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
517 |
sig == packageQuerySignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
518 |
"/ query for the package to use for classes & methods |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
519 |
ex proceedWith:pkg |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
520 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
521 |
sig == usedNameSpaceQuerySignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
522 |
"/ query for the namespaces searched when encountering globals |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
523 |
ex proceedWith:spaces |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
524 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
525 |
sig == nameSpaceQuerySignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
526 |
"/ query for the namespace to install new classes in |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
527 |
ex proceedWith:spc |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
528 |
]. |
3580
47534257f9e5
avoid two queries for rejected signals.
Claus Gittinger <cg@exept.de>
parents:
3386
diff
changeset
|
529 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
530 |
sig == Signal noHandlerSignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
531 |
ex parameter rejected ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
532 |
ex reject |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
533 |
] |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
534 |
]. |
2893 | 535 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
536 |
"/ for your convenience ... |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
537 |
sig == Class methodRedefinitionSignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
538 |
param := ex parameter. "/ an association: oldMethod -> newMethod |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
539 |
oldPackage := param key package. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
540 |
newPackage := param value package. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
541 |
msg := 'trying to overwrite method:\\ %1\\in package ''' |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
542 |
, oldPackage , ''' with method from package ''' , newPackage , '''' |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
543 |
] ifFalse:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
544 |
msg := 'error in fileIn: %1' |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
545 |
]. |
2893 | 546 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
547 |
what := ex errorString. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
548 |
what isNil ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
549 |
what := ex signal notifierString. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
550 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
551 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
552 |
"/ handle the case where no GUI has been built in, |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
553 |
"/ just abort the fileIn with a notification |
2893 | 554 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
555 |
Display isNil ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
556 |
sender := ex suspendedContext sender. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
557 |
self notify:(what , |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
558 |
' in ' , sender receiver class name , |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
559 |
'>>>' , sender selector). |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
560 |
ex return |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
561 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
562 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
563 |
msg := msg bindWith:what. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
564 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
565 |
sig == Object haltSignal ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
566 |
sender := ex suspendedContext. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
567 |
msg := msg , ('\\in ' , sender receiver class name , '>>>' , sender selector) withCRs |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
568 |
]. |
2893 | 569 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
570 |
"/ otherwise ask what should be done now and either |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
571 |
"/ continue or abort the fileIn |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
572 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
573 |
action := self askForDebug:msg withCRs. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
574 |
action == #continue ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
575 |
ex proceed |
2005
d77ecd466b5b
handle usedNameSpaces request
Claus Gittinger <cg@exept.de>
parents:
1999
diff
changeset
|
576 |
]. |
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
577 |
action == #abort ifTrue:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
578 |
ex return |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
579 |
]. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
580 |
|
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
581 |
"/ (ex signal) enterDebuggerWith:ex message:what. |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
582 |
ex reject |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
583 |
] do:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
584 |
[self atEnd] whileFalse:[ |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
585 |
lastValue := self fileInNextChunkNotifying:someone passChunk:passChunk |
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
586 |
] |
180 | 587 |
]. |
611 | 588 |
^ lastValue |
973 | 589 |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
590 |
"Modified: / 15.6.1998 / 21:40:27 / cg" |
611 | 591 |
! ! |
592 |
||
593 |
!PositionableStream methodsFor:'positioning'! |
|
594 |
||
595 |
backStep |
|
596 |
"move backward read position by one" |
|
597 |
||
598 |
position <= 0 ifTrue: [^ self positionError]. |
|
599 |
position := position - 1 |
|
600 |
! |
|
601 |
||
602 |
position |
|
603 |
"return the read position" |
|
604 |
||
605 |
^ position |
|
606 |
! |
|
607 |
||
608 |
position:index |
|
609 |
"set the read position" |
|
610 |
||
611 |
"/ FIX: allow positioning right after last element of stream |
|
612 |
"/ ((index > readLimit) or:[index < 0]) ifTrue: [^ self positionError]. |
|
613 |
||
614 |
((index > (readLimit+1)) or:[index < 0]) ifTrue: [^ self positionError]. |
|
615 |
position := index |
|
616 |
! |
|
617 |
||
618 |
reset |
|
619 |
"set the read position to the beginning of the collection" |
|
620 |
||
621 |
position := "0" 1 |
|
622 |
! |
|
623 |
||
624 |
setToEnd |
|
625 |
"set the read position to the end of the collection" |
|
626 |
||
627 |
position := readLimit |
|
628 |
! |
|
629 |
||
630 |
skip:numberToSkip |
|
631 |
"skip the next numberToSkip elements" |
|
632 |
||
633 |
self position:(position + numberToSkip) |
|
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
634 |
! |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
635 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
636 |
skipThroughAll:aCollection |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
637 |
"skip for and through the sequence given by the argument, aCollection; |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
638 |
return nil if not found, self otherwise. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
639 |
On a successful match, the next read will return elements after aCollection; |
2153
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
640 |
if no match was found, the receiver will be positioned at the end. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
641 |
This is redefined here, to make use of positioning." |
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
642 |
|
2154
89e96599e1e2
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2153
diff
changeset
|
643 |
|buffer l first idx| |
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
644 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
645 |
l := aCollection size. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
646 |
first := aCollection at:1. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
647 |
[self atEnd] whileFalse:[ |
2153
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
648 |
buffer := self nextAvailable:l. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
649 |
buffer = aCollection ifTrue:[ |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
650 |
^ self |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
651 |
]. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
652 |
idx := buffer indexOf:first startingAt:2. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
653 |
idx == 0 ifFalse:[ |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
654 |
self position:(self position - l + idx - 1) |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
655 |
] |
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
656 |
]. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
657 |
^ nil |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
658 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
659 |
" |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
660 |
|s| |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
661 |
s := ReadStream on:'12345678901234567890'. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
662 |
s skipThroughAll:'901'. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
663 |
s upToEnd |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
664 |
" |
2153
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
665 |
" |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
666 |
|s| |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
667 |
s := ReadStream on:'12345678901234567890'. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
668 |
s skipThroughAll:'1234'. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
669 |
s upToEnd |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
670 |
" |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
671 |
" |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
672 |
|s| |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
673 |
s := ReadStream on:'12345678901234567890'. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
674 |
s skipThroughAll:'999'. |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
675 |
s atEnd |
244e36cbbd9b
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2130
diff
changeset
|
676 |
" |
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
677 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
678 |
"Created: 26.6.1996 / 09:35:35 / cg" |
2154
89e96599e1e2
skipThroughAll: does not need the old position
Claus Gittinger <cg@exept.de>
parents:
2153
diff
changeset
|
679 |
"Modified: 11.1.1997 / 19:16:38 / cg" |
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
680 |
! |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
681 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
682 |
skipToAll:aCollection |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
683 |
"skip for the sequence given by the argument, aCollection; |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
684 |
return nil if not found, self otherwise. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
685 |
On a successful match, the next read will return elements of aCollection." |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
686 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
687 |
|oldPos buffer l first idx| |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
688 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
689 |
oldPos := self position. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
690 |
l := aCollection size. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
691 |
first := aCollection at:1. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
692 |
[self atEnd] whileFalse:[ |
1998 | 693 |
buffer := self next:l. |
694 |
buffer = aCollection ifTrue:[ |
|
695 |
self position:(self position - l). |
|
696 |
^ self |
|
697 |
]. |
|
698 |
idx := buffer indexOf:first startingAt:2. |
|
699 |
idx == 0 ifFalse:[ |
|
700 |
self position:(self position - l + idx - 1) |
|
701 |
] |
|
1489
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
702 |
]. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
703 |
self position:oldPos. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
704 |
^ nil |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
705 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
706 |
" |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
707 |
|s| |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
708 |
s := ReadStream on:'12345678901234567890'. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
709 |
s skipToAll:'901'. |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
710 |
s upToEnd |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
711 |
" |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
712 |
|
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
713 |
"Modified: 26.6.1996 / 09:28:27 / cg" |
9e3b166483fb
moved some skip methods from readStream;
Claus Gittinger <cg@exept.de>
parents:
1420
diff
changeset
|
714 |
"Created: 26.6.1996 / 09:35:06 / cg" |
44 | 715 |
! ! |
611 | 716 |
|
717 |
!PositionableStream methodsFor:'private'! |
|
718 |
||
719 |
contentsSpecies |
|
720 |
"return a class of which instances will be returned, when |
|
721 |
parts of the collection are asked for. |
|
722 |
(see upTo-kind of methods in subclasses)" |
|
723 |
||
724 |
^ collection species |
|
725 |
! |
|
726 |
||
727 |
on:aCollection |
|
728 |
"setup for streaming on aCollection" |
|
729 |
||
730 |
collection := aCollection. |
|
731 |
readLimit := aCollection size. |
|
732 |
position := "0" 1 |
|
733 |
! |
|
734 |
||
735 |
on:aCollection from:first to:last |
|
736 |
"setup for streaming on aCollection from first to last" |
|
737 |
||
738 |
collection := aCollection. |
|
739 |
position := first. |
|
740 |
readLimit := last |
|
741 |
! |
|
742 |
||
743 |
positionError |
|
1998 | 744 |
"{ Pragma: +optSpace }" |
745 |
||
2966 | 746 |
"report an error when positioning past the end |
747 |
or before the beginning." |
|
611 | 748 |
|
2966 | 749 |
^ InvalidPositionErrorSignal raiseIn:thisContext sender |
611 | 750 |
! |
751 |
||
752 |
with:aCollection |
|
753 |
"setup for streaming to the end of aCollection" |
|
754 |
||
755 |
collection := aCollection. |
|
756 |
self setToEnd |
|
757 |
! ! |
|
758 |
||
759 |
!PositionableStream methodsFor:'queries'! |
|
760 |
||
761 |
isPositionable |
|
762 |
"return true, if the stream supports positioning (this one is)" |
|
763 |
||
764 |
^ true |
|
765 |
! ! |
|
766 |
||
3170
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
767 |
!PositionableStream methodsFor:'reading'! |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
768 |
|
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
769 |
upToAll:aCollection |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
770 |
"read until a subcollection consisisting of the elements in aCollection |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
771 |
is encountered. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
772 |
Return everything read excluding the elements in aCollection. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
773 |
The position is left before the collection; i.e. the next |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
774 |
read operations will return those elements. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
775 |
If no such subcollection is encountered, all elements up to the end |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
776 |
are read and returned. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
777 |
Compare this with #throughAll: which also reads up to some objects |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
778 |
but positions behind it and DOES include it in the returned |
3184
d99302322139
Ok, #upToAll: positions after the collection.
Stefan Vogel <sv@exept.de>
parents:
3170
diff
changeset
|
779 |
collection. |
d99302322139
Ok, #upToAll: positions after the collection.
Stefan Vogel <sv@exept.de>
parents:
3170
diff
changeset
|
780 |
|
d99302322139
Ok, #upToAll: positions after the collection.
Stefan Vogel <sv@exept.de>
parents:
3170
diff
changeset
|
781 |
Note: this behavior is inconsistent with the other upTo.. methods, |
d99302322139
Ok, #upToAll: positions after the collection.
Stefan Vogel <sv@exept.de>
parents:
3170
diff
changeset
|
782 |
which position after the found item. We implement the method |
d99302322139
Ok, #upToAll: positions after the collection.
Stefan Vogel <sv@exept.de>
parents:
3170
diff
changeset
|
783 |
this way for the sake of ST80-compatibility." |
3170
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
784 |
|
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
785 |
|answerStream element last rslt| |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
786 |
|
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
787 |
last := aCollection last. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
788 |
answerStream := WriteStream on:(self contentsSpecies new). |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
789 |
[self atEnd] whileFalse:[ |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
790 |
element := self next. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
791 |
answerStream nextPut:element. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
792 |
element == last ifTrue:[ |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
793 |
((rslt := answerStream contents) endsWith:aCollection) ifTrue:[ |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
794 |
self position:(self position - aCollection size). |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
795 |
^ rslt copyWithoutLast:aCollection size |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
796 |
] |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
797 |
]. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
798 |
]. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
799 |
^ answerStream contents |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
800 |
|
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
801 |
" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
802 |
|s| |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
803 |
s := ReadStream on:'hello world'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
804 |
Transcript show:'<'; show:(s upToAll:'wo'); showCR:'>'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
805 |
Transcript show:'<'; show:(s upToEnd); showCR:'>'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
806 |
" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
807 |
" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
808 |
|s| |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
809 |
s := ReadStream on:'hello world'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
810 |
Transcript show:'<'; show:(s upToAll:'xx'); showCR:'>'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
811 |
Transcript showCR:s atEnd. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
812 |
Transcript show:'<'; show:(s upToEnd); showCR:'>'. |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
813 |
" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
814 |
|
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
815 |
"Modified: / 12.1.1998 / 22:06:42 / cg" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
816 |
"Created: / 12.1.1998 / 22:07:01 / cg" |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
817 |
! ! |
7b299d83c45a
moved upToAll: to positionableStream.
Claus Gittinger <cg@exept.de>
parents:
3032
diff
changeset
|
818 |
|
611 | 819 |
!PositionableStream methodsFor:'testing'! |
820 |
||
821 |
atEnd |
|
822 |
"return true, if the read-position is at the end" |
|
823 |
||
824 |
^ position > readLimit |
|
825 |
! |
|
826 |
||
827 |
isEmpty |
|
828 |
"return true, if the contents of the stream is empty" |
|
829 |
||
830 |
^ readLimit == 0 |
|
831 |
! ! |
|
832 |
||
1897 | 833 |
!PositionableStream class methodsFor:'documentation'! |
701 | 834 |
|
835 |
version |
|
3584
099a64bc9b63
support for V'Age fileIn (application stuff)
Claus Gittinger <cg@exept.de>
parents:
3580
diff
changeset
|
836 |
^ '$Header: /cvs/stx/stx/libbasic/PositionableStream.st,v 1.65 1998-06-15 19:41:00 cg Exp $' |
701 | 837 |
! ! |
611 | 838 |
PositionableStream initialize! |