[Pkg] The Trunk: System-fbs.650.mcz

[commits at source.squeak.org]

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 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].
+ 	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!