[squeak-dev] [ANN] DoItFirst command line goodie on SqueakSource

David T. Lewis lewis at mail.msen.com
Thu Nov 26 20:00:56 UTC 2020


On Sun, Jun 14, 2020 at 01:15:01PM -0400, David T. Lewis wrote:
> A few cups of coffee this morning led to some enhancements to my DoItFirst
> utility, so I decided to put in on SqueakSource.
> 
>    http://www.squeaksource.com/DoItFirst
>

I have been updating this since the original post, and I think it is
in pretty good shape at this point. Latest version on SqueakSource is
DoItFirst-System-Support-dtl.14.mcz.

In order to make this work properly I also add a couple of references
to DoItFirst from other class startUp methods. That is messy to add to
a MCZ, so I'm attaching a change set containing the latest package plus
the two additional startUp calls.

I think this is clean enough to consider adding to trunk now, so if
folks think it is a good idea, let me know and I'll add it.

To summarize (from the -help command line option):

DoItFirst image arguments:
	-doit argumentlist "evaluate each argument as a doIt expression"
	-evaluate arg "evaluate arg, 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"

Dave
 
-------------- next part --------------
'From Squeak6.0alpha of 13 November 2020 [latest update: #20077] on 26 November 2020 at 1:57:39 pm'!
"Change Set:		DoItFirst-dtl
Date:			26 November 2020
Author:			David T. Lewis

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""
	-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""
"!

Object subclass: #DoItFirst
	instanceVariableNames: 'actions'
	classVariableNames: 'Current'
	poolDictionaries: ''
	category: 'DoItFirst-System-Support'!

!DoItFirst commentStamp: 'dtl 11/16/2020 21:28' 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"
	-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"

!


!Delay class methodsFor: 'snapshotting' stamp: 'dtl 11/14/2020 22:18'!
startUp: resuming
	"Restart active delay, if any, when resuming a snapshot."

	DelaySuspended ifFalse:[^self error: 'Trying to activate Delay twice'].
	DelaySuspended := false.
	self restoreResumptionTimes.
	AccessProtect signal.
	resuming ifTrue: [ DoItFirst reevaluateDebug ].
! !


!DoItFirst methodsFor: 'private' stamp: 'dtl 6/15/2020 17:59'!
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.! !

!DoItFirst methodsFor: 'private' stamp: 'dtl 6/15/2020 17:59'!
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.! !

!DoItFirst methodsFor: 'private' stamp: 'dtl 8/6/2020 20:17'!
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.! !

!DoItFirst methodsFor: 'private' stamp: 'dtl 6/14/2020 12:03'!
isArg: token
	^ token isEmpty not and: [ token beginsWith: '-' ].! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 6/14/2020 12:36'!
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 ]
! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 11/16/2020 21:34'!
debug
	"halt and enter a debugger"
	Halt new signal: self class name, ' inserted break in StartUpList processing'.! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 6/14/2020 12:36'!
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 ]]! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 11/16/2020 20:54'!
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! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 11/16/2020 21:20'!
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 ]]! !

!DoItFirst methodsFor: 'actions' stamp: 'dtl 11/15/2020 15:51'!
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"' .
		'-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 flush.
	Smalltalk quitPrimitive.

! !

!DoItFirst methodsFor: 'evaluating' stamp: 'dtl 11/15/2020 16:08'!
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]! !

!DoItFirst methodsFor: 'evaluating' stamp: 'dtl 11/15/2020 16:08'!
evaluateArgs
	| actionQueue |
	actionQueue := self parse readStream.
	[ actionQueue atEnd ] whileFalse: [ actionQueue next value ].
! !

!DoItFirst methodsFor: 'evaluating' stamp: 'dtl 6/14/2020 12:11'!
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! !

!DoItFirst methodsFor: 'evaluating' stamp: 'dtl 11/16/2020 21:48'!
parse
	"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 := Smalltalk arguments readStream.
	actions := OrderedCollection new.
	[ args atEnd ] whileFalse: [
		args next ifNotNil: [ :next | | nextOption |
			nextOption := (next beginsWith: '--')
				ifTrue: [ next allButFirst ]
				ifFalse: [ next ]. 
			(nextOption caseOf: {
				[ '-help' ] -> [ self addFirst: [ self help ] to: actions at: #help. needsFiles := true] .
				[ '-debug' ] -> [ self addWithoutEvaluation: [ self debug ] at: #debug] .
				[ '-doit' ] -> [ | list | list := self nextTokensFrom: args. self add:[ self doIt: list ] to: actions at: #doit. needsFiles := true] .
				[ '-evaluate' ] -> [ | arg | arg := args next.  self add:[ self evaluateOption: arg ] to: actions at: #evaluate. needsFiles := true] .
				[ '-filein' ] -> [ | list | list := self nextTokensFrom: args. self add:[ self fileIn: list ] to: actions at: #filein. needsFiles := true] .
				[ '-cwd' ] -> [ | arg | arg := args next.  self addFirst:[ self cwd: arg ] to: actions at: #cwd. needsFiles := needsDirectory := true] .
			} otherwise: [] ) ] ].
	needsFiles ifTrue: [ FileStream startUp: true. "initialize stdout and stderr" ].
	needsDirectory ifTrue: [ FileDirectory startUp "set default directory" ].
	^ actions.
! !

!DoItFirst methodsFor: 'initialize-release' stamp: 'dtl 11/14/2020 22:44'!
initialize
	actions := Dictionary new.
! !


!DoItFirst class methodsFor: 'reevaluate options' stamp: 'dtl 11/26/2020 13:29'!
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.! !

!DoItFirst class methodsFor: 'reevaluate options' stamp: 'dtl 11/26/2020 13:30'!
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.! !

!DoItFirst class methodsFor: 'class initialization' stamp: 'dtl 11/26/2020 13:31'!
current
	"Protect against nil in case package was reloaded and existing startUp
	methods refer to the current instance."
	^Current ifNil: [ Current := self new ]! !

!DoItFirst class methodsFor: 'class initialization' stamp: 'dtl 11/16/2020 21:02'!
initialize
	Smalltalk addToStartUpList: self before: SmallInteger.! !

!DoItFirst class methodsFor: 'system startup' stamp: 'dtl 11/15/2020 16:08'!
startUp: resuming
	resuming ifTrue: [ Current := self new. Current evaluateArgs ]
! !


!FileDirectory class methodsFor: 'name utilities' stamp: 'dtl 11/19/2020 21:42'!
startUp
	"Establish the platform-specific FileDirectory subclass. Do any platform-specific startup."
	self setDefaultDirectoryClass.

	self setDefaultDirectory: (self dirPathFor: Smalltalk imageName).

	Preferences startInUntrustedDirectory 
		ifTrue:[	"The SecurityManager may override the default directory to prevent unwanted write access etc."
				self setDefaultDirectory: SecurityManager default untrustedUserDirectory.
				"Make sure we have a place to go to"
				DefaultDirectory assureExistence].
	Smalltalk openSourceFiles.
	(Smalltalk classNamed: #DoItFirst) ifNotNil: [ :cls | cls reevaluateCwd ].
! !

DoItFirst initialize!


More information about the Squeak-dev mailing list