|
1 " |
|
2 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 EditTextView subclass:#TextCollector |
|
14 instanceVariableNames:'entryStream lineLimit destroyAction |
|
15 outstandingLines outstandingLine |
|
16 flushBlock flushPending collecting' |
|
17 classVariableNames:'' |
|
18 poolDictionaries:'' |
|
19 category:'Views-Text' |
|
20 ! |
|
21 |
|
22 TextCollector comment:' |
|
23 |
|
24 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
25 All Rights Reserved |
|
26 |
|
27 a view for editable text, which also understands some stream messages. |
|
28 Instances of this view can take the place of a stream and display the received |
|
29 text; it is used especially for Transcript. |
|
30 |
|
31 %W% %E% |
|
32 written winter-89 by claus |
|
33 '! |
|
34 |
|
35 !TextCollector class methodsFor:'defaults'! |
|
36 |
|
37 defaultLineLimit |
|
38 ^ nil |
|
39 ! ! |
|
40 |
|
41 !TextCollector class methodsFor:'instance creation'! |
|
42 |
|
43 newTranscript |
|
44 |topView transcript f v| |
|
45 |
|
46 Display initialize. |
|
47 topView := StandardSystemView label:'Transcript' |
|
48 minExtent:(100 @ 100). |
|
49 |
|
50 v := ScrollableView for:self in:topView. |
|
51 v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0). |
|
52 transcript := v scrolledView. |
|
53 transcript lineLimit:600. |
|
54 transcript collect:true. |
|
55 "transcript partialLines:false." |
|
56 |
|
57 f := transcript font. |
|
58 topView extent:(((f widthOf:'x') * 70) @ (f height * 10)). |
|
59 |
|
60 Smalltalk at:#Transcript put:transcript. |
|
61 |
|
62 "fancy feature: whenever Transcript is closed, reset to StdError" |
|
63 transcript destroyAction:[Smalltalk at:#Transcript put:Stderr]. |
|
64 |
|
65 topView realize. |
|
66 ^ transcript |
|
67 ! ! |
|
68 |
|
69 !TextCollector methodsFor:'initialize / release'! |
|
70 |
|
71 initialize |
|
72 super initialize. |
|
73 |
|
74 outstandingLines := OrderedCollection new. |
|
75 flushBlock := [self endEntry]. |
|
76 flushPending := false. |
|
77 collecting := false. |
|
78 |
|
79 lineLimit := self class defaultLineLimit. |
|
80 entryStream := ActorStream new. |
|
81 entryStream nextPutBlock:[:something | self nextPut:something]. |
|
82 entryStream nextPutAllBlock:[:something | self nextPutAll:something] |
|
83 ! |
|
84 |
|
85 destroy |
|
86 destroyAction notNil ifTrue:[ |
|
87 destroyAction value |
|
88 ]. |
|
89 flushBlock notNil ifTrue:[ |
|
90 device removeTimedBlock:flushBlock |
|
91 ]. |
|
92 super destroy |
|
93 ! ! |
|
94 |
|
95 !TextCollector methodsFor:'accessing'! |
|
96 |
|
97 collect:aBoolean |
|
98 "turn on collecting - i.e. do not output immediately |
|
99 but collect text and output en-bloque after some time |
|
100 delta" |
|
101 |
|
102 collecting := aBoolean |
|
103 ! |
|
104 |
|
105 lineLimit:aNumber |
|
106 "define the number of text-lines I am supposed to hold" |
|
107 |
|
108 lineLimit := aNumber |
|
109 ! |
|
110 |
|
111 destroyAction:aBlock |
|
112 "define the action to be performed when I get destroyed" |
|
113 |
|
114 destroyAction := aBlock |
|
115 ! |
|
116 |
|
117 endEntry |
|
118 "flush collected output" |
|
119 |
|
120 |nLines| |
|
121 |
|
122 "insert the bunch of lines - if any" |
|
123 nLines := outstandingLines size. |
|
124 (nLines ~~ 0) ifTrue:[ |
|
125 outstandingLines do:[:line | |
|
126 self insertStringAtCursor:line. |
|
127 self insertCharAtCursor:(Character cr) |
|
128 ]. |
|
129 " |
|
130 self insertLines:outstandingLines withCr:true. |
|
131 " |
|
132 self withCursorOffDo:[ |
|
133 (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[ |
|
134 self scrollDown:nLines |
|
135 ] |
|
136 ]. |
|
137 outstandingLines grow:0 |
|
138 ]. |
|
139 "and the last partial line - if any" |
|
140 outstandingLine notNil ifTrue:[ |
|
141 flushPending := false. |
|
142 self nextPut:outstandingLine. |
|
143 outstandingLine := nil |
|
144 ]. |
|
145 device removeTimedBlock:flushBlock. |
|
146 flushPending := false |
|
147 ! ! |
|
148 |
|
149 !TextCollector methodsFor:'private'! |
|
150 |
|
151 checkLineLimit |
|
152 "this method checks if the text has become too large (> lineLimit) |
|
153 and cuts off some lines at the top if so; it must be called whenever lines |
|
154 have been added to the bottom" |
|
155 |
|
156 |nDel| |
|
157 |
|
158 lineLimit notNil ifTrue:[ |
|
159 (cursorLine > lineLimit) ifTrue:[ |
|
160 nDel := list size - lineLimit. |
|
161 list removeFromIndex:1 toIndex:nDel. |
|
162 cursorLine := cursorLine - nDel. |
|
163 firstLineShown := firstLineShown - nDel. |
|
164 (firstLineShown < 1) ifTrue:[ |
|
165 cursorLine := cursorLine - firstLineShown + 1. |
|
166 firstLineShown := 1 |
|
167 ]. |
|
168 self contentsChanged |
|
169 ] |
|
170 ] |
|
171 ! ! |
|
172 |
|
173 !TextCollector methodsFor:'stream messages'! |
|
174 |
|
175 lineLength |
|
176 ^ width // (font width) |
|
177 ! |
|
178 |
|
179 nextPut:something |
|
180 "this allows TextCollectors to be used Stream-wise" |
|
181 |
|
182 flushPending ifTrue:[ |
|
183 self endEntry |
|
184 ]. |
|
185 (something isMemberOf:Character) ifTrue:[ |
|
186 ((something == Character cr) or:[something == Character nl]) ifTrue:[ |
|
187 ^ self cr |
|
188 ]. |
|
189 self insertCharAtCursor:something |
|
190 ] ifFalse:[ |
|
191 self insertStringAtCursor:(something printString). |
|
192 self checkLineLimit |
|
193 ]. |
|
194 device synchronizeOutput |
|
195 ! |
|
196 |
|
197 nextPutAll:something |
|
198 "this allows TextCollectors to be used Stream-wise" |
|
199 |
|
200 ^ self nextPut:something |
|
201 ! |
|
202 |
|
203 cr |
|
204 collecting ifTrue:[ |
|
205 outstandingLines add:outstandingLine. |
|
206 outstandingLine := nil. |
|
207 flushPending ifFalse:[ |
|
208 device addTimedBlock:flushBlock after:0.2. |
|
209 flushPending := true |
|
210 ] ifTrue:[ |
|
211 device evaluateTimeOutBlocks |
|
212 ] |
|
213 ] ifFalse:[ |
|
214 self cursorReturn. |
|
215 self checkLineLimit |
|
216 ] |
|
217 ! |
|
218 |
|
219 show:anObject |
|
220 "insert the argument aString at current cursor position" |
|
221 |
|
222 |aString| |
|
223 |
|
224 aString := anObject printString. |
|
225 collecting ifTrue:[ |
|
226 outstandingLine notNil ifTrue:[ |
|
227 outstandingLine := outstandingLine , aString |
|
228 ] ifFalse:[ |
|
229 outstandingLine := aString |
|
230 ]. |
|
231 flushPending ifFalse:[ |
|
232 device addTimedBlock:flushBlock after:0.2. |
|
233 flushPending := true |
|
234 ] |
|
235 ] ifFalse:[ |
|
236 self nextPut:aString |
|
237 ] |
|
238 ! |
|
239 |
|
240 showCr:aString |
|
241 "insert the argument aString followed by a newline |
|
242 at current cursor position" |
|
243 |
|
244 self show:aString. |
|
245 self cr |
|
246 ! |
|
247 |
|
248 doesNotUnderstand:aMessage |
|
249 "this is funny: all message we do not understand, are passed |
|
250 on to the stream which will send the characters via nextPut: |
|
251 This way, we understand all Stream messages - great isn't it !! |
|
252 " |
|
253 ^ entryStream perform:(aMessage selector) |
|
254 withArguments:(aMessage arguments) |
|
255 ! ! |