New Transcript (was: [squeak-dev] Re: [Pharo-project] Cog VM -- Thanks and Performance / Optimization Questions)

Juan Vuletich juan at jvuletich.org
Fri Feb 18 22:03:33 UTC 2011


Hi Folks,

This new version includes full Morphic integration. It was done for 
Cuis, but it shouldn't be too hard to adapt for Squeak / Pharo.

Cheers,
Juan Vuletich

Juan Vuletich wrote:
> Hi Eliot,
>
> There are other problems with Transcript besides performance. It is 
> easy to break the UI if called at the wrong times. In those cases, it 
> is usually needed to kill Squeak from the OS. Besides, it is not 
> thread safe.
>
> Instantly becoming a hero sounds cool, so this is my attempt at it :) 
> I only tried this in Cuis, but I believe it should work on Squeak and 
> Pharo without much trouble. After loading this code, you can evaluate 
> 'Smalltalk at: #Transcript put: NewTranscript'.
>
> Some good properties of this are:
> - Very fast.
> - Thread safe!
> - Doesn't use Morphic at all. Can be used to debug Morphic itself.
> - Doesn't do delayed execution (no events, no forked processes). 
> Immediate visual feedback.
> - Can show itself on Display, log to File, both, or none.
> - Can be used for headless or remote images (for example, web servers).
>
> Some possible downsides are:
> - Output only. Not a text editor. We have the Workspace and the 
> Transcripter for that.
> - No seamless Morphic integration. I'll do one for Cuis, though.
>
> If no serious problems are found, I'll remove TranscriptStream from 
> Cuis, and rename this class as Transcript.
>
> Cheers,
> Juan Vuletich

-------------- next part --------------
'From Cuis 3.0 of 31 January 2011 [latest update: #790] on 18 February 2011 at 5:34:24 pm'!
!classDefinition: #Transcript category: #'System-Support'!
Object subclass: #Transcript
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Support'!

!Transcript commentStamp: '<historical>' prior: 0!
A new implementation of Transcript.
- Thread safe.
- Very fast.
- Independent of Morphic or any other UI framework.
- Immediate feedback.
- Can log to file.
- Not an editor. Only used for output.
- All protocol is on the Class side!

!classDefinition: 'Transcript class' category: nil!
Transcript class
	instanceVariableNames: 'entries firstIndex lastIndex accessSemaphore unfinishedEntry logToFile showOnDisplay innerRectangle lastDisplayTime'!
!classDefinition: #TranscriptMorph category: #'Morphic-Widgets'!
BorderedMorph subclass: #TranscriptMorph
	instanceVariableNames: 'form'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!

!DateAndTime methodsFor: 'squeak protocol' stamp: 'jmv 2/18/2011 12:57'!
printWithMsOn: aStream
	"Print with millisecond resolution, no leading space, no offset."

	| ps |
	self printYMDOn: aStream withLeadingSpace: false.
	aStream nextPut: $T.
	self printHMSOn: aStream.
	ps _ (self nanoSecond // 1000000) printString padded: #left to: 3 with: $0.
	aStream nextPut: $..
	aStream nextPutAll: ps! !


!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 2/18/2011 17:30'!
findATranscript: evt
	"Locate a transcript, open it, and bring it to the front.  Create one if necessary"

	self
		findAWindowSatisfying: [ :aWindow | aWindow model == Transcript]
		orMakeOneUsing: [ TranscriptMorph openWindow ]! !


!TextModelMorph methodsFor: 'updating' stamp: 'jmv 2/18/2011 11:12'!
update: aSymbol 
	aSymbol ifNil: [^self].
	aSymbol == #flash ifTrue: [^self flash].
	aSymbol == #actualContents 
		ifTrue: [
			"Some day, it would be nice to keep objects and update them
			instead of throwing them away all the time for no good reason..."
			textMorph releaseParagraph.
			self formatAndStyleIfNeeded.
			^self].
	aSymbol == #acceptedContents ifTrue: [
		model refetch.
		^self].
	aSymbol == #refetched ifTrue: [
		self setSelection: model getSelection.
		self hasUnacceptedEdits: false.
		^self].
	aSymbol == #initialSelection 
		ifTrue: [^self setSelection: model getSelection].
	aSymbol == #autoSelect 
		ifTrue: [
			self handleEdit: [
					TextEditor abandonChangeText.	"no replacement!!"
					self editor
						setSearch: model autoSelectString;
						againOrSame: true ]].
	aSymbol == #clearUserEdits ifTrue: [^self hasUnacceptedEdits: false].
	aSymbol == #wantToChange 
		ifTrue: [
			self canDiscardEdits ifFalse: [^self promptForCancel].
			^self].
	aSymbol == #codeChangedElsewhere 
		ifTrue: [
			self hasEditingConflicts: true.
			^self changed ].
	aSymbol == #shoutStyle
		ifTrue: [
			self stylerStyled.
			^self changed ].! !


!TheWorldMenu methodsFor: 'commands' stamp: 'jmv 2/18/2011 17:29'!
openTranscript

	TranscriptMorph openWindow! !


!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:49'!
bounds: aRectangle
	innerRectangle _ aRectangle insetBy: self borderWidth! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
clear
	| stream |
	accessSemaphore critical: [
		"Having at least one entry simplifies handling of the entries circular collection"
		firstIndex _ 1.
		lastIndex _ 1.
		entries at: 1 put: 'Transcript'.	
		unfinishedEntry reset.
		
		logToFile ifTrue: [
			stream _ StandardFileStream forceNewFileNamed: self filename.
			[
				stream nextPutAll: 'Transcript log started: '.
				DateAndTime now printOn: stream.
				stream
					lf;
					nextPutAll: '------------------------------------------------------------------------';
					lf
			] ensure: [ stream close ]]].
	self display! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 14:16'!
log: aString
	self addEntry: aString.
	self display! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:46'!
logToFile: aBoolean
	"
	self logToFile
	"
	logToFile _ aBoolean! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 16:46'!
showOnDisplay: aBoolean
	"
	self logToFile
	"
	showOnDisplay _ aBoolean! !

!Transcript class methodsFor: 'preferred protocol' stamp: 'jmv 2/18/2011 17:06'!
windowIsClosing
	self showOnDisplay: false! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
cr
	"WriteStream protocol.
	In the older TranscriptStream, it added a CR character.
	Now, finish the current incomplete entry."

	self finishEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
crtab
	"WriteStream protocol.
	End the current entry, and start a new one starting with a single tab character."

	self cr; tab! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
endEntry
	"For compatibility with old TranscriptStream. nop here"! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:21'!
flush
	"For compatibility with old TranscriptStream. nop here"! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPut: aCharacter
	"WriteStream protocol.
	Append aCharacter to the unfinishedEntry.
	cr characters sent with this message do NOT finish the current unfinishedEntry."

	unfinishedEntry nextPut: aCharacter.
	self displayUnfinishedEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 14:17'!
nextPutAll: aString
	"WriteStream protocol.
	Append aString to the unfinishedEntry.
	cr characters sent with this message do NOT finish the current unfinishedEntry."

	unfinishedEntry nextPutAll: aString.
	self displayUnfinishedEntry! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:20'!
print: anObject
	"Stream protocol"
	anObject printOn: self! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
show: anObject
	"Old TranscriptStream protocol."
	self nextPutAll: anObject asString! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
space
	"WriteStream protocol.
	Append a space character to the receiver."

	self nextPut: Character space! !

!Transcript class methodsFor: 'old Transcript compatibility' stamp: 'jmv 2/18/2011 11:22'!
tab
	"WriteStream protocol.
	Append a tab character to the receiver."

	self nextPut: Character tab! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:59'!
addEntry: aString
	"Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
	| msg now |
	logToFile ifTrue: [
		now _ DateAndTime now.
		msg _ String streamContents: [ :strm |
			now printWithMsOn: strm.
			strm
				nextPutAll: ' process:';
				nextPutAll: Processor activeProcess priority printString;
				nextPut: $ ;
				nextPutAll: Processor activeProcess hash printString;
				nextPut: $ ;
				nextPutAll: aString;
				lf ]].

	self addEntry: aString logToFile: msg! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 12:34'!
addEntry: aString logToFile: otherString
	"Add a new entrie to the entries circular list. If full, a new entry will replace the oldest one."
	| stream |
	accessSemaphore critical: [
		
		"Internal circular collection"
		lastIndex _ lastIndex \\ self maxEntries + 1.
		firstIndex = lastIndex ifTrue: [
			firstIndex _ firstIndex \\ self maxEntries + 1 ].
		entries at: lastIndex put: aString.
		
		"external file"
		otherString ifNotNil: [
			[
				stream _ StandardFileStream fileNamed: self filename.
				stream
					setToEnd;
					nextPutAll: otherString;
					flush]
			ensure: [ stream close ]
		]
	]! !

!Transcript class methodsFor: 'private' stamp: 'jmv 2/18/2011 14:16'!
finishEntry
	| newEntry |
	newEntry _ unfinishedEntry contents.
	unfinishedEntry reset.
	self addEntry: newEntry.
	self display! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:20'!
display
	showOnDisplay ifTrue: [
		self displayOn: Display.
		lastDisplayTime _ DateAndTime now ]! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 16:49'!
displayOn: aForm
	"
	experimentos
	Transcript displayOn: Display
	"
	| font port count i string x y fh f bw |
	bw _ self borderWidth.
	aForm border: (innerRectangle outsetBy: bw) width: bw. 
	aForm fill: innerRectangle fillColor: Color white.
	port _ BitBlt toForm: aForm.
	port clipWidth: innerRectangle right.
	font _ StrikeFont default.
	font installOn: port foregroundColor: Color black.
	
	fh _ font height.
	count _ innerRectangle height // fh-1.
	x _ innerRectangle left.
	y _ innerRectangle top.
	f _ firstIndex-1.
	firstIndex > lastIndex ifTrue: [ f _ f - self maxEntries ].
	i _ (lastIndex - count max: f) \\ self maxEntries + 1.
	[
		string _ entries at: i.	
		port displayString: string from: 1 to: string size at: x at y strikeFont: font kern: font baseKern negated.
		y _ y + fh.
		i = lastIndex
	] whileFalse: [ i _ i \\ self maxEntries + 1 ].

	string _ unfinishedEntry contents.	
	port displayString: string from: 1 to: string size at: x at y strikeFont: font kern: font baseKern negated.! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:23'!
displayUnfinishedEntry
	showOnDisplay ifTrue: [
		(lastDisplayTime isNil or: [ (DateAndTime now - lastDisplayTime) totalSeconds > 1 ])
			ifTrue: [ ^self display ].
		self displayUnfinishedEntryOn: Display ]! !

!Transcript class methodsFor: 'displaying' stamp: 'jmv 2/18/2011 14:14'!
displayUnfinishedEntryOn: aForm

	| font port count string x y fh |
	port _ BitBlt toForm: aForm.
	port clipWidth: innerRectangle right.
	font _ StrikeFont default.
	font installOn: port foregroundColor: Color black.
	
	fh _ font height.
	count _ innerRectangle height // fh-1.
	x _ innerRectangle left.

	string _ unfinishedEntry contents.
	y _ ((lastIndex - firstIndex \\ self maxEntries) min: count-1) + 1 * font height + innerRectangle top.
	port displayString: string from: 1 to: string size at: x at y strikeFont: font kern: font baseKern negated.! !

!Transcript class methodsFor: 'class initialization' stamp: 'jmv 2/18/2011 13:13'!
initialize
	"
	self initialize
	"
	showOnDisplay _ true.
	innerRectangle _ 20 at 20 extent: 300 at 500.
	logToFile _ false.
	entries _ Array new: self maxEntries.
	unfinishedEntry _ '' writeStream.
	accessSemaphore _ Semaphore forMutualExclusion.
	self clear! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 16:49'!
borderWidth
	^1! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:33'!
filename
	^'transcript.txt'! !

!Transcript class methodsFor: 'constants' stamp: 'jmv 2/18/2011 12:59'!
maxEntries
	^1000! !


!TranscriptMorph methodsFor: 'drawing' stamp: 'jmv 2/18/2011 17:18'!
drawOn: aCanvas
	"
	Transcript
		showOnDisplay: true;
		bounds: bounds;
		displayOn: aCanvas form.
	"
	Transcript
		showOnDisplay: true;
		bounds: (0 at 0 extent: bounds extent);
		displayOn: form;
		bounds: bounds.
	aCanvas drawImage: form at: bounds origin! !

!TranscriptMorph methodsFor: 'geometry' stamp: 'jmv 2/18/2011 17:17'!
extent: aPoint
	super extent: aPoint.
	(form isNil or: [ form extent ~= aPoint ]) ifTrue: [
		form _ Form extent: aPoint depth: Display depth ]! !


!TranscriptMorph class methodsFor: 'instance creation' stamp: 'jmv 2/18/2011 17:08'!
openWindow
	"
	TranscriptMorph openWindow
	"
	SystemWindow new
		setLabel: 'Transcript';
		model: Transcript;
		widgetsColor: Theme current transcript;
		addMorph: TranscriptMorph new frame: (0 at 0 extent: 1 at 1);
		openInWorld! !

Transcript initialize!
Transcript class removeSelector: #logToFile!
TextModelMorph removeSelector: #appendEntry!
Smalltalk removeClassNamed: #TranscriptStream!


More information about the Squeak-dev mailing list