"
 COPYRIGHT (c) 1989 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 inFlush collecting
		timeDelay access'
	classVariableNames:''
	poolDictionaries:''
	category:'Views-Text'
!

!TextCollector class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 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.
"
!

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, errorLogs 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 
    than this limit are added at the bottom, the textcollector will forget lines 
    at the top. 
    You can set linelimit to nil (i.e. no limit), but you may need a lot 
    of memory then ...

    [StyleSheet paramters (transcript only):]

        transcriptForegroundColor       defaults to textForegroundColor
        transcriptBackgroundColor'      defaults to textBackgroundColor.

        transcriptCursorForegroundColor
        transcriptCursorBackgroundColor

    [author:]
        Claus Gittinger

    [see also:]
        CodeView EditTextView
        ActorStream
"
! !

!TextCollector class methodsFor:'instance creation'!

newTranscript
    "create and open a new transcript.
     This is a leftOver method from times were the Launcher & Transcript
     were two different views. It is no longer recommended."

    |topView transcript f v lines cols|

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

    v := HVScrollableView for:self miniScrollerH:true miniScrollerV:false in:topView.
    v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
    transcript := v scrolledView.
    "transcript partialLines:false."

    f := transcript font.

    "
     should add the height of the frame & scrollbars to be exact ...
    "
    cols := self defaultTranscriptSize x.
    lines := self defaultTranscriptSize y.
    topView extent:(((f widthOf:'x') * cols) @ (f height * lines)).

    transcript beTranscript.

    "
     run it at a slightly higher prio, to allow for
     delayed buffered updates to be performed
    "
    topView openWithPriority:(Processor userSchedulingPriority + 1).

    ^ transcript

    "
     TextCollector newTranscript.
     Transcript lineLimit:3000.
    "

    "Modified: 17.2.1997 / 18:20:27 / cg"
! !

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

defaultTranscriptSize
    "the number of cols/lines by which the Transcript should come up"

    ^ 70@11
! !

!TextCollector methodsFor:'accessing'!

beginEntry
    "noop for now, ST80 compatibility"

    ^ self

    "Created: / 4.3.1998 / 11:08:14 / stefan"
!

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
!

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; displaying all that has been buffered so far"

    |nLines lines|

    shown ifFalse:[
        flushPending ifFalse:[
            self installDelayedUpdate.
        ].
        ^ self
    ].
    inFlush ifTrue:[^ self].

    Processor removeTimedBlock:flushBlock.
    flushPending ifFalse:[^ self].

    access critical:[
        inFlush := true.
        flushPending := false.
        outstandingLines size ~~ 0 ifTrue:[
            "insert the bunch of lines - if any"
            lines := outstandingLines.
            outstandingLines := nil.

            nLines := lines size.
            (nLines ~~ 0) ifTrue:[
                self insertLines:lines withCR:true.
                self cursorToEnd.
                self withCursorOffDo:[
                    (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
                        self scrollDown:nLines
                    ]
                ].
            ].
        ].

        "and the last partial line - if any"
        outstandingLine size > 0 ifTrue:[
            self insertStringAtCursor:outstandingLine.
            outstandingLine := ''.
        ].
        self checkLineLimit.
        inFlush := false.
        device flush.
    ].
    flushPending ifTrue:[
        flushPending := false.
        self installDelayedUpdate
    ]

    "Modified: 11.1.1997 / 14:41:32 / cg"
!

lineLimit:aNumber
    "define the number of text-lines I am supposed to hold"

    lineLimit := aNumber
! !

!TextCollector methodsFor:'change & update'!

getListFromModel
    "a textCollector always scrolls to the bottom"

     super getListFromModel.
     self scrollToBottom

    "Created: 12.2.1996 / 14:27:56 / stefan"
    "Modified: 11.1.1997 / 14:41:50 / cg"
! !

!TextCollector methodsFor:'events'!

exposeX:x y:y width:w height:h
    "flush buffered text when exposed"

    super exposeX:x y:y width:w height:h.
    self endEntry
! !

!TextCollector methodsFor:'initialize / release'!

destroy
    "destroy this view"

    destroyAction notNil ifTrue:[
        destroyAction value
    ].
    Processor removeTimedBlock:flushBlock.
    flushBlock := nil.
    outstandingLines := nil.
    outstandingLine := ''.

    super destroy

    "Modified: 11.1.1997 / 14:40:30 / cg"
!

editMenu
    "return my popUpMenu; thats the superClasses menu,
     minus any accept item."

    <resource: #programMenu>

    |m idx|

    m := super editMenu.

    "
     textcollectors do not support #accept
     remove it from the menu (and the preceeding separating line)
    "
    idx := m indexOf:#accept.
    idx ~~ 0 ifTrue:[
        m remove:idx.
        (m labels at:(idx - 1)) = '-' ifTrue:[
            m remove:idx - 1
        ].
    ].
    ^ m

    "Modified: 3.7.1997 / 13:54:11 / cg"
!

initialize
    super initialize.

    outstandingLines := nil.

    flushBlock := [self endEntry].
    flushPending := inFlush := false.
    collecting := true.
    timeDelay := self class defaultTimeDelay.
    access := RecursionLock new. "/ Semaphore forMutualExclusion.

    lineLimit := self class defaultLineLimit.
    entryStream := ActorStream new.
    entryStream nextPutBlock:[:something | self nextPut:something].
    entryStream nextPutAllBlock:[:something | self nextPutAll:something]

    "Modified: 11.1.1997 / 14:35:32 / cg"
!

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

    super mapped.
    self endEntry
!

reinitialize
    "recreate access-semaphore; image could have been save (theoretically)
     with the semaphore locked - in this case, we had a deadlock"

    flushPending := false.
    access := RecursionLock new. "/ Semaphore forMutualExclusion.
    super reinitialize.

    "Modified: / 5.3.1998 / 10:09:14 / stefan"
! !

!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
	]
    ]
!

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. dumb vga cards ...)."

    |p|

    flushPending ifFalse:[
        flushPending := true.
        inFlush ifFalse:[
            "
             we could run under a process, which dies in the meantime;
             therefore, we have to arrange for the transcript process to
             be interrupted and do the update.
            "
            windowGroup isNil ifTrue:[
                p := Processor activeProcess
            ] ifFalse:[
                p := windowGroup process
            ].
            (p isNil or:[p isSystemProcess]) ifTrue:[
                self endEntry
            ] ifFalse:[
                Processor addTimedBlock:flushBlock for:p afterSeconds:timeDelay.
            ]
        ]
    ]

    "Modified: 17.9.1996 / 00:11:53 / cg"
    "Modified: 17.4.1997 / 13:03:15 / stefan"
! !

!TextCollector methodsFor:'queries'!

current
    "return the current (your screens) transcript.
     In multiDisplay applications, this need NOT be the main transcript.
     But typically, this is the same as Transcript."

    ^ self topView application class current transcript

    "
     Transcript current flash
    "

    "Created: 5.7.1996 / 14:14:34 / cg"
    "Modified: 5.7.1996 / 14:14:52 / cg"
! !

!TextCollector methodsFor:'stream messages'!

cr
    "output a carriage return, finishing the current line"

    access critical:[
        collecting ifTrue:[
            outstandingLine notNil ifTrue:[  "/ mhmh - is never nil
                outstandingLines isNil ifTrue:[
                    outstandingLines := OrderedCollection with:outstandingLine
                ] ifFalse:[
                    outstandingLines add:outstandingLine.
                ]
            ].
            outstandingLine := ''.
        ] ifFalse:[
            self cursorReturn.
            self checkLineLimit.
            self cursorToEnd.
        ].
    ].

    collecting ifTrue:[
        flushPending ifFalse:[
            self installDelayedUpdate
        ]
    ]

    "Modified: 11.1.1997 / 14:39:00 / cg"
!

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

lineLength
    "to make a textCollector (somewhat) compatible with printer
     streams, support the lineLength query"

    ^ width // (font width)

    "Modified: 11.1.1997 / 14:42:41 / cg"
!

nextPut:something
    "append somethings printString to my displayed text.
     This allows TextCollectors to be used Stream-wise"

    (something isCharacter) ifTrue:[
        ((something == Character cr) or:[something == Character nl]) ifTrue:[
            ^ self cr
        ].
    ].
    self show:(something asString).

"/    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 flush

    "Modified: 11.1.1997 / 14:43:05 / cg"
!

nextPutAll:something
    "append all of something to my displayed text.
     This allows TextCollectors to be used Stream-wise"

    ^ self show:something

    "Modified: 11.1.1997 / 14:43:26 / cg"
!

show:anObject
    "insert the argument aString at current cursor position"

    |aString lines|

    aString := anObject printString.

    (aString includes:(Character cr)) ifTrue:[
        lines := aString asStringCollection.
        lines keysAndValuesDo:[:nr :line |
            nr == lines size ifTrue:[
                "/ the last one.
                self show:line
            ] ifFalse:[
                self showCR:line
            ].
        ].
        ^ self.
    ].

    access critical:[
        outstandingLine size > 0 ifTrue:[
            outstandingLine := outstandingLine , aString
        ] ifFalse:[
            outstandingLine := aString
        ].
        collecting ifTrue:[
            flushPending ifFalse:[
                self installDelayedUpdate
            ] ifTrue:[
                outstandingLines size > 50 ifTrue:[
                    self endEntry
                ]
            ]
        ] ifFalse:[
            self endEntry
        ]
    ].

    "Modified: 31.8.1997 / 08:53:20 / cg"
! !

!TextCollector methodsFor:'transcript specials'!

beTranscript
    "make the receiver be the systemTranscript; this one
     is accessable via the global Transcript and gets relevant
     system messages from various places."

    |fg bg cFg cBg|

    Smalltalk at:#Transcript put:self.

    "
     fancy feature: whenever Transcript is closed, reset to StdError
    "
    self destroyAction:[
        self == (Smalltalk at:#Transcript) ifTrue:[
            Smalltalk at:#Transcript put:Stderr
        ]
    ].

    "/ user may prefer a special color for this one;
    "/ look into the style definitions ...

    fg := styleSheet colorAt:'transcript.foregroundColor' default:self foregroundColor.
    bg := styleSheet colorAt:'transcript.backgroundColor' default:self backgroundColor.
    self foregroundColor:fg backgroundColor:bg.
    self viewBackground:bg.

    cFg := styleSheet colorAt:'transcript.cursorForegroundColor' default:bg.
    cBg := styleSheet colorAt:'transcript.cursorBackgroundColor' default:fg.
    self cursorForegroundColor:cFg backgroundColor:cBg. 

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

    "Modified: / 2.11.1997 / 22:34:47 / cg"
! !

!TextCollector class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.42 1998-03-06 15:29:52 stefan Exp $'
! !