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