'From Pharo0.1 of 16 May 2008 [Latest update: #10258] on 29 March 2009 at 3:33:24 pm'!
Object subclass: #ThreadSafeTranscript
	instanceVariableNames: 'stream accessSemaphore'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ThreadSafeTranscript'!
!ThreadSafeTranscript commentStamp: 'sd 3/27/2009 08:48' prior: 0!
I'm an output device.

Ultimately I can replace TranscripterStream since I'm thread safe and TranscripterStream.
I used Monitor but I could use semaphore. 

ThreadSafeTranscript can be installed as the default transcript using
ThreadSafeTranscript installThreadSafeAsTranscript

It can be installed as another Transcript accessible using STranscript
ThreadSafeTranscript installThreadSafeAsSTranscript
!


!ThreadSafeTranscript methodsFor: 'color' stamp: 'sd 5/18/2007 22:33'!
black
	"copied from Transcripter"

	Display depth = 1 ifTrue: [^ Bitmap with: 16rFFFFFFFF "Works without color support"].
	^ Color black! !

!ThreadSafeTranscript methodsFor: 'color' stamp: 'sd 5/18/2007 22:33'!
white
	"copied from Transcripter"

	Display depth = 1 ifTrue: [^ Bitmap with: 0 "Works without color support"].
	^ Color white! !


!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'stephane.ducasse 3/28/2009 21:26'!
buildWith: builder

	| windowSpec textSpec |
	windowSpec := builder pluggableWindowSpec new.
	windowSpec model: self.
	windowSpec label: self title.
	windowSpec children: OrderedCollection new.

	textSpec := builder pluggableTextSpec new.
	textSpec 
		model: self;
		menu: #codePaneMenu:shifted:;
		frame: (0@0corner: 1@1).
	windowSpec children add: textSpec.

	^builder build: windowSpec! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'stephane.ducasse 3/28/2009 22:00'!
closeAllViews
	"self new closeAllViews"

	self dependents do: 
			[:d | (d isSystemWindow) ifTrue: [d delete]]! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'stephane.ducasse 3/28/2009 21:26'!
open
	"self new open"
	(self buildWith: MorphicToolBuilder new) openInWorld
! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'stephane.ducasse 3/28/2009 21:26'!
title

	^ 'ThreadSafeTranscript'! !

!ThreadSafeTranscript methodsFor: 'ui building' stamp: 'sd 5/17/2007 22:54'!
windowColorSpecification
	"Answer a WindowColorSpec object that declares my preference"

	^ WindowColorSpec classSymbol: self name wording: 'Transcript' brightColor: #lightOrange pastelColor: #paleOrange helpMessage: 'The system transcript'
! !


!ThreadSafeTranscript methodsFor: 'printing' stamp: 'stephane.ducasse 3/28/2009 21:31'!
isSelfEvaluating

	self == Transcript ifTrue: [^true].
	^super isSelfEvaluating! !

!ThreadSafeTranscript methodsFor: 'printing' stamp: 'stephane.ducasse 3/28/2009 21:30'!
printOn: aStream

	self == Transcript ifFalse: [^super printOn: aStream].
	aStream nextPutAll: self title! !


!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/19/2007 10:33'!
characterLimit

	^ 20000! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'stephane.ducasse 3/28/2009 21:33'!
clear
	"Clear all characters and redisplay the view"
	
	accessSemaphore 
		critical: [ self changed: #clearText.
				stream reset ]! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'stephane.ducasse 3/28/2009 21:57'!
close
	self flush.
	stream close.
	! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 15:05'!
cr 
	
	accessSemaphore
		critical: [stream cr].
! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 3/27/2009 08:43'!
endEntry
	"Display all the characters since the last endEntry, and reset the stream"
	
	accessSemaphore 
		critical: [ self changed: #appendEntry.
				stream reset ].! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 22:58'!
flush
	self endEntry
! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 15:04'!
nextPut: value
	
	accessSemaphore
		critical: [stream nextPut: value].
	^value! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 22:31'!
nextPutAll: value
	
	accessSemaphore
		critical: [stream nextPutAll: value].
	^value! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 3/27/2009 08:43'!
pastEndPut: anObject
	"If the stream reaches its limit, just output the contents and reset."
	
	self endEntry.
	^ self nextPut: anObject! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'stephane.ducasse 3/28/2009 21:32'!
reset
	! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'sd 5/18/2007 22:31'!
show: anObject

	self nextPutAll: anObject asString; endEntry! !

!ThreadSafeTranscript methodsFor: 'streaming' stamp: 'dc 11/5/2007 15:58'!
with: aBlock
	
	accessSemaphore
		critical: [ ^ aBlock value: stream ].
! !


!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'sd 5/19/2007 10:38'!
contents 
	
	| contents | 
	accessSemaphore
		critical: [contents :=  stream contents ].
	^ contents! !

!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'stephane.ducasse 3/28/2009 21:21'!
space

	accessSemaphore
		critical: [stream space].
! !

!ThreadSafeTranscript methodsFor: 'protected low level' stamp: 'sd 5/19/2007 10:36'!
tab
	
	accessSemaphore
		critical: [stream tab].
! !


!ThreadSafeTranscript methodsFor: 'initialize' stamp: 'stephane.ducasse 3/28/2009 21:55'!
initialize
 
	super initialize.
	accessSemaphore := Semaphore new forMutualExclusion.
	stream := String new writeStream.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ThreadSafeTranscript class
	instanceVariableNames: ''!

!ThreadSafeTranscript class methodsFor: 'toolbuilder' stamp: 'sd 3/27/2009 07:49'!
buildWith: aBuilder
	"(self buildWith: MorphicToolBuilder new) openInWorld"
	^self new buildWith: aBuilder! !

!ThreadSafeTranscript class methodsFor: 'toolbuilder' stamp: 'stephane.ducasse 3/28/2009 21:33'!
open 
	"self open"
	
	^ self new open ! !


!ThreadSafeTranscript class methodsFor: 'examples' stamp: 'stephane.ducasse 3/28/2009 21:37'!
examples
	"self examples"
	
	| tt |
	Smalltalk at: #STranscript ifAbsent: [self installThreadSafeAsSTranscript].
	tt := (Smalltalk at: #STranscript).
	tt open.
	tt nextPutAll: 'Pharo'; flush; cr; tab.
	tt show: ' is cool' ; cr.
	tt reset.
	tt clear.
	tt nextPutAll: 'Pharo'; flush; cr; tab.
	tt show: ' is really cool' ; cr.! !

!ThreadSafeTranscript class methodsFor: 'examples' stamp: 'stephane.ducasse 3/28/2009 21:49'!
examplesConcurrent
	"self examplesConcurrent"
	
	| tt |
	Smalltalk at: #STranscript ifAbsent: [self installThreadSafeAsSTranscript].
	tt := (Smalltalk at: #STranscript).
	tt open.
	[1 to: 10 do: [:i | tt nextPutAll: i printString; nextPutAll: '*'.
					Processor yield ]. 
	tt flush	]  fork.
	[100 to: 110 do: [:i | tt nextPutAll: i printString; nextPutAll: '-'.
					Processor yield  ].
	tt flush	] fork.! !


!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'sd 3/27/2009 08:47'!
install

	self installThreadSafeAsTranscript! !

!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'sd 3/27/2009 08:48'!
installThreadSafeAsSTranscript

	Smalltalk at: #STranscript put: (self new)
	
	"ThreadSafeTranscript open"! !

!ThreadSafeTranscript class methodsFor: 'declare' stamp: 'sd 3/27/2009 08:46'!
installThreadSafeAsTranscript

	Smalltalk at: #Transcript put: (self new)

	"ThreadSafeTranscript open"! !


!ThreadSafeTranscript class methodsFor: 'color' stamp: 'sd 3/27/2009 08:41'!
windowColorSpecification
	"Answer a WindowColorSpec object that declares my preference"

	^ WindowColorSpec classSymbol: ThreadSafeTranscript wording: 'SafeTranscript' brightColor: #lightBlue pastelColor: #paleOrange helpMessage: 'The system transcript'! !