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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 13 18:56:56 UTC 2013


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