"

 COPYRIGHT (c) 1989 by Claus Gittinger

 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

       classVariableNames:''

       poolDictionaries:''

       category:'Views-Text'

!

TextCollector comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

'!

!TextCollector class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

 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.

"

!

version

"

"

!

documentation

"

    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.

    Its main use in the system is the Transcript, but it can also be used for

    things like trace-windows etc.

    If collecting is turned on, a Textcollector will not immediately display 

    entered text, but wait for some short time (timeDelay) and collect incoming 

    data - finally updating the whole chunk in one piece. 

    This helps slow display devices, which would otherwise scroll a lot. 

    (on fast displays this is less of a problem).

    The total number of lines kept is controlled by lineLimit, if more lines are 

    entered at the bottom, the textcollector will forget lines at the top. 

    Linelimit can also be set to nil (i.e. no limit), but you may need a lot 

    of memory then ...

"

! !

!TextCollector class methodsFor:'defaults'!

defaultLineLimit

    "the number of lines remembered by default"

    ^ 600

! 

defaultTimeDelay

    "the time in seconds to wait & collect by default"

    ^ 0.3 

! !

!TextCollector class methodsFor:'instance creation'!

newTranscript

    topView := StandardSystemView label:'Transcript' minExtent:(100 @ 100).

    topView icon:(Form fromFile:'SmalltalkX.xbm').

    v := ScrollableView for:self in:topView.

    v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).

    transcript := v scrolledView.

    "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 open.

    "transcript lineLimit:1000. " "or whatever you think makes sense"

    ^ transcript

! !

!TextCollector methodsFor:'initialize / release'!

initialize

    super initialize.

    outstandingLines := OrderedCollection new.

    flushBlock := [self endEntry].

    flushPending := false.

    collecting := true.

    timeDelay := self class defaultTimeDelay.

    access := Semaphore forMutualExclusion.

    lineLimit := self class defaultLineLimit.

    entryStream := ActorStream new.

    entryStream nextPutBlock:[:something | self nextPut:something].

    entryStream nextPutAllBlock:[:something | self nextPutAll:something]

!

reinitialize

    "recreate access-semaphore; image could have been save (theoretically)

     with the semaphore locked - int this case, we had a deadlock"

    flushPending := false.

    access := Semaphore forMutualExclusion.

    super reinitialize.

!

mapped

    "view became visible - show collected lines (if any)"

    super mapped.

    self endEntry

!

destroy

    destroyAction notNil ifTrue:[

    ].

    Processor removeTimedBlock:flushBlock.

    flushBlock := nil.

    outstandingLines := OrderedCollection new.

    outstandingLine := ''.

    super destroy

! !

!TextCollector methodsFor:'accessing'!

collect:aBoolean

    "turn on/off collecting - if on, 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.

     This is a special feature, to allow resetting Transcript to Stderr

     when closed. (see TextCollectorclass>>newTranscript)"

    destroyAction := aBlock

!

endEntry

    "flush collected output"

    |nLines lines|

    shown ifFalse:[^ self].

    Processor removeTimedBlock:flushBlock.

    access critical:[

    ]

! !

!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:[

    ]

!

installDelayedUpdate

    "arrange for collecting input for some time,

     and output all buffered strings at once after a while.

     This makes output to the transcript much faster on systems

     with poor scrolling performance (i.e. dump vga cards ...)."

    |wg p|

    flushPending ifFalse:[

    ]

! !

!TextCollector methodsFor:'stream messages'!

lineLength

    ^ width // (font width)

!

nextPut:something

    "this allows TextCollectors to be used Stream-wise"

    flushPending ifTrue:[

    ].

    (something isMemberOf:Character) ifTrue:[

    ] ifFalse:[

    ].

    device synchronizeOutput

!

nextPutAll:something

    "this allows TextCollectors to be used Stream-wise"

    ^ self nextPut:something

!

cr

    "output a carriage return, finishing the current line"

    |wasBlocked|

    collecting ifTrue:[

    ] ifFalse:[

    ]

!

show:anObject

    "insert the argument aString at current cursor position"

    |aString wasBlocked|

    aString := anObject printString.

    collecting ifTrue:[

    ] ifFalse:[

    ]

!

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)

! !