[Pkg] 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 Packages
mailing list