The Trunk: System-dtl.1195.mcz

David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.1195.mcz

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

Name: System-dtl.1195
Author: dtl
Time: 8 December 2020, 4:10:40.495367 pm
UUID: 88a0ce82-643e-47c4-83e9-27404ce5f71f
Ancestors: System-eem.1194

Add DoItFirst to be the first thing in the system startup list, processing certain command line options prior to any additional image initialization.
DoItFirst image arguments:
        --doit argumentlist "evaluate each argument as a doIt expression"
        --evaluate arg "evaluate arg, print result then exit"
        --file filename "evaluate contents of filename, print result then exit"
        --filein filelist "file in each file named in fileList"
        --cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"
        --debug "enter a debugger as soon as possible in the startUp processing"
        --help "print this message"
Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit
A single '-' may be used instead of '--', -help is interpreted as --help

=============== Diff against System-eem.1194 ===============

Item was added:
+ Object subclass: #DoItFirst
+ instanceVariableNames: 'actions'
+ classVariableNames: 'Current'
+ poolDictionaries: ''
+ category: 'System-Support'!
+
+ !DoItFirst commentStamp: 'dtl 12/6/2020 14:39' prior: 0!
+ Be the first thing in the system startup list, and do things that should be done prior to any additional image initialization. If the first image argument is a recognized option, evaluate it. Image arguments are typically preceded by a '--' token on the command line.
+
+ DoItFirst image arguments:
+ --doit argumentlist "evaluate each argument as a doIt expression"
+ --evaluate arg "evaluate arg, print result then exit"
+ --file filename "evaluate contents of filename, print result then exit"
+ --filein filelist "file in each file named in fileList"
+ --cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"
+ --debug "enter a debugger as soon as possible in the startUp processing"
+ --help "print this message"
+
+ Some arguments have single character synonyms, -f is a synonym for --file, -d for --doit
+ A single '-' may be used instead of '--', -help is interpreted as --help
+ !

Item was added:
+ ----- Method: DoItFirst class>>current (in category 'class initialization') -----
+ current
+ "Protect against nil in case package was reloaded and existing startUp
+ methods refer to the current instance."
+ ^Current ifNil: [ Current := self new ]!

Item was added:
+ ----- Method: DoItFirst class>>initialize (in category 'class initialization') -----
+ initialize
+ Smalltalk addToStartUpList: self before: SmallInteger.!

Item was added:
+ ----- Method: DoItFirst class>>reevaluateCwd (in category 'reevaluate options') -----
+ reevaluateCwd
+ "If a -cwd option was specified on the command line, reevaluate it now.
+ May be called from FileDirectory class>>startUp: to reevaluate the command line
+ option to ensure that the default directory is ultimately set as specified by the -cwd
+ image command line option."
+
+ ^ self current evaluateArg: #cwd.!

Item was added:
+ ----- Method: DoItFirst class>>reevaluateDebug (in category 'reevaluate options') -----
+ reevaluateDebug
+ "The -debug option cannot be evaluated at DoInNow startUp time, but may be called
+ later in the startUp processing. If -debug was not specified as a command option this
+ method does nothing.
+
+ May be called from Delay>>startup to invoke a debugger at the earliest possible time."
+
+ ^ self current evaluateArg: #debug.!

Item was added:
+ ----- Method: DoItFirst class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ resuming ifTrue: [ Current := self new. Current evaluateArgs ]
+ !

Item was added:
+ ----- Method: DoItFirst>>actions (in category 'private') -----
+ actions
+ ^actions!

Item was added:
+ ----- Method: DoItFirst>>add:to:at: (in category 'private') -----
+ add: valuable to: actionList at: key
+ "Add valuable to the end of action list, and register it at key so that it may
+ be reevaluated at a later time if necessary."
+ actionList addLast: valuable.
+ actions at: key put: valuable.!

Item was added:
+ ----- Method: DoItFirst>>addFirst:to:at: (in category 'private') -----
+ addFirst: valuable to: actionList at: key
+ "Add valuable to the beginning of action list, and register it at key so that it may
+ be reevaluated at a later time if necessary."
+ actionList addFirst: valuable.
+ actions at: key put: valuable.!

Item was added:
+ ----- Method: DoItFirst>>addWithoutEvaluation:at: (in category 'private') -----
+ addWithoutEvaluation: valuable at: key
+ "Register action at key so that it may be reevaluated at a later time. Do not
+ evaluate in the startUp of DoItNow. Used when the action cannot yet be
+ evaluated because it requires startUp processing later in the startup list."
+ actions at: key put: valuable.!

Item was added:
+ ----- Method: DoItFirst>>cwd: (in category 'actions') -----
+ cwd: path
+ "Evaluate arg and print the result on stdout, or error message on stderr.
+ Exit immediately without saving the image."
+ (FileDirectory on: path) exists
+ ifTrue: [ FileDirectory setDefaultDirectory: path ]
+ ifFalse: [ FileStream stderr nextPutAll: path, ': directory does not exist'; lf; flush.
+ Smalltalk quitPrimitive ]
+ !

Item was added:
+ ----- Method: DoItFirst>>debug (in category 'actions') -----
+ debug
+ "halt and enter a debugger"
+ Halt new signal: self class name, ' inserted break in StartUpList processing'.!

Item was added:
+ ----- Method: DoItFirst>>doIt: (in category 'actions') -----
+ doIt: arguments
+ "Evaluate arguments and print the result on stdout, or error message on stderr.
+ Exit the image after any error."
+ arguments do: [ :arg |
+ [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ]]!

Item was added:
+ ----- Method: DoItFirst>>evaluateArg: (in category 'evaluating') -----
+ evaluateArg: actionKey
+ "If actionKey is registered, then evaluate its action. This is intended to allow
+ a previously evaluated option to be reevaluated at a later point in the system
+ startup list if necessary."
+ (actions at: actionKey ifAbsent: []) ifNotNil: [:action | action value]!

Item was added:
+ ----- Method: DoItFirst>>evaluateArgs (in category 'evaluating') -----
+ evaluateArgs
+ | actionQueue |
+ actionQueue := self parse readStream.
+ [ actionQueue atEnd ] whileFalse: [ actionQueue next value ].
+ !

Item was added:
+ ----- Method: DoItFirst>>evaluateFileContents: (in category 'actions') -----
+ evaluateFileContents: fileName
+ "Evaluate the contents of a file and print the result on stdout, or error
+ message on stderr. Exit immediately without saving the image."
+
+ | fs arg |
+ [ [ fs := FileStream oldFileNamed: fileName. ]
+ on: FileDoesNotExistException
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ].
+ arg := fs contentsOfEntireFile.
+ ^ self evaluateOption: arg.
+ ] ensure: [ fs close ].
+ !

Item was added:
+ ----- Method: DoItFirst>>evaluateOption: (in category 'actions') -----
+ evaluateOption: arg
+ "Evaluate option and print the result on stdout, or error message on stderr.
+ Exit immediately without saving the image."
+ [FileStream stdout nextPutAll: (Compiler evaluate: arg) asString; lf; flush]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush ].
+ Smalltalk quitPrimitive!

Item was added:
+ ----- Method: DoItFirst>>fileIn: (in category 'actions') -----
+ fileIn: fileNames
+ "File in each named file. On error, print a message to stderr and exit the image."
+ fileNames do: [ :arg |
+ [ | fs |
+ fs := FileStream oldFileNamed: arg.
+ FileStream stdout nextPutAll: 'file in ', fs name; lf; flush.
+ fs fileIn ]
+ on: Error
+ do: [ :ex | FileStream stderr nextPutAll: ex asString; lf; flush.
+ Smalltalk quitPrimitive ]]!

Item was added:
+ ----- Method: DoItFirst>>help (in category 'actions') -----
+ help
+ FileStream stdout nextPutAll: self class name, ' image arguments:'; lf.
+ { '--doit argumentlist "evaluate each argument as a doIt expression"' .
+ '--evaluate arg "evaluate arg, print result then exit"' .
+ '--file filename "evaluate contents of filename, print result then exit"' .
+ '--filein filelist "file in each file named in fileList"' .
+ '--cwd path "set FileDirectory defaultDirectory to path prior to evaluating other options"' .
+ '--debug "enter a debugger as soon as possible in the startUp processing"'.
+ '--help "print this message"'
+ } do: [ :e | FileStream stdout tab; nextPutAll: e; lf ].
+ FileStream stdout
+ nextPutAll: 'some arguments have single character synonyms, -f is a synonym for --file, -d for --doit'; lf;
+ nextPutAll: 'single ''-'' may be used instead of ''--'', -help is interpreted as --help'; lf;
+ flush.
+ Smalltalk quitPrimitive.
+
+ !

Item was added:
+ ----- Method: DoItFirst>>initialize (in category 'initialize-release') -----
+ initialize
+ actions := Dictionary new.
+ !

Item was added:
+ ----- Method: DoItFirst>>isArg: (in category 'private') -----
+ isArg: token
+ ^ token isEmpty not and: [ token beginsWith: '-' ].!

Item was added:
+ ----- Method: DoItFirst>>keyFor: (in category 'evaluating') -----
+ keyFor: argument
+ "Interpret an argument key from the command line. Be permissive in
+ allowing '-somearg' to be treated as '--somearg', and where possible let
+ '-s' be the single character synonym for '--somearg' "
+ ^ argument caseOf: {
+ "print help to stdout then exit"
+ [ '--help' ] -> [ #help ] .
+ [ '-help' ] -> [ #help ] .
+ [ '-h' ] -> [ #help ] .
+ "enter debugger as soon as possible"
+ [ '--debug' ] -> [ #debug ] .
+ [ '-debug' ] -> [ #debug ] .
+ "evaluate each argument string as a doIt"
+ [ '--doit' ] -> [ #doit ] .
+ [ '-doit' ] -> [ #doit ] .
+ [ '-d' ] -> [ #doit ] .
+ "evaluate expression and exit"
+ [ '--evaluate' ] -> [ #evaluate ] .
+ [ '-evaluate' ] -> [ #evaluate ] .
+ [ '-e' ] -> [ #evaluate ] .
+ "evaluate contents of file and exit"
+ [ '--file' ] -> [ #file ] .
+ [ '-file' ] -> [ #file ] .
+ [ '-f' ] -> [ #file ] .
+ "file in one or more files"
+ [ '--filein' ] -> [ #filein ] .
+ [ '-filein' ] -> [ #filein ] .
+ "change FileDirectory default directory"
+ [ '--cwd' ] -> [ #cwd ] .
+ [ '-cwd' ] -> [ #cwd ] .
+ [ '-c' ] -> [ #cwd ]
+ } otherwise: [ #ignore ].
+ !

Item was added:
+ ----- Method: DoItFirst>>nextTokensFrom: (in category 'evaluating') -----
+ nextTokensFrom:  argumentStream
+ "Next available tokens up to the next parseable argument, for commands
+ that expect an argument list of names or doIt expressions."
+
+ | list |
+ list := OrderedCollection new.
+ [ argumentStream atEnd or: [ self isArg: argumentStream peek ]]
+ whileFalse: [ list add: argumentStream next ].
+ ^ list!

Item was added:
+ ----- Method: DoItFirst>>parse (in category 'evaluating') -----
+ parse
+ "Parse the argument list and answer a list of action selectors to be performed"
+ ^ self parse: Smalltalk arguments.
+ !

Item was added:
+ ----- Method: DoItFirst>>parse: (in category 'evaluating') -----
+ parse: argumentList
+ "Iterate over the argument list, adding action blocks to the actions dictionary.
+ If any action blocks require files or directory initialization send the appropriate
+ startUp message to do it now. Answer a list of option selectors that should be
+ evaluated."
+
+ | args actions needsFiles needsDirectory |
+ needsFiles := needsDirectory := false.
+ args := argumentList readStream.
+ actions := OrderedCollection new.
+ [ args atEnd ] whileFalse: [ | key |
+ (key := self keyFor: args next) caseOf: {
+ [ #help ] -> [ self addFirst: [ self help ] to: actions at: key. needsFiles := true] .
+ [ #debug ] -> [ self addWithoutEvaluation: [ self debug ] at: key] .
+ [ #doit ] -> [ | list | list := self nextTokensFrom: args. self add:[ self doIt: list ] to: actions at: key. needsFiles := true] .
+ [ #evaluate ] -> [ | arg | arg := args next.  self add:[ self evaluateOption: arg ] to: actions at: key. needsFiles := true] .
+ [ #file ] -> [ | arg | arg := args next.  self add:[ self evaluateFileContents: arg ] to: actions at: key. needsFiles := true] .
+ [ #filein ] -> [ | list | list := self nextTokensFrom: args. self add:[ self fileIn: list ] to: actions at: key. needsFiles := needsDirectory := true] .
+ [ #cwd ] -> [ | arg | arg := args next.  self addFirst:[ self cwd: arg ] to: actions at: key. needsFiles := needsDirectory := true] .
+ } otherwise: [] ].
+ needsFiles ifTrue: [ FileStream startUp: true. "initialize stdout and stderr" ].
+ needsDirectory ifTrue: [ FileDirectory startUp "set default directory" ].
+ ^ actions.
+ !