TextColl.st
changeset 34 c4b386a8cc57
parent 22 ac872628ef2d
child 36 641fe12489b2
--- a/TextColl.st	Sat Aug 06 12:23:16 1994 +0200
+++ b/TextColl.st	Sat Aug 06 15:06:37 1994 +0200
@@ -13,38 +13,59 @@
 EditTextView subclass:#TextCollector
        instanceVariableNames:'entryStream lineLimit destroyAction
                               outstandingLines outstandingLine
-                              flushBlock flushPending collecting timeDelay'
+                              flushBlock flushPending collecting timeDelay access'
        classVariableNames:''
        poolDictionaries:''
        category:'Views-Text'
 !
 
 TextCollector comment:'
-
 COPYRIGHT (c) 1989 by Claus Gittinger
               All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.6 1994-01-08 17:29:55 claus Exp $
-written winter-89 by claus
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.7 1994-08-06 13:06:37 claus Exp $
 '!
 
 !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.
+"
+!
+
+version
+"
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.7 1994-08-06 13:06:37 claus Exp $
+"
+!
+
 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.
+    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).
+    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 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 ...
+    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 ...
 "
 ! !
 
@@ -59,7 +80,7 @@
 defaultTimeDelay
     "the time in seconds to wait & collect by default"
 
-    ^ 0.2
+    ^ 0.3 
 ! !
 
 !TextCollector class methodsFor:'instance creation'!
@@ -68,6 +89,7 @@
     |topView transcript f v|
 
     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).
@@ -94,10 +116,12 @@
     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.
@@ -105,20 +129,28 @@
     entryStream nextPutAllBlock:[:something | self nextPutAll:something]
 !
 
+mapped
+    "view became visible - show collected lines (if any)"
+
+    super mapped.
+    self endEntry
+!
+
 destroy
     destroyAction notNil ifTrue:[
         destroyAction value
     ].
-    flushBlock notNil ifTrue:[
-        Processor removeTimedBlock:flushBlock
-    ].
+    Processor removeTimedBlock:flushBlock.
+    flushBlock := nil.
+    outstandingLines := OrderedCollection new.
+    outstandingLine := ''.
     super destroy
 ! !
 
 !TextCollector methodsFor:'accessing'!
 
 collect:aBoolean
-    "turn on collecting - i.e. do not output immediately
+    "turn on/off collecting - if on, do not output immediately
      but collect text and output en-bloque after some time delta"
 
     collecting := aBoolean
@@ -131,7 +163,9 @@
 !
 
 destroyAction:aBlock
-    "define the action to be performed when I get destroyed"
+    "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
 !
@@ -141,27 +175,30 @@
 
     |nLines|
 
+    shown ifFalse:[^ self].
+
     Processor removeTimedBlock:flushBlock.
     flushPending := false.
 
-    "insert the bunch of lines - if any"
-    nLines := outstandingLines size.
-    (nLines ~~ 0) ifTrue:[
-        self insertLines:outstandingLines withCr:true.
-        self withCursorOffDo:[
-            (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
-                self scrollDown:nLines
-            ]
+    access critical:[
+        "insert the bunch of lines - if any"
+        nLines := outstandingLines size.
+        (nLines ~~ 0) ifTrue:[
+            self insertLines:outstandingLines withCr:true.
+            self withCursorOffDo:[
+                (cursorLine >= (firstLineShown + nFullLinesShown)) ifTrue:[
+                    self scrollDown:nLines
+                ]
+            ].
+            outstandingLines := OrderedCollection new.
         ].
-        outstandingLines grow:0
-    ].
-    "and the last partial line - if any"
-    outstandingLine notNil ifTrue:[
-        flushPending := false.
-        self nextPut:outstandingLine.
-        outstandingLine := nil
-    ].
-    self checkLineLimit
+        "and the last partial line - if any"
+        outstandingLine notNil ifTrue:[
+            self insertStringAtCursor:outstandingLine.
+            outstandingLine := ''.
+        ].
+        self checkLineLimit
+    ]
 ! !
 
 !TextCollector methodsFor:'private'!
@@ -186,6 +223,30 @@
             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. dump vga cards ...)."
+
+    |wg p|
+
+    flushPending ifFalse:[
+        flushPending := true.
+        "
+         this could run under a process, which dies in the meantime;
+         therefore, we have to interrupt the transcript process.
+        "
+        wg := self windowGroup.
+        wg isNil ifTrue:[
+            p := Processor activeProcess
+        ] ifFalse:[
+            p := wg process
+        ].
+        Processor addTimedBlock:flushBlock for:p afterSeconds:timeDelay.
+    ]
 ! !
 
 !TextCollector methodsFor:'stream messages'!
@@ -221,39 +282,47 @@
 cr
     "output a carriage return, finishing the current line"
 
+    |wasBlocked|
+
     collecting ifTrue:[
-        outstandingLines add:outstandingLine.
-        outstandingLine := nil.
+        access critical:[
+            outstandingLine notNil ifTrue:[
+                outstandingLines add:outstandingLine.
+            ].
+            outstandingLine := ''.
+        ].
         flushPending ifFalse:[
-            Processor addTimedBlock:flushBlock after:timeDelay.
-            flushPending := true
-        ] ifTrue:[
-            Processor evaluateTimeouts
+            self installDelayedUpdate
         ]
     ] ifFalse:[
-        self cursorReturn.
-        self checkLineLimit
+        access critical:[
+            self cursorReturn.
+            self checkLineLimit.
+        ].
     ]
 !
 
 show:anObject
     "insert the argument aString at current cursor position"
 
-    |aString|
+    |aString wasBlocked|
 
     aString := anObject printString.
     collecting ifTrue:[
-        outstandingLine notNil ifTrue:[
-            outstandingLine := outstandingLine , aString
-        ] ifFalse:[
-            outstandingLine := aString
+        access critical:[
+            outstandingLine notNil ifTrue:[
+                outstandingLine := outstandingLine , aString
+            ] ifFalse:[
+                outstandingLine := aString
+            ].
         ].
         flushPending ifFalse:[
-            Processor addTimedBlock:flushBlock after:timeDelay.
-            flushPending := true
+            self installDelayedUpdate
         ]
     ] ifFalse:[
-        self nextPut:aString
+        access critical:[
+            self nextPut:aString.
+        ].
     ]
 !