[squeak-dev] The Trunk: ST80-fbs.165.mcz

David T. Lewis lewis at mail.msen.com
Fri Dec 13 19:17:39 UTC 2013


According to the class comment:

Transcripter is a dog-simple scrolling stream with display.  It is 
intended to operate with no support from MVC or color in a minimal, or
headless version of Squeak.  No attention has been paid to appearance or
performance.

This is explicitly designed to *not* be part of MVC or any other UI
framework, and it is clearly documented as such. It does not belong in the
ST80 package.

Dave

> Frank Shearar uploaded a new version of ST80 to project The Trunk:
> http://source.squeak.org/trunk/ST80-fbs.165.mcz
>
> ==================== Summary ====================
>
> Name: ST80-fbs.165
> Author: fbs
> Time: 13 December 2013, 6:56:32.522 pm
> UUID: 1fc821e0-cf5e-7e49-9037-8fb7b5e58ec0
> Ancestors: ST80-fbs.164
>
> Transcripter is actually MVC specific. Move it there, and other UI
> frameworks can define their own emergency evaluator.
>
> =============== Diff against ST80-fbs.164 ===============
>
> Item was changed:
>   SystemOrganization addCategory: #'ST80-Controllers'!
>   SystemOrganization addCategory: #'ST80-Editors'!
>   SystemOrganization addCategory: #'ST80-Framework'!
>   SystemOrganization addCategory: #'ST80-Menus'!
>   SystemOrganization addCategory: #'ST80-Menus-Tests'!
>   SystemOrganization addCategory: #'ST80-Paths'!
>   SystemOrganization addCategory: #'ST80-Pluggable Views'!
> + SystemOrganization addCategory: #'ST80-REPL'!
>   SystemOrganization addCategory: #'ST80-Support'!
>   SystemOrganization addCategory: #'ST80-Support-Tests'!
>   SystemOrganization addCategory: #'ST80-Symbols'!
>   SystemOrganization addCategory: #'ST80-ToolBuilder'!
>   SystemOrganization addCategory: #'ST80-Views'!
>
> Item was added:
> + ReadWriteStream subclass: #Transcripter
> + 	instanceVariableNames: 'frame para'
> + 	classVariableNames: ''
> + 	poolDictionaries: ''
> + 	category: 'ST80-REPL'!
> +
> + !Transcripter commentStamp: '<historical>' prior: 0!
> + Transcripter is a dog-simple scrolling stream with display.  It is
> intended to operate with no support from MVC or color in a minimal, or
> headless version of Squeak.  No attention has been paid to appearance or
> performance.!
>
> Item was added:
> + ----- Method: Transcripter class>>emergencyEvaluator (in category
> 'utilities') -----
> + emergencyEvaluator
> + 	(Transcripter newInFrame: (0 at 0 corner: 320 at 200))
> + 		show: 'Type ''revert'' to revert your last method change.
> + Type ''exit'' to exit the emergency evaluator.';
> + 		readEvalPrint!
>
> Item was added:
> + ----- Method: Transcripter class>>newInFrame: (in category 'instance
> creation') -----
> + newInFrame: frame
> + "
> + (Transcripter newInFrame: (0 at 0 extent: 100 at 200))
> + 	nextPutAll: 'Hello there'; endEntry;
> + 	cr; print: 355.0/113; endEntry;
> + 	readEvalPrint.
> + "
> + 	| transcript |
> + 	transcript := self on: (String new: 100).
> + 	transcript initInFrame: frame.
> + 	^ transcript clear!
>
> Item was added:
> + ----- Method: Transcripter class>>startTranscriptProcess (in category
> 'instance creation') -----
> + startTranscriptProcess   "Transcripter startTranscriptProcess"
> + 	| activeProcess |
> + 	Transcript := self newInFrame: Display boundingBox.
> + 	activeProcess := [Transcript readEvalPrint.
> + 					Smalltalk processShutDownList: true; quitPrimitive]
> + 						newProcess
> + 					priority: Processor userSchedulingPriority.
> + 	activeProcess resume.
> + 	Processor terminateActive
> + !
>
> Item was added:
> + ----- Method: Transcripter>>black (in category 'private') -----
> + black
> + 	Display depth = 1 ifTrue: [^ Bitmap with: 16rFFFFFFFF "Works without
> color support"].
> + 	^ Color black!
>
> Item was added:
> + ----- Method: Transcripter>>clear (in category 'accessing') -----
> + clear
> + 	Display fill: (frame insetBy: -2) fillColor: self black;
> + 			fill: frame fillColor: self white.
> + 	self on: (String new: 100); endEntry!
>
> Item was added:
> + ----- Method: Transcripter>>confirm: (in category 'command line') -----
> + confirm: queryString
> +
> + 	| choice |
> + 	[choice := self request: queryString , '
> + Please type yes or no followed by return'.
> + 	choice first asUppercase = $Y ifTrue: [^ true].
> + 		choice first asUppercase = $N ifTrue: [^ false]] repeat!
>
> Item was added:
> + ----- Method: Transcripter>>endEntry (in category 'accessing') -----
> + endEntry
> + 	| c d cb |
> + 	c := self contents.
> + 	Display extent ~= DisplayScreen actualScreenSize ifTrue:
> + 		["Handle case of user resizing physical window"
> + 		DisplayScreen startUp.
> + 		frame := frame intersect: Display boundingBox.
> + 		^ self clear; show: c].
> + 	para setWithText: c asText
> + 		style: TextStyle default
> + 		compositionRectangle: ((frame insetBy: 4) withHeight: 9999)
> + 		clippingRectangle: frame
> + 		foreColor: self black backColor: self white.
> + 	d := para compositionRectangle bottom - frame bottom.
> + 	d > 0 ifTrue:
> + 		["Scroll up to keep all contents visible"
> + 		cb := para characterBlockAtPoint: para compositionRectangle topLeft
> + 											+ (0@(d+para lineGrid)).
> + 		self on: (c copyFrom: cb stringIndex to: c size).
> + 		readLimit:= position:= collection size.
> + 		^ self endEntry].
> + 	para display!
>
> Item was added:
> + ----- Method: Transcripter>>initInFrame: (in category 'initialization')
> -----
> + initInFrame: rect
> + 	Smalltalk at: #Paragraph ifPresent: [:classParagraph | "MVC"
> + 		frame := rect insetBy: 2.  "Leave room for border"
> + 		para := classParagraph withText: self contents asText
> + 					style: TextStyle default
> + 					compositionRectangle: ((frame insetBy: 4) withHeight: 9999)
> + 					clippingRectangle: frame
> + 					foreColor: self black backColor: self white]!
>
> Item was added:
> + ----- Method: Transcripter>>readEvalPrint (in category 'command line')
> -----
> + readEvalPrint
> + 	| line okToRevert |
> + 	okToRevert := true.
> + 	[#('quit' 'exit' 'done' ) includes: (line := self request: '>')]
> + 		whileFalse:
> + 		[line = 'revert'
> + 		ifTrue: [okToRevert
> + 			ifTrue: [RecentMessages default revertMostRecent.
> + 					self cr; show: 'reverted: ' , RecentMessages default mostRecent.
> + 					okToRevert := false]
> + 			ifFalse: [self cr; show: 'Only one level of revert currently
> supported']]
> + 		ifFalse: [self cr; show: ([Compiler evaluate: line] ifError: [:err :ex
> | err])]]!
>
> Item was added:
> + ----- Method: Transcripter>>request: (in category 'command line') -----
> + request: prompt
> + 	| startPos char contents |
> + 	self cr; show: prompt.
> + 	startPos := position.
> + 	[[Sensor keyboardPressed] whileFalse.
> + 	(char := Sensor keyboard) = Character cr]
> + 		whileFalse:
> + 		[char = Character backspace
> + 			ifTrue: [readLimit := position := (position - 1 max: startPos)]
> + 			ifFalse: [self nextPut: char].
> + 		self endEntry].
> + 	contents := self contents.
> + 	^ contents copyFrom: startPos + 1 to: contents size!
>
> Item was added:
> + ----- Method: Transcripter>>show: (in category 'accessing') -----
> + show: anObject
> + 	self nextPutAll: anObject asString; endEntry!
>
> Item was added:
> + ----- Method: Transcripter>>white (in category 'private') -----
> + white
> + 	Display depth = 1 ifTrue: [^ Bitmap with: 0 "Works without color
> support"].
> + 	^ Color white!
>
>




More information about the Squeak-dev mailing list