--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TextColl.st Fri Jul 16 11:44:44 1993 +0200
@@ -0,0 +1,255 @@
+"
+ COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+EditTextView subclass:#TextCollector
+ instanceVariableNames:'entryStream lineLimit destroyAction
+ outstandingLines outstandingLine
+ flushBlock flushPending collecting'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Text'
+!
+
+TextCollector comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+a view for editable text, which also understands some stream messages.
+Instances of this view can take the place of a stream and display the received
+text; it is used especially for Transcript.
+
+%W% %E%
+written winter-89 by claus
+'!
+
+!TextCollector class methodsFor:'defaults'!
+
+defaultLineLimit
+ ^ nil
+! !
+
+!TextCollector class methodsFor:'instance creation'!
+
+newTranscript
+ |topView transcript f v|
+
+ Display initialize.
+ topView := StandardSystemView label:'Transcript'
+ minExtent:(100 @ 100).
+
+ v := ScrollableView for:self in:topView.
+ v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+ transcript := v scrolledView.
+ transcript lineLimit:600.
+ transcript collect:true.
+ "transcript partialLines:false."
+
+ f := transcript font.
+ topView extent:(((f widthOf:'x') * 70) @ (f height * 10)).
+
+ Smalltalk at:#Transcript put:transcript.
+
+ "fancy feature: whenever Transcript is closed, reset to StdError"
+ transcript destroyAction:[Smalltalk at:#Transcript put:Stderr].
+
+ topView realize.
+ ^ transcript
+! !
+
+!TextCollector methodsFor:'initialize / release'!
+
+initialize
+ super initialize.
+
+ outstandingLines := OrderedCollection new.
+ flushBlock := [self endEntry].
+ flushPending := false.
+ collecting := false.
+
+ lineLimit := self class defaultLineLimit.
+ entryStream := ActorStream new.
+ entryStream nextPutBlock:[:something | self nextPut:something].
+ entryStream nextPutAllBlock:[:something | self nextPutAll:something]
+!
+
+destroy
+ destroyAction notNil ifTrue:[
+ destroyAction value
+ ].
+ flushBlock notNil ifTrue:[
+ device removeTimedBlock:flushBlock
+ ].
+ super destroy
+! !
+
+!TextCollector methodsFor:'accessing'!
+
+collect:aBoolean
+ "turn on collecting - i.e. do not output immediately
+ but collect text and output en-bloque after some time
+ delta"
+
+ collecting := aBoolean
+!
+
+lineLimit:aNumber
+ "define the number of text-lines I am supposed to hold"
+
+ lineLimit := aNumber
+!
+
+destroyAction:aBlock
+ "define the action to be performed when I get destroyed"
+
+ destroyAction := aBlock
+!
+
+endEntry
+ "flush collected output"
+
+ |nLines|
+
+ "insert the bunch of lines - if any"
+ nLines := outstandingLines size.
+ (nLines ~~ 0) ifTrue:[
+ outstandingLines do:[:line |
+ self insertStringAtCursor:line.
+ self insertCharAtCursor:(Character cr)
+ ].
+"
+ self insertLines:outstandingLines withCr:true.
+"
+ self withCursorOffDo:[
+ (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
+ self scrollDown:nLines
+ ]
+ ].
+ outstandingLines grow:0
+ ].
+ "and the last partial line - if any"
+ outstandingLine notNil ifTrue:[
+ flushPending := false.
+ self nextPut:outstandingLine.
+ outstandingLine := nil
+ ].
+ device removeTimedBlock:flushBlock.
+ flushPending := false
+! !
+
+!TextCollector methodsFor:'private'!
+
+checkLineLimit
+ "this method checks if the text has become too large (> lineLimit)
+ and cuts off some lines at the top if so; it must be called whenever lines
+ have been added to the bottom"
+
+ |nDel|
+
+ lineLimit notNil ifTrue:[
+ (cursorLine > lineLimit) ifTrue:[
+ nDel := list size - lineLimit.
+ list removeFromIndex:1 toIndex:nDel.
+ cursorLine := cursorLine - nDel.
+ firstLineShown := firstLineShown - nDel.
+ (firstLineShown < 1) ifTrue:[
+ cursorLine := cursorLine - firstLineShown + 1.
+ firstLineShown := 1
+ ].
+ self contentsChanged
+ ]
+ ]
+! !
+
+!TextCollector methodsFor:'stream messages'!
+
+lineLength
+ ^ width // (font width)
+!
+
+nextPut:something
+ "this allows TextCollectors to be used Stream-wise"
+
+ flushPending ifTrue:[
+ self endEntry
+ ].
+ (something isMemberOf:Character) ifTrue:[
+ ((something == Character cr) or:[something == Character nl]) ifTrue:[
+ ^ self cr
+ ].
+ self insertCharAtCursor:something
+ ] ifFalse:[
+ self insertStringAtCursor:(something printString).
+ self checkLineLimit
+ ].
+ device synchronizeOutput
+!
+
+nextPutAll:something
+ "this allows TextCollectors to be used Stream-wise"
+
+ ^ self nextPut:something
+!
+
+cr
+ collecting ifTrue:[
+ outstandingLines add:outstandingLine.
+ outstandingLine := nil.
+ flushPending ifFalse:[
+ device addTimedBlock:flushBlock after:0.2.
+ flushPending := true
+ ] ifTrue:[
+ device evaluateTimeOutBlocks
+ ]
+ ] ifFalse:[
+ self cursorReturn.
+ self checkLineLimit
+ ]
+!
+
+show:anObject
+ "insert the argument aString at current cursor position"
+
+ |aString|
+
+ aString := anObject printString.
+ collecting ifTrue:[
+ outstandingLine notNil ifTrue:[
+ outstandingLine := outstandingLine , aString
+ ] ifFalse:[
+ outstandingLine := aString
+ ].
+ flushPending ifFalse:[
+ device addTimedBlock:flushBlock after:0.2.
+ flushPending := true
+ ]
+ ] ifFalse:[
+ self nextPut:aString
+ ]
+!
+
+showCr:aString
+ "insert the argument aString followed by a newline
+ at current cursor position"
+
+ self show:aString.
+ self cr
+!
+
+doesNotUnderstand:aMessage
+ "this is funny: all message we do not understand, are passed
+ on to the stream which will send the characters via nextPut:
+ This way, we understand all Stream messages - great isn't it !!
+ "
+ ^ entryStream perform:(aMessage selector)
+ withArguments:(aMessage arguments)
+! !