Squeak 4.6: CommandLine-cmm.4.mcz

Chris Muller uploaded a new version of CommandLine to project Squeak 4.6:
http://source.squeak.org/squeak46/CommandLine-cmm.4.mcz

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

Name: CommandLine-cmm.4
Author: cmm
Time: 16 January 2015, 3:27:43.102 pm
UUID: 0a2ab805-2910-49f5-81dc-c7de4581f4f6
Ancestors: CommandLine-fbs.3

Let Errors print themselves.

==================== Snapshot ====================

SystemOrganization addCategory: #'CommandLine-Tools'!
SystemOrganization addCategory: #'CommandLine-UIManager'!

UIManager subclass: #DummyUIManager
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'CommandLine-UIManager'!

!DummyUIManager commentStamp: 'fbs 10/31/2013 07:36' prior: 0!
I'm an alternative UIManager used to run an the image without GUI.  I redefine methods which require user input as these requests are irrelevant in a headless environment. !

----- Method: DummyUIManager>>checkForNewDisplaySize (in category 'display') -----
checkForNewDisplaySize
        Display extent = DisplayScreen actualScreenSize ifTrue: [^ self].
        DisplayScreen startUp.
!

----- Method: DummyUIManager>>chooseDirectory:from: (in category 'ui requests') -----
chooseDirectory: label from: dir
        ^ nil!

----- Method: DummyUIManager>>chooseFrom:lines:title: (in category 'ui requests') -----
chooseFrom: aList lines: linesArray title: aString
        ^ aList first!

----- Method: DummyUIManager>>chooseFrom:values:lines:title: (in category 'ui requests') -----
chooseFrom: labelList values: valueList lines: linesArray title: aString
        ^ valueList first!

----- Method: DummyUIManager>>confirm: (in category 'ui requests') -----
confirm: queryString
        (ProvideAnswerNotification signal: queryString)
                ifNotNil: [:answer|^answer].

        self error: 'No user response possible'!

----- Method: DummyUIManager>>confirm:orCancel: (in category 'ui requests') -----
confirm: aString orCancel: cancelBlock
        (ProvideAnswerNotification signal: aString) ifNotNil: [:answer |
        ^answer == #cancel ifTrue: [cancelBlock value] ifFalse: [answer]].

        self error: 'No user response possible'!

----- Method: DummyUIManager>>displayProgress:at:from:to:during: (in category 'ui requests') -----
displayProgress: titleString at: aPoint from: minVal to: maxVal during: workBlock
        ^ workBlock value: Association new!

----- Method: DummyUIManager>>edit:label:accept: (in category 'ui requests') -----
edit: aText label: labelString accept: anAction
        ^ nil!

----- Method: DummyUIManager>>fontFromUser: (in category 'ui requests') -----
fontFromUser: priorFont
        self error: 'No user response possible'!

----- Method: DummyUIManager>>inform: (in category 'ui requests') -----
inform: aString
        "Nothing to be done here"!

----- Method: DummyUIManager>>informUserDuring: (in category 'ui requests') -----
informUserDuring: aBlock
        aBlock value: nil!

----- Method: DummyUIManager>>newDisplayDepthNoRestore: (in category 'display') -----
newDisplayDepthNoRestore: pixelSize
        "Change depths.  Check if there is enough space!!  , di"
        | area need |
        pixelSize = Display depth ifTrue: [^ self  "no change"].
        pixelSize abs < Display depth ifFalse:
                ["Make sure there is enough space"
                area := Display boundingBox area. "pixels"

                need := (area * (pixelSize abs - Display depth) // 8)  "new bytes needed"
                                + Smalltalk lowSpaceThreshold.
                (Smalltalk garbageCollectMost <= need
                        and: [Smalltalk garbageCollect <= need])
                        ifTrue: [self error: 'Insufficient free space']].
        Display setExtent: Display extent depth: pixelSize.

        DisplayScreen startUp!

----- Method: DummyUIManager>>request:initialAnswer: (in category 'ui requests') -----
request: queryString initialAnswer: defaultAnswer
        (ProvideAnswerNotification signal: queryString)
        ifNotNil: [:answer |
            ^ answer == #default ifTrue: [defaultAnswer] ifFalse: [answer]].

        self error: 'No user response possible'!

----- Method: DummyUIManager>>requestPassword: (in category 'ui requests') -----
requestPassword: queryString
        ^ self request: queryString initialAnswer: ''!

----- Method: DummyUIManager>>restoreDisplay (in category 'display') -----
restoreDisplay!

----- Method: DummyUIManager>>restoreDisplayAfter: (in category 'display') -----
restoreDisplayAfter: aBlock
        aBlock value.
        Sensor waitButton.!

StandardToolSet subclass: #CommandLineToolSet
        instanceVariableNames: ''
        classVariableNames: 'SaveSnapshotOnError'
        poolDictionaries: ''
        category: 'CommandLine-Tools'!

----- Method: CommandLineToolSet class>>debugContext:label:contents: (in category 'debugging') -----
debugContext: aContext label: aString contents: contents
        "We can't open a command line debugger, so just log the error and carry on."
        | s |
        s := FileStream stderr.
        s
                nextPutAll: self className;
                nextPutAll: ': ';
                nextPutAll: aString;
                cr;
                nextPutAll: contents;
                cr.
        (aContext stackOfSize: 20) do: [:ctx | ctx printOn: s. s cr].
        s flush.!

----- Method: CommandLineToolSet class>>debugError: (in category 'debugging') -----
debugError: anError
        "Print out a sensible stack trace and bail"
        self saveSnapshotOnError ifTrue: [ Smalltalk saveAs: 'Debug-' , Smalltalk imageEntry name ].
        anError printVerboseOn: FileStream stderr.
        FileStream stderr flush.
        Smalltalk
                snapshot: false
                andQuit: true!

----- Method: CommandLineToolSet class>>debugSyntaxError: (in category 'debugging') -----
debugSyntaxError: anError
        FileStream stderr
                 nextPutAll: '----- Syntax error -----' ;
                 cr ;
                 nextPutAll: anError errorCode ;
                 cr ;
                 nextPutAll: '----- Syntax error -----' ;
                 cr ;
                 flush.
        self debugError: anError!

----- Method: CommandLineToolSet class>>saveSnapshotOnError (in category 'preferences') -----
saveSnapshotOnError
        <preference: 'Save snapshot of image on failure'
        category: 'debug'
        description: 'If true, saves a snapshot of the failing image to the current directory.'
        type: #Boolean>
        ^ SaveSnapshotOnError ifNil: [SaveSnapshotOnError := false].!

----- Method: CommandLineToolSet class>>saveSnapshotOnError: (in category 'preferences') -----
saveSnapshotOnError: aBoolean
        SaveSnapshotOnError := aBoolean.!

----- Method: CommandLineToolSet class>>unload (in category 'class initialization') -----
unload
        ToolSet unregister: self.!