From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 12:44:59 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <name>Scripting</name> <environment>Smalltalk</environment> <private>false</private> <imports> private Smalltalk.* </imports> <category>Scripting Support</category> <attributes> <package>ScriptingSupport</package> </attributes> <class> <name>ScriptRunner</name> <environment>Scripting</environment> <super>Core.Object</super> <private>false</private> none environment myUndeclareds myUndeclaredsImport <imports></imports> <category>Scripting Support</category> <attributes> <package>ScriptingSupport</package> </attributes> </class> <comment> Scripting.ScriptRunner
This is the object to be used as "self" when running scripts. It provides a number of utility methods that scripts can invoke, and has a namespace that includes temporary script variables.
</comment> <class> <name>ScriptingConsole</name> <environment>Scripting</environment> <super>Core.Object</super> <private>false</private> none scriptRunner prompt <imports></imports> <category>Scripting Support</category> <attributes> <package>ScriptingSupport</package> </attributes> </class> <comment> Scripting.ScriptingConsole
This runs the read-eval-print loop from the command line for Smalltalk scripting. Instance Variables: prompt <Boolean> Should we use a prompt when running the interactive console. scriptRunner <ScriptRunner> The thing we will actually use to run the code.
</comment> <class> <name>ScriptingCompilerErrorHandler</name> <environment>Scripting</environment> <super>Kernel.NonInteractiveCompilerErrorHandler</super> <private>false</private> none runner <imports></imports> <category>CommandLine Smalltalk</category> <attributes> <package>ScriptingSupport</package> </attributes> </class> <comment> Scripting.ScriptingCompilerErrorHandler
This is a non-interactive compiler error handler, but does not use the Undeclared Namespace for undeclared variables. Instead it will use the ScriptRunner's namespace. It also will react to ambiguous bindings by just using the preferred one. Instance Variables: runner <ScriptRunner> The script runner who is using this handler. We use this to find environment to use for the undeclared variables.
</comment> <class> <name>ScriptingSystem</name> <environment>Scripting</environment> <super>Core.Subsystem</super> <private>false</private> none scripts scriptName shouldQuit commandLine scriptRunner debug useStandardIn prompt <imports></imports> <category>Scripting Support</category> <attributes> <package>ScriptingSupport</package> </attributes> </class> <comment> Scripting.ScriptingSystem
This handles running smalltalk scripts from the command line. Instance Variables: commandLine <SequenceableCollection> Caches our command line information. debug <Boolean> The value of the debug flag. If true, and there's an error, we become headfull and open a debugger. prompt <Boolean> If in interactive mode, should we issue a prompt, or just stay quiet. scriptName <String | nil> The name of the script we expect to run. scriptRunner <ScriptRunner> The script runner we will use to actually run things. scripts <(Collection of: String)> The set of scripts we will run when we set up this system. shouldQuit <Boolean> Should we quit after we finish running our scripts. useStandardIn <Boolean> This is set if we're told to run a script file, but there is no file. In that case, when we get to that point, read from standard in to find out what to do.
</comment> <methods> Scripting.ScriptRunner <category>convenience</category>
include: fileName "Run the named script." | stream | stream := fileName asFilename readStream. [self fileInFrom: stream] ensure: [stream close]. ^fileName.
print: anObject "A convenience method for printing the object to our output." Stdout print: anObject; flush.
use: parcelName "Ensure that the parcel by this name (either the parcel name, or the file path to it) is loaded." Parcel loadParcelByName: parcelName. ^parcelName.
</methods> <methods> Scripting.ScriptRunner <category>printing</category>
printOn: aStream "We deliberately print ourselves as nothing, so that in interactive scripting, if we call a method on us that returns self, it won't clutter things up. Consider, e.g. (self print: 42)." ^self.
</methods> <methods> Scripting.ScriptRunner <category>compiling</category>
compile: aStream "Compile the text using a compiler error handler that will ignore certain kinds of errors and not try to do anything at all in the GUI." | compiler method source| compiler := Compiler new. source := self skipOverHashBangInScripts: aStream. method := compiler compile: source in: nil allowReceiver: true class: self class environment: self doitEnvironment noPattern: true notifying: nil ifFail: [nil] handler: (ScriptingCompilerErrorHandler new runner: self). method isNil ifFalse: [method sourcePointer: source]. ^method.
doitEnvironment "We run the scripts in a namespace that behaves in a workspace-like way. That is, it imports all namespaces, and we also use it to store any undeclared variables in the scripts." | imports | environment isNil ifFalse: [^environment]. imports := self importsForAllNamespaces. environment := WorkspaceVariablePool new. myUndeclareds := NameSpace new. myUndeclaredsImport := GeneralNameSpaceImport simpleName: 'ScriptUndeclared' in: environment. imports := imports , (Array with: myUndeclaredsImport). environment at: #ScriptUndeclared put: myUndeclareds. environment importsObjects: imports. "A special flag for a quit 'command'." environment at: #quit put: Object new. ^environment
fileInFrom: aStream | method | method := self compile: aStream. method isNil ifTrue: [^nil]. ^[[self performMethod: method] on: DuplicateBindingsError do: [:ex | ex resume: ex suggestedBinding]] on: Error do: [:ex | self reportError: ex].
importsForAllNamespaces | allNamespaces | allNamespaces := Root allNameSpaces copyWithout: Undeclared. ^allNamespaces collect: [:each | GeneralNameSpaceImport pathString: each fullName]
interactiveDebug: anException "Become headfull and open a regular debugger on the exception." | debugger | debugger := Smalltalk at: #DebuggerService ifAbsent: [^false]. HeadlessImage current isHeadless ifTrue: [HeadlessImage current becomeHeadfull]. debugger openOnException: anException. ^true.
reportError: anException "Dump the error out to the transcript using the verbose form we get from the debugger, but truncating the stack to only print from the unbound method that is the script forward." ScriptingSystem current debug ifTrue: [(self interactiveDebug: anException) ifTrue: [^self]]. HeadlessImage current dumpStackToTranscriptUsingDebuggerService: anException initialContext label: anException description stopWhen: [:each | each method isBlockMethod not and: [each method selector = #unboundMethod]]. anException return: nil.
skipOverHashBangInScripts: aStream "Given a stream, and if it's at the beginning, if we see it starts with #!, skip to the end of that line, assuming this is the Unix convention of having a line like #!visual " aStream position = 0 ifFalse: [^aStream contents]. aStream peek = $# ifFalse: [^aStream contents]. aStream next. aStream peek = $! ifFalse: [aStream reset. ^aStream contents]. aStream skipThrough: Character cr. ^aStream upToEnd.
updateImports "Update the doitEnviornment's list of imports. #addImport will not add pre-existing imports." environment isNil ifTrue: [^self]. self importsForAllNamespaces do: [:import | environment addImport: import]. "Make sure our undeclared list comes last." environment removeImport: myUndeclaredsImport. environment addImport: myUndeclaredsImport.
</methods> <methods> Scripting.ScriptRunner <category>accessing</category>
myUndeclareds ^myUndeclareds
myUndeclareds: aNamespace myUndeclareds := aNamespace
</methods> <methods> Scripting.ScriptingConsole <category>running</category>
bannerString ^'Welcome to the interactive Smalltalk console'.
commandLoop prompt ifTrue: [Stdout nextPutAll: self bannerString; flush]. [true] whileTrue: [prompt ifTrue: [Stdout nextPutAll: '] '; flush]. self runCommand: self getNextLine].
getNextLine "Grab the next line from Stdin. If it ends with a \, then keep appending the next line to it. Otherwise evaluate it." | line nextLine continued | line := ''. Stdin atEnd ifTrue: [ObjectMemory quit]. [nextLine := Stdin through: Character cr. continued := (nextLine size > 1) and: [(nextLine at: nextLine size - 1) = self lineContinuationCharacter]. continued ifTrue: [nextLine := nextLine copyFrom: 1 to: nextLine size - 2]. line := line , nextLine. continued] whileTrue. ^line.
lineContinuationCharacter ^$\.
printResult: anObject "Print the resulting of executing the command. In most cases this is just the printString, but optimize the special cases of self and Transcript" | string | string := self specialCasePrintStringFor: anObject. prompt ifTrue: [Stdout nextPutAll: '=> ']. Stdout nextPutAll: string. Stdout cr
runCommand: aString "Run the command, and if there's an error, dump a stack. This is probably redundant for most cases, because the scriptRunner also handles errors, but will catch, for example, errors in printString-ing the value." [| value | value := scriptRunner fileInFrom: aString readStream. self printResult: value] on: UnhandledException do: [:ex | scriptRunner reportError: ex].
specialCasePrintStringFor: anObject "If we have a special way of printing some object, or something special to do when we print the object, check for it here." anObject == Transcript ifTrue: [^'Transcript']. "If this is the special quit flag, and the value of that variable hasn't been changed, then quit the image." (anObject class == Object and: [anObject == (scriptRunner doitEnvironment at: #quit)]) ifTrue: [ObjectMemory quit]. ^anObject printString.
</methods> <methods> Scripting.ScriptingConsole <category>accessing</category>
prompt ^prompt
prompt: anObject prompt := anObject
</methods> <methods> Scripting.ScriptingConsole <category>initialize-release</category>
initialize scriptRunner := ScriptRunner new. prompt := true.
</methods> <methods> Scripting.ScriptingConsole class <category>instance creation</category>
new ^super new initialize.
</methods> <methods> Scripting.ScriptingCompilerErrorHandler <category>accessing</category>
runner ^runner.
runner: scriptRunner runner := scriptRunner
</methods> <methods> Scripting.ScriptingCompilerErrorHandler <category>error handling</category>
addBindingFor: association association key: association key asSymbol. runner myUndeclareds simpleAddBinding: association. (runner myUndeclareds bindingFor: association key) value: association value. ^true.
duplicateBindings: varName in: node from: codeStream "For duplicate bindings, just use the one the system suggests." ^[runner doitEnvironment bindingFor: varName] on: DuplicateBindingsError do: [:ex | ex return: ex suggestedBinding].
syntaxError: message at: sourcePosition "On a syntax error, print the source code with the indicator to the output rather than the default of bringing up a window." | errorText | source reset. errorText := WriteStream on: String new. errorText nextPutAll: 'ERROR: '; nextPutAll: (source next: sourcePosition - 1); space; nextPutAll: message; nextPutAll: source upToEnd; cr; nextPutAll: '--------------------------------------------------------------------'; cr. HeadlessImage current stackDumpStream nextPutAll: errorText contents; flush. ^self abort.
undeclared: association in: node from: codeStream "Automatically declare variables into the scriptRunner's namespace." ^[self addBindingFor: association] on: Error do: [:ex | super undeclaredStore: association in: node from: codeStream].
undeclaredStore: association in: assignNode from: codeStream "Automatically declare variables into the scriptRunner's namespace." ^[self addBindingFor: association] on: Error do: [:ex | super undeclaredStore: association in: assignNode from: codeStream]
</methods> <methods> Scripting.ScriptingSystem <category>initialize/release</category>
initialize super initialize. self reset.
</methods> <methods> Scripting.ScriptingSystem <category>accessing</category>
argumentsVariableName "Return the variable name under which we will store the script's arguments (if any) in the namespace in which the script runs." ^'arguments'.
commandLine: anObject commandLine := anObject
debug ^debug
debug: anObject debug := anObject
noPrompt prompt := false.
prompt ^prompt
prompt: aBoolean prompt := aBoolean
scriptName ^scriptName
scriptName: aString scriptName := aString
scriptRunner scriptRunner isNil ifTrue: [scriptRunner := ScriptRunner new]. ^scriptRunner.
scriptRunner: aScriptRunner scriptRunner := aScriptRunner.
scripts "Return our list of scripts. The lazy initialization is important, because 7.5 or earlier with non-shadow loading can cause incorrect initialization when the current system is reset on each instanceMethodsChanged." ^scripts isNil ifTrue: [scripts := #()] ifFalse: [scripts]
shouldQuit "Return a variable indicating if we should quit the image when this system finishes setting up. The lazy initialization is important, because 7.5 or earlier with non-shadow loading can cause incorrect initialization when the current system is reset on each instanceMethodsChanged." ^shouldQuit isNil ifTrue: [shouldQuit := false] ifFalse: [shouldQuit]
shouldQuit: aBoolean shouldQuit := aBoolean
</methods> <methods> Scripting.ScriptingSystem <category>private-activate/deactivate</category>
commandLine "We want the full command line, rather than the one we've overridden in the normal Subsystem code." commandLine isNil ifTrue: [ commandLine := CEnvironment commandLine]. ^commandLine.
findCommandLineScript "Look at the command line for file names directly following the image name when there is no '--' command-line option ." | position argument | position := CommandLineInterest new findStartPositionForImageOptionsIn: self commandLine. position > self commandLine size ifTrue: [^self]. argument := self commandLine at: position . (argument notEmpty and: [(argument first ~= $-) and: ['*.st' match: argument]]) ifTrue: [ scriptName := argument. self scriptRunner doitEnvironment at: self argumentsVariableName put: (self commandLine copyFrom: position + 1 to: self commandLine size). shouldQuit := true].
runActivationActions self findCommandLineScript. super runActivationActions.
runScript: aFilename | stream | [stream := (aFilename asFilename withEncoding: #Source) readStream. self scriptRunner fileInFrom: stream] ensure: [stream close].
</methods> <methods> Scripting.ScriptingSystem <category>default actions</category>
checkScriptFile scriptName isNil ifTrue: [^self]. scriptName asFilename definitelyExists ifFalse: [ HeadlessImage current stackDumpStream nextPutAll: 'smalltalk: No such file or directory -- ', scriptName. HeadlessImage current stackDumpStream cr; cr; flush. scriptName := nil].
pauseAction "If we're about to save the image, clear out our script options." super pauseAction. self reset.
quitIfAppropriate "If we're at a point where we should now quit the image (because the shouldQuit variable has been set by someone) then quit." self shouldQuit ifTrue: [ObjectMemory quit].
reset "Reset our variables to make sure we don't somehow save the image with values in them that would be re-run on startup or re-activation of this sytem." scriptName := nil. scripts := OrderedCollection new. shouldQuit := false. commandLine := nil. scriptRunner := ScriptRunner new. debug := false. useStandardIn := false. prompt := true.
setUp "On setup, run our scripts, either from the command line directly, or from files. If we've run some, then quit the image." super setUp. self checkScriptFile. [scriptName isNil ifFalse: [self runScript: scriptName]. useStandardIn ifTrue: [self scriptRunner fileInFrom: Stdin]. self scripts do: [:each | self scriptRunner fileInFrom: each readStream]] ensure: [self quitIfAppropriate. self reset].
</methods> <methods> Scripting.ScriptingSystem <category>command line options</category>
runInteractiveConsole "Start an interactive console" | interpreter | interpreter := ScriptingConsole new. interpreter prompt: self prompt. interpreter commandLoop.
</methods> <methods> Scripting.ScriptingSystem <category>prerequisites</category>
prerequisiteSystems ^Array with: RuntimeSystem.
</methods> <methods> Scripting.ScriptingSystem class <category>initialize-release</category>
disableHeadlessTranscriptToFile HeadlessImage current transcriptToFileHeadless: false.
disableHeadlessTranscriptToStdout HeadlessImage current transcriptToStandardOutHeadless: false.
initialize "self initialize" self setUpOutput. (Parcel dependents includes: self) ifFalse: [Parcel addDependent: self]. (ChangeSet dependents includes: self) ifFalse: [ChangeSet addDependent: self]. super initialize.
obsolete Parcel removeDependent: self. ChangeSet removeDependent: self. super obsolete.
postLoad: aParcel "We have been loaded. Our initialization may not get called until much later, if at all, and we need to do these steps early, in case we're being loaded from a parcel." super postLoad: aParcel. self setUpOutput. (ChangeSet dependents includes: self) ifFalse: [ChangeSet addDependent: self].
redirectStackDumpsToStderr HeadlessImage current stackDumpStream: Stderr.
setUpOutput self disableHeadlessTranscriptToFile. self disableHeadlessTranscriptToStdout. self redirectStackDumpsToStderr.
</methods> <methods> Scripting.ScriptingSystem class <category>image preparation</category>
prepareScriptingImage "Save our an image under the name smalltalk.im which runs headless and will run scripting commands when started up." " ScriptingSystem prepareScriptingImage " self setUpOutput. ^HeadlessImage current saveHeadless: true to: 'smalltalk'.
</methods> <methods> Scripting.ScriptingSystem class <category>updating</category>
update: aSymbol with: arguments from: anObject "If a namespace is added, add it to our imports, if we have a scriptRunner already set up." (#(#parcelLoaded #parcelUpdated #loadParcel: #addNameSpace:attributes:) includes: aSymbol) ifTrue: [ self current scriptRunner isNil ifFalse: [ self current scriptRunner updateImports]].
</methods> <methods> Core.Association <category>scripting</category>
& anObject "Create a new collection with anObject appended to it. When sent to an object (including a string), create a new collection containing the two objects. That is, don't concatenate the strings. When sent to an association, it constructs a dictionary. In other cases it creates an Array. #('zero') & 'one' Dictionary new & (3->4) (3->4) & (5->6) 1 & 2 'abc' & 'def' " ^Dictionary with: self with: anObject.
</methods> <methods> Core.Collection <category>scripting</category>
& anObject "Create a new collection with anObject appended to it. When sent to an object (including a string), create a new collection containing the two objects. That is, don't concatenate the strings. When sent to an association, it constructs a dictionary. In other cases it creates an Array. #('zero') & 'one' Dictionary new & (3->4) (3->4) & (5->6) 1 & 2 'abc' & 'def' " ^self copyWith: anObject.
</methods> <methods> Core.Collection <category>adding</category>
copyWith: anObject ^self copy add: anObject; yourself.
</methods> <methods> Core.HeadlessImage <category>accessing</category>
stackDumpStream (stackDumpStream isNil or: [(stackDumpStream respondsTo: #closed) and: [stackDumpStream closed]]) ifTrue: [^Transcript]. ^stackDumpStream
</methods> <methods> Core.Subsystem <category>private-activate/deactivate</category>
basicCommandLine ^CEnvironment commandLine.
commandLine "We force the command line for other subsystems so that they ignore the script arguments, and the script can define it's own things that shadow base system command-line options if it wants to." ^self basicCommandLine readStream upTo: '--'.
</methods> <methods> Core.Object <category>scripting</category>
& anObject "Create a new collection with anObject appended to it. When sent to an object (including a string), create a new collection containing the two objects. That is, don't concatenate the strings. When sent to an association, it constructs a dictionary. In other cases it creates an Array. #('zero') & 'one' Dictionary new & (3->4) (3->4) & (5->6) 1 & 2 'abc' & 'def' " ^Array with: self with: anObject.
</methods> <methods> Kernel.CompilerErrorHandler <category>initialize-release</category>
environment ^environment.
</methods> <methods> Kernel.DuplicateBindingsError <category>constants</category>
defaultResumeValue "We want to be able to use the suggested binding as the default when we force a resume, not just when the defaultAction runs." ^suggestedBinding.
</methods> <methods> Core.CharacterArray <category>scripting</category>
& anObject "Create a new collection with anObject appended to it. When sent to an object (including a string), create a new collection containing the two objects. That is, don't concatenate the strings. If you want concatenation, use the $, operator. However, strings are treated specially in that if you & a string and a character, you treat the string as a collection and build a new one including that character. In all other cases, building a new string and concatenating would fail, so we fall back to the object treatment. This is intended for scripting, so we try to do what you mean at the expense of consistency. When sent to an association, it constructs a dictionary. In other cases it creates an Array. #('zero') & 'one' Dictionary new & (3->4) (3->4) & (5->6) 1 & 2 'abc' & 'def' 'abc' & $d 'abc' & 4 " ^anObject class == Character ifTrue: [self , (Array with: anObject)] ifFalse: [Array with: self with: anObject].
</methods> <methods> Scripting.ScriptingSystem <category>command line options</category>
e: argumentStream "Run the (single-line) argument. " <option: '-e'> scriptName := nil. scripts add: argumentStream next. shouldQuit := true.
help: argumentStream "Print our help for our options." <option: '-h'> | stream | stream := HeadlessImage current stackDumpStream. stream nextPutAll: 'Usage: vm scripting.im [switches] [--] [programfile] [arguments]'. stream cr; nextPutAll: ' -e ''command'' One line of script. Several -e''s allowed. Omit programfile]'. stream cr; nextPutAll: ' -h ''command'' Print this help.'. stream cr; nextPutAll: ' -i Start an interactive console'. stream cr; nextPutAll: ' -noprompt If in interactive mode, run with no prompt. Otherwise ignored.'. stream cr; nextPutAll: ' -debug If we get an error, open a GUI debugger'. stream cr; nextPutAll: ' -nodebug If we get an error, do not open a GUI debugger (the default)'. stream cr; nextPutAll: ' -- Indicates the program file to run. If none, read from stdin.'. stream cr; cr; flush. shouldQuit := true.
interactive: argumentStream "Start an interactive console" <option: '-i'> scripts add: 'ScriptingSystem current runInteractiveConsole'.
noPrompt: argumentStream "If running an interactive console, don't have a prompt. This is useful for piping in scripts that are to be run line by line." <option: '-noPrompt'> <option: '-noprompt'> self noPrompt.
script: argumentStream "The item following -- in the command line is treated as the program file to run. If there's nothing following, we read standard in for the program." <option: '--'> scriptName := argumentStream next. scriptName isNil ifTrue: [useStandardIn := true]. self scriptRunner doitEnvironment at: self argumentsVariableName put: argumentStream upToEnd. shouldQuit := true.
shouldDebug: argumentStream "Open a debugger when we get an error." <option: '-debug'> debug := true.
shouldNotDebug: argumentStream "Don't open a debugger when we encounter an error." <option: '-nodebug'> debug := false.
</methods> <initialize> Scripting.ScriptingSystem </initialize> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>Collection</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none <imports></imports> <category>Collections-Abstract</category> <attributes> <package>Collections-Abstract</package> </attributes> </class> <class> <name>DuplicateBindingsError</name> <environment>Kernel</environment> <super>Core.Error</super> <private>false</private> none suggestedBinding ambiguousReferencesExist <imports></imports> <category>System-Name Spaces</category> <attributes> <package>System-Name Spaces</package> </attributes> </class> <class> <name>Subsystem</name> <environment>Core</environment> <super>Core.Object</super> <private>false</private> none state canActivate prerequisites current <imports></imports> <category>System-Subsystems</category> <attributes> <package>System-Subsystems</package> </attributes> </class> <class> <name>HeadlessImage</name> <environment>Core</environment> <super>Core.Subsystem</super> <private>false</private> none isTerminating startupFilename transcriptFilename currentlyHeadless shouldSaveHeadless transcriptToStandardOut transcriptToStandardOutHeadless transcriptToFile transcriptToFileHeadless suspendedProcesses stackDumpStream <imports></imports> <category>Headless-Support</category> <attributes> <package>Headless</package> </attributes> </class> <class> <name>CompilerErrorHandler</name> <environment>Kernel</environment> <super>Core.Object</super> <private>false</private> none failBlock retryBlock class selector errorHandlers environment <imports></imports> <category>System-Compiler-Support</category> <attributes> <package>System-Compiler-Support</package> </attributes> </class> <class> <name>NonInteractiveCompilerErrorHandler</name> <environment>Kernel</environment> <super>Kernel.CompilerErrorHandler</super> <private>false</private> none source <imports></imports> <category>System-Compiler-Support</category> <attributes> <package>System-Compiler-Support</package> </attributes> </class> <class> <name>Association</name> <environment>Core</environment> <super>Core.LookupKey</super> <private>false</private> none value <imports></imports> <category>Collections-Support</category> <attributes> <package>Collections-Support</package> </attributes> </class> <class> <name>CharacterArray</name> <environment>Core</environment> <super>Core.ArrayedCollection</super> <private>false</private> none <imports></imports> <category>Collections-Text</category> <attributes> <package>Collections-Text</package> </attributes> </class>