[Pharo-project] Issue 3736 in pharo: new Transcript from CUIS

pharo at googlecode.com pharo at googlecode.com
Sat Feb 19 23:02:56 CET 2011


Comment #1 on issue 3736 by stephane... at gmail.com: new Transcript from CUIS
http://code.google.com/p/pharo/issues/detail?id=3736

'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 Pharo-project mailing list