WriteStr.st
author Claus Gittinger <cg@exept.de>
Wed, 03 Apr 1996 00:14:55 +0200
changeset 1136 898af060dfde
parent 838 67a53cceaab1
child 1295 83f594f05c52
permissions -rw-r--r--
underline cleanup
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
252
claus
parents: 95
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
PositionableStream subclass:#WriteStream
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    14
	 instanceVariableNames:''
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    15
	 classVariableNames:''
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    16
	 poolDictionaries:''
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    17
	 category:'Streams'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    18
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    19
68
59faa75185ba *** empty log message ***
claus
parents: 63
diff changeset
    20
!WriteStream class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    21
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    22
copyright
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    23
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    24
 COPYRIGHT (c) 1989 by Claus Gittinger
252
claus
parents: 95
diff changeset
    25
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    26
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    27
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    28
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    30
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    31
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    32
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    33
"
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    34
!
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    35
68
59faa75185ba *** empty log message ***
claus
parents: 63
diff changeset
    36
documentation
59faa75185ba *** empty log message ***
claus
parents: 63
diff changeset
    37
"
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    38
    Streams for writing into - this implementation currently DOES change the 
261
afdf1e7184ad *** empty log message ***
claus
parents: 260
diff changeset
    39
    identity if the streamed-upon collection IF it cannot grow easily. 
afdf1e7184ad *** empty log message ***
claus
parents: 260
diff changeset
    40
    Collections which cannot grow easily are for example: Array, ByteArray and String.
88
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    41
    Thus it is slightly incompatible to ST-80 since 'aStream contents' does 
81dacba7a63a *** empty log message ***
claus
parents: 77
diff changeset
    42
    not always return the original collection. This may change.
68
59faa75185ba *** empty log message ***
claus
parents: 63
diff changeset
    43
"
345
claus
parents: 329
diff changeset
    44
! !
claus
parents: 329
diff changeset
    45
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    46
!WriteStream methodsFor:'accessing'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    47
a27a279701f8 Initial revision
claus
parents:
diff changeset
    48
contents
345
claus
parents: 329
diff changeset
    49
    "return the current contents (a collection) of the stream.
claus
parents: 329
diff changeset
    50
     Currently, this returns the actual collection if possible
claus
parents: 329
diff changeset
    51
     (and reset is implemented to create a new one) in contrast to
claus
parents: 329
diff changeset
    52
     ST80, where contents returns a copy and reset only sets the writePointer.
claus
parents: 329
diff changeset
    53
     The ST/X behavior creates less temporary garbage in the normal case
claus
parents: 329
diff changeset
    54
     (whre things are written for the contents only) but may be incompatible
claus
parents: 329
diff changeset
    55
     with some applications. Time will show, if this is to be changed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    56
260
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    57
    |lastIndex|
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    58
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    59
    lastIndex := position - 1.
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    60
    collection size == lastIndex ifFalse:[
252
claus
parents: 95
diff changeset
    61
	collection isFixedSize ifTrue:[
260
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    62
	    "
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    63
	     grow is expensive - return a copy.
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    64
	     (is this what users of writeStream expect ?
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    65
	    "
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    66
	    collection := collection copyFrom:1 to:lastIndex
252
claus
parents: 95
diff changeset
    67
	] ifFalse:[
260
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
    68
	    collection grow:lastIndex
252
claus
parents: 95
diff changeset
    69
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    70
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
    71
    ^ collection
a27a279701f8 Initial revision
claus
parents:
diff changeset
    72
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    73
329
claus
parents: 293
diff changeset
    74
reset
345
claus
parents: 329
diff changeset
    75
    "reset the stream; write anew.
claus
parents: 329
diff changeset
    76
     See the comment in WriteStream>>contnts"
329
claus
parents: 293
diff changeset
    77
claus
parents: 293
diff changeset
    78
    collection := collection species new:(collection size).
claus
parents: 293
diff changeset
    79
    super reset
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    80
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
    81
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    82
!WriteStream methodsFor:'ignored'!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    83
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    84
bold
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    85
    "change font to bold - ignored here.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    86
     - this allows WriteStreams to be compatible to PrinterStreams"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    87
!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    88
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    89
boldItalic
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    90
    "change font to italic - ignored here.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    91
     - this allows WriteStreams to be compatible to PrinterStreams"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    92
!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    93
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    94
italic
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    95
    "change font to italic - ignored here.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    96
     - this allows WriteStreams to be compatible to PrinterStreams"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    97
!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    98
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
    99
normal
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   100
    "change font to normal - ignored here.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   101
     - this allows WriteStreams to be compatible to PrinterStreams"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   102
! !
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   103
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   104
!WriteStream methodsFor:'positioning'!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   105
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   106
position:index
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   107
    "redefined to allow positioning past the readLimit"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   108
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   109
    ((index > (collection size + 1)) or:[index < 0]) ifTrue: [^ self positionError].
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   110
    position := index
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   111
! !
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   112
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   113
!WriteStream methodsFor:'private'!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   114
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   115
growCollection
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   116
    self growCollection:10
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   117
!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   118
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   119
growCollection:minNewSize
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   120
    "grow the streamed collection to at least minNewSize"
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   121
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   122
    |oldSize newSize newColl|
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   123
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   124
    oldSize := collection size.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   125
    (oldSize == 0) ifTrue:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   126
	newSize := minNewSize
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   127
    ] ifFalse:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   128
	newSize := oldSize * 2.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   129
	[newSize < minNewSize] whileTrue:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   130
	    newSize := newSize * 2
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   131
	]
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   132
    ].
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   133
    collection isFixedSize ifTrue:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   134
	newColl := collection species new:newSize.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   135
	newColl replaceFrom:1 to:oldSize with:collection startingAt:1.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   136
	collection := newColl
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   137
    ] ifFalse:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   138
	collection grow:newSize
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   139
    ].
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   140
! !
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   141
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   142
!WriteStream methodsFor:'private accessing'!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   143
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   144
on:aCollection from:start to:last
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   145
    "create and return a new stream for writing onto aCollection, where
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   146
     writing is limited to the elements in the range start to last."
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   147
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   148
    super on:aCollection from:start to:last.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   149
    writeLimit := last.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   150
! !
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   151
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   152
!WriteStream methodsFor:'queries'!
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   153
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   154
isWritable
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   155
    ^ true
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   156
! !
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   157
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   158
!WriteStream methodsFor:'reading'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   159
a27a279701f8 Initial revision
claus
parents:
diff changeset
   160
next
10
claus
parents: 5
diff changeset
   161
    "catch read access to write stream - report an error"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   162
10
claus
parents: 5
diff changeset
   163
    self shouldNotImplement
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   164
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   165
a27a279701f8 Initial revision
claus
parents:
diff changeset
   166
peek
10
claus
parents: 5
diff changeset
   167
    "catch read access to write stream - report an error"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   168
10
claus
parents: 5
diff changeset
   169
    self shouldNotImplement
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   170
! !
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   171
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   172
!WriteStream methodsFor:'writing'!
369
claus
parents: 359
diff changeset
   173
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   174
next:count put:anObject
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   175
    "append anObject count times to the receiver.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   176
     Redefined to avoid count grows of the underlying collection -
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   177
     instead a single grow on the final size is performed."
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   178
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   179
    |final|
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   180
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   181
    (collection isNil or:[writeLimit notNil]) ifTrue:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   182
	^ super next:count put:anObject
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   183
    ].
369
claus
parents: 359
diff changeset
   184
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   185
    final := position + count - 1.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   186
    (final > collection size) ifTrue:[
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   187
	self growCollection:final
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   188
    ].
369
claus
parents: 359
diff changeset
   189
611
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   190
    position to:final do:[:index |
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   191
	collection at:index put:anObject.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   192
    ].
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   193
    position := position + count.
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   194
    (position > readLimit) ifTrue:[readLimit := position - 1].
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   195
    ^ anObject
80bb0f1a7bab checkin from browser
Claus Gittinger <cg@exept.de>
parents: 530
diff changeset
   196
!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   197
a27a279701f8 Initial revision
claus
parents:
diff changeset
   198
nextPut:anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   199
    "append the argument, anObject to the stream"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   200
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   201
%{  /* NOCONTEXT */
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   202
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   203
    REGISTER int pos;
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   204
    unsigned ch;
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   205
    OBJ coll;
252
claus
parents: 95
diff changeset
   206
    OBJ p, l;
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   207
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   208
    coll = __INST(collection);
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   209
    p = __INST(position);
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   210
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   211
    if (__isNonNilObject(coll) && __isSmallInteger(p)) {
68
59faa75185ba *** empty log message ***
claus
parents: 63
diff changeset
   212
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   213
	pos = __intVal(p);
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   214
	l = __INST(writeLimit);
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   215
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   216
	if ((l == nil)
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   217
	 || (__isSmallInteger(l) && (pos <= __intVal(l)))) {
252
claus
parents: 95
diff changeset
   218
	    OBJ cls;
claus
parents: 95
diff changeset
   219
329
claus
parents: 293
diff changeset
   220
	    cls = __qClass(coll);
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   221
838
67a53cceaab1 no global refs
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   222
	    if (cls == @global(String)) {
252
claus
parents: 95
diff changeset
   223
		if (__isCharacter(anObject) 
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   224
		 && (pos <= __stringSize(coll))) {
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   225
		    ch = __intVal(_characterVal(anObject));
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   226
		    if ((ch >= 0) && (ch <= 255)) {
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   227
			__StringInstPtr(coll)->s_element[pos-1] = ch;
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   228
			__INST(position) = __MKSMALLINT(pos + 1);
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   229
			if (__isSmallInteger(__INST(readLimit))
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   230
			 && (pos >= __intVal(__INST(readLimit)))) {
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   231
			    __INST(readLimit) = __MKSMALLINT(pos);
329
claus
parents: 293
diff changeset
   232
			}
claus
parents: 293
diff changeset
   233
			RETURN ( anObject );
252
claus
parents: 95
diff changeset
   234
		    }
claus
parents: 95
diff changeset
   235
		}
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   236
	    } else {
838
67a53cceaab1 no global refs
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   237
		if (cls == @global(ByteArray)) {
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   238
		    if (__isSmallInteger(anObject) 
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   239
		     && ((ch = __intVal(anObject)) >= 0)
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   240
		     && (ch <= 255)
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   241
		     && (pos <= _byteArraySize(coll))) {
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   242
			__ByteArrayInstPtr(coll)->ba_element[pos-1] = ch;
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   243
			__INST(position) = __MKSMALLINT(pos + 1);
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   244
			if (__isSmallInteger(__INST(readLimit))
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   245
			 && (pos >= __intVal(__INST(readLimit)))) {
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   246
			    __INST(readLimit) = __MKSMALLINT(pos);
329
claus
parents: 293
diff changeset
   247
			}
claus
parents: 293
diff changeset
   248
			RETURN ( anObject );
252
claus
parents: 95
diff changeset
   249
		    }
329
claus
parents: 293
diff changeset
   250
		} else {
838
67a53cceaab1 no global refs
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   251
		    if (cls == @global(Array)) {
329
claus
parents: 293
diff changeset
   252
			if (pos <= _arraySize(coll)) {
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   253
			     __ArrayInstPtr(coll)->a_element[pos-1] = anObject;
329
claus
parents: 293
diff changeset
   254
			    __STORE(coll, anObject);
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   255
			    __INST(position) = __MKSMALLINT(pos + 1);
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   256
			    if (__isSmallInteger(__INST(readLimit))
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   257
			     && (pos >= __intVal(__INST(readLimit)))) {
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   258
				__INST(readLimit) = __MKSMALLINT(pos);
329
claus
parents: 293
diff changeset
   259
			    }
claus
parents: 293
diff changeset
   260
			    RETURN ( anObject );
claus
parents: 293
diff changeset
   261
			}
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   262
		    }
252
claus
parents: 95
diff changeset
   263
		}
claus
parents: 95
diff changeset
   264
	    }
claus
parents: 95
diff changeset
   265
	}
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   266
    }
260
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
   267
%}.
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   268
    (writeLimit isNil
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   269
    or:[position <= writeLimit]) ifTrue:[
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   270
	(position > collection size) ifTrue:[self growCollection].
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   271
	collection at:position put:anObject.
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   272
	(position > readLimit) ifTrue:[readLimit := position].
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   273
	position := position + 1.
838
67a53cceaab1 no global refs
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   274
    ] ifFalse:[
67a53cceaab1 no global refs
Claus Gittinger <cg@exept.de>
parents: 701
diff changeset
   275
	WriteErrorSignal raiseErrorString:'write behond writeLimit'
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   276
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   277
    ^anObject
a27a279701f8 Initial revision
claus
parents:
diff changeset
   278
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   279
a27a279701f8 Initial revision
claus
parents:
diff changeset
   280
nextPutAll:aCollection
63
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   281
    "append all elements of the argument, aCollection to the stream.
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   282
     Redefined to avoid count grows of the underlying collection -
1f0cdefb013f *** empty log message ***
claus
parents: 10
diff changeset
   283
     instead a single grow on the final size is performed."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   284
a27a279701f8 Initial revision
claus
parents:
diff changeset
   285
    |nMore final|
a27a279701f8 Initial revision
claus
parents:
diff changeset
   286
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   287
    collection isNil ifTrue:[
260
cefb485445a7 *** empty log message ***
claus
parents: 252
diff changeset
   288
	^ super nextPutAll:aCollection
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   289
    ].
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
   290
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   291
    nMore := aCollection size.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   292
    final := position + nMore - 1.
293
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   293
    (writeLimit notNil
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   294
    and:[final > writeLimit]) ifTrue:[
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   295
	final := writeLimit.
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   296
	nMore := final - position + 1
31df3850e98c *** empty log message ***
claus
parents: 261
diff changeset
   297
    ].
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   298
    (final > collection size) ifTrue:[
252
claus
parents: 95
diff changeset
   299
	self growCollection:final
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   300
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   301
    collection replaceFrom:position
252
claus
parents: 95
diff changeset
   302
			to:final
claus
parents: 95
diff changeset
   303
		      with:aCollection 
claus
parents: 95
diff changeset
   304
		startingAt:1.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   305
a27a279701f8 Initial revision
claus
parents:
diff changeset
   306
    position := position + nMore.
a27a279701f8 Initial revision
claus
parents:
diff changeset
   307
    (position > readLimit) ifTrue:[readLimit := position - 1].
a27a279701f8 Initial revision
claus
parents:
diff changeset
   308
    ^ aCollection
a27a279701f8 Initial revision
claus
parents:
diff changeset
   309
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   310
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 611
diff changeset
   311
!WriteStream class methodsFor:'documentation'!
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 611
diff changeset
   312
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 611
diff changeset
   313
version
1136
898af060dfde underline cleanup
Claus Gittinger <cg@exept.de>
parents: 838
diff changeset
   314
    ^ '$Header: /cvs/stx/stx/libbasic/Attic/WriteStr.st,v 1.25 1996-04-02 22:14:55 cg Exp $'
701
a309e3ef7faf checkin from browser
Claus Gittinger <cg@exept.de>
parents: 611
diff changeset
   315
! !