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
'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@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@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@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@20 extent: 300@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@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@0 extent: 1@1);
openInWorld! !
Transcript initialize!
Transcript class removeSelector: #logToFile!
TextModelMorph removeSelector: #appendEntry!
Smalltalk removeClassNamed: #TranscriptStream!
