The Trunk: System-fbs.650.mcz

Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.650.mcz

==================== Summary ====================

Name: System-fbs.650
Author: fbs
Time: 30 December 2013, 10:01:04.803 am
UUID: 46142ef7-bfcf-f445-be72-03a4103bb3b1
Ancestors: System-fbs.649

System-Recovery contains all the tools we use to attempt to recover from very bad state. At the moment it only contains the Transcripter, also known as the emergency evaluator.

=============== Diff against System-fbs.649 ===============

Item was changed:
  SystemOrganization addCategory: #'System-Applications'!
  SystemOrganization addCategory: #'System-Change Notification'!
  SystemOrganization addCategory: #'System-Changes'!
  SystemOrganization addCategory: #'System-Digital Signatures'!
  SystemOrganization addCategory: #'System-Download'!
  SystemOrganization addCategory: #'System-Exceptions'!
  SystemOrganization addCategory: #'System-FilePackage'!
  SystemOrganization addCategory: #'System-FileRegistry'!
  SystemOrganization addCategory: #'System-Finalization'!
  SystemOrganization addCategory: #'System-Localization'!
  SystemOrganization addCategory: #'System-Object Events'!
  SystemOrganization addCategory: #'System-Object Storage'!
  SystemOrganization addCategory: #'System-Preferences'!
+ SystemOrganization addCategory: #'System-Recovery'!
  SystemOrganization addCategory: #'System-Serial Port'!
  SystemOrganization addCategory: #'System-Support'!
  SystemOrganization addCategory: #'System-Tools'!

Item was added:
+ ReadWriteStream subclass: #Transcripter
+ instanceVariableNames: 'frame para'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'System-Recovery'!
+
+ !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@0 corner: 320@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@0 extent: 100@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].
+ Project current displayTranscripter: self.
+ 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].
+ !

Item was added:
+ ----- Method: Transcripter>>initInFrame: (in category 'initialization') -----
+ initInFrame: rect
+ frame := rect insetBy: 2.  "Leave room for border"
+ Project current initializeParagraphForTranscripter: self
+ !

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!