"
 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)
! !