#REFACTORING by exept
class: Smalltalk class
changed: #recursiveInstallAutoloadedClassesFrom:rememberIn:maxLevels:noAutoload:packageTop:showSplashInLevels:
Transcript showCR:(... bindWith:...) -> Transcript showCR:... with:...
"{ Encoding: utf8 }"
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
Object subclass:#ReadEvalPrintLoop
instanceVariableNames:'stdin stdout stderr inputStream outputStream errorStream compiler
prompt doChunkFormat traceFlag timingFlag profilingFlag printFlag
exitAction currentDirectory lastEditedClass lastEditedSelector
editorCommand confirmDebugger noDebugger debuggerUsed
returnValuePrinting returnValuePrompt defaultPackagePrefix
answerPrompt'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
!
!ReadEvalPrintLoop class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
A simple read-eval-print loop for non-GUI or stscript operation.
Invoked, for example if stx is started with a --repl argument,
or by the MiniDebugger with the 'I' command.
A line starting with '?' shows the usage message.
Lines starting with '#' are directives:
#exit - exit the rep-loop
#show ... - show various infos
#use package - show various infos
type '?' to see more.
The input can be in one of two formats:
1) traditional chunk format (bang-separated chunks, bangs duplicated)
this is the traditional fileIn format, as generated by fileOut from the browser
2) interactive line mode. Chunks are any number of lines up to either an empty line or
a line ending in a period. This is more useful for an interactive REPL, where statements/expressions
are entered linewise by a user.
The input can is switched to non-chunk format whenever a line with a '#' in the first column appears.
Try it (but only if you have a console):
Smalltalk readEvalPrintLoop
[Author:]
Claus Gittinger
"
! !
!ReadEvalPrintLoop methodsFor:'accessing'!
answerPrompt
"the string shown before the answer"
^ answerPrompt ? '-> (Answer): '
!
answerPrompt:aString
"set the string shown before the answer"
answerPrompt := aString.
!
compiler:something
"assign a compiler to use;
can be used to change the language"
compiler := something.
!
confirmDebugger
"true if the user is asked for a debugger in case of errors"
^ confirmDebugger ? true
!
confirmDebugger:aBoolean
"true if the user is asked for a debugger in case of errors"
confirmDebugger := aBoolean
!
debuggerUsed
"by default, the miniDebugger is given control in case of an error;
you may want to write (subclass) your own ;-)"
^ debuggerUsed ? MiniDebugger
!
debuggerUsed:aDebuggerClass
"by default, the miniDebugger is given control in case of an error;
you may want to write (subclass) your own ;-)"
debuggerUsed := aDebuggerClass
!
defaultPackagePrefix
"a default to be prepended to #use packages"
^ defaultPackagePrefix ? 'stx:'
!
defaultPackagePrefix:aStringOrNil
"a default to be prepended to #use packages"
defaultPackagePrefix := aStringOrNil
!
doChunkFormat
"true if currently reading chunk format"
^ doChunkFormat ? true
"Created: / 07-12-2006 / 18:24:04 / cg"
!
doChunkFormat:aBoolean
"enable/disable chunk format"
doChunkFormat := aBoolean.
"Created: / 07-12-2006 / 18:24:04 / cg"
!
editorCommand
"the editor command to use with the #edit directive.
Uses the STX_EDITOR or EDITOR shell variables' value, if defined;
if not, the value in the classvar EDITORCOMMAND if non-nil;
otheriwse vi (notepad on windows)"
|editor|
(editor := editorCommand) isNil ifTrue:[
editor := OperatingSystem getEnvironment:'STX_EDITOR'.
editor isNil ifTrue:[
editor := OperatingSystem getEnvironment:'EDITOR'.
editor isNil ifTrue:[
OperatingSystem isMSWINDOWSlike ifTrue:[
editor := 'notepad'.
] ifFalse:[
editor := 'vi'.
].
].
].
].
^ editor
"Created: / 08-11-2016 / 22:45:22 / cg"
"Modified: / 24-06-2017 / 09:54:10 / cg"
!
errorStream
"return the current error stream"
errorStream notNil ifTrue:[^ errorStream].
^ Processor activeProcess stderr
"Created: / 07-12-2006 / 19:12:27 / cg"
!
errorStream:aStream
"assign an error stream"
errorStream := stderr := aStream.
"Created: / 07-12-2006 / 17:33:39 / cg"
!
input:aStream
<resource: #obsolete>
"assign an input stream"
inputStream := stdin := aStream asLineNumberReadStream.
"Modified: / 07-12-2006 / 17:33:31 / cg"
!
inputStream
"get the current input stream"
inputStream notNil ifTrue:[^ inputStream].
^ Processor activeProcess stdin
"Created: / 07-12-2006 / 19:12:13 / cg"
!
inputStream:aStream
"assign an input stream"
inputStream := stdin := aStream asLineNumberReadStream.
"Modified: / 07-12-2006 / 17:33:31 / cg"
!
noDebugger
"true if no debugger should be activated on errors (aborts)"
^ noDebugger ? false
!
noDebugger:aBoolean
"true if no debugger should be activated on errors (aborts)"
noDebugger := aBoolean
!
output:aStream
<resource: #obsolete>
"assign an output stream"
outputStream := stdout := aStream.
"Created: / 07-12-2006 / 17:27:48 / cg"
!
outputStream
"return the current output stream"
outputStream notNil ifTrue:[^ outputStream].
^ Processor activeProcess stdout
"Created: / 07-12-2006 / 19:12:27 / cg"
!
outputStream:aStream
"assign an output stream"
outputStream := stdout := aStream.
"Created: / 07-12-2006 / 17:27:48 / cg"
!
printFlag
"true if the return value of expressions should be printed"
^ printFlag ? true
!
printFlag:aBoolean
"true if the return value of expressions should be printed"
printFlag := aBoolean
!
prompt:aString
"set the string shown as prompt"
prompt := aString.
! !
!ReadEvalPrintLoop methodsFor:'compiler interface-error handling'!
correctableError:message position:pos1 to:pos2 from:aCompiler
"compiler notifies us of an error - ignore it"
^ false "/ no correction
!
correctableSelectorWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ false
!
correctableWarning:message position:pos1 to:pos2 from:aCompiler
"compiler notifies us of an error - ignore it"
^ false
"Created: / 02-11-2010 / 13:29:22 / cg"
!
error:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
self error:('Syntax Error: ',aString).
!
unusedVariableWarning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ false
!
warning:aString position:relPos to:relEndPos from:aCompiler
"compiler notifies us of a warning - ignore it"
^ self
! !
!ReadEvalPrintLoop methodsFor:'directives'!
askYesNo:message
stderr show:message.
^ (self inputStream nextLine withoutSeparators startsWith:'y').
!
cmd_apropos:lineStream
"apropos directive; i.e.
#apropos collection [;more]
"
|words classNamesMatching selectorsMatching showList|
lineStream skipSeparators.
words := lineStream upToEnd asCollectionOfSubstringsSeparatedBy:$;.
words := words select:[:each | each notEmpty].
words := words select:[:each | each isBlank not].
(words isEmpty) ifTrue:[
stderr showCR:'? usage: #apropos <word> [; morewords]'.
^ self.
].
"/ search in classes:
classNamesMatching := Smalltalk allClasses
select:[:cls |
cls isPrivate not
and:[ words conform:[:word |
cls name matches:word caseSensitive:false]]]
thenCollect:#name.
"/ search in method names:
selectorsMatching := (Smalltalk allClasses
collectAll:[:cls |
cls isPrivate
ifTrue:[#()]
ifFalse:[
cls selectors
select:[:sel |
words conform:[:word |
sel matches:word caseSensitive:false]]]]
) asSet.
showList :=
[:list :listName |
|showIt sortedList longest limit numCols colWidth|
showIt := true.
list notEmpty ifTrue:[
list size > 20 ifTrue:[
showIt := self askYesNo:(
'apropos: there are %1 matching %2; list them all (y/n)? '
bindWith:list size
with:listName)
] ifFalse:[
stderr showCR:'matching %1:' with:listName.
].
showIt ifTrue:[
sortedList := list asOrderedCollection sort.
longest := (list collect:[:nm | nm size]) max.
limit := 78.
numCols := (80 // (longest min:limit)) max:1.
colWidth := (longest min:limit).
sortedList slicesOf:numCols do:[:eachGroupOfN |
stderr
spaces:2;
nextPutLine:(
(eachGroupOfN
collect:[:nm |
(nm contractTo:colWidth) paddedTo:colWidth
]
) asStringWith:' ').
].
].
].
].
showList value:classNamesMatching value:'classes'.
showList value:selectorsMatching value:'method names'.
"
self basicNew
input:Stdin;
cmd_apropos:'Array' readStream
self basicNew
input:Stdin;
cmd_apropos:'at:' readStream
self basicNew
input:Stdin;
cmd_apropos:'*at:' readStream
"
!
cmd_break:lineStream
"breakpoint directive; i.e.
#break <classname> ['class'] <selector>
"
|answer class selectorString selector method implClass|
answer := self
getClassNameAndSelectorFrom:lineStream
specialWords:#('all')
into:[:classArg :selectorArg |
class := classArg.
selectorString := selectorArg.
].
(answer == false) ifTrue:[^ self].
(answer = 'all') ifTrue:[
^ self
].
(selectorString isEmptyOrNil) ifTrue:[
stderr nextPutLine:'usage: #break <className> [class] <selector>'.
^ self.
].
(selector := selectorString asSymbolIfInterned) isNil ifTrue:[
stderr show:'no implementation of selector: '; showCR:selectorString.
^ self.
].
"/ stderr show:'class: '; showCR:class.
"/ stderr show:'selector: '; showCR:selector.
(method := class compiledMethodAt:selector) isNil ifTrue:[
implClass := class whichClassImplements:selector.
implClass isNil ifTrue:[
(class isMeta not and:[(implClass := class theMetaclass whichClassImplements:selector) notNil]) ifTrue:[
stderr nextPutLine:('no such method\(but found one on the class-side; try "#break %1 %2")' withCRs
bindWith:implClass name with:selector).
] ifFalse:[
stderr nextPutLine:'no such method'.
].
^ self.
].
(self askYesNo:('no such method in %1, but inherited from %2.\Add breakpoint there (y/n)?' withCRs
bindWith:class name with:implClass name)) ifFalse:[
^ self
].
method := implClass compiledMethodAt:selector.
].
MessageTracer trapMethod:method.
stderr nextPutLine:'breakpoint set. Use #delete to remove.'.
"
self basicNew
input:Stdin;
cmd_list:'Array' readStream
self basicNew
input:Stdin;
cmd_list:'Array at:put:' readStream
self basicNew
input:Stdin;
cmd_list:'ReadEvalPrintLoop doIt' readStream
"
!
cmd_clear:lineStream
self cmd_setOrClear:lineStream to:false
"Created: / 07-12-2006 / 19:04:50 / cg"
!
cmd_debug:lineStream
MiniDebugger enter.
!
cmd_delete:lineStream
"breakpoint delete directive; i.e.
#delete <classname> ['class'] <selector>
#delete <classname>
#delete all
"
|class selector method answer count|
answer := self
getClassNameAndSelectorFrom:lineStream
specialWords:#('all')
into:[:classArg :selectorArg |
class := classArg.
selector := selectorArg.
].
(answer == false) ifTrue:[
stderr nextPutLine:'usage: #delete <className> [class] <selector>'.
stderr nextPutLine:' or: #delete <className> [class]'.
stderr nextPutLine:' or: #delete all'.
^ self
].
(answer = 'all') ifTrue:[
MessageTracer unwrapAllMethods.
^ self
].
selector notNil ifTrue:[
(method := class compiledMethodAt:selector asSymbol) isNil ifTrue:[
stderr nextPutLine:'no such method'.
^ self.
].
MessageTracer unwrapMethod:method.
stderr nextPutLine:'breakpoint removed.'.
^ self.
].
count := 0.
class instAndClassMethodsDo:[:m |
m isWrapped ifTrue:[
MessageTracer unwrapMethod:m.
count := count + 1.
].
].
stderr nextPutLine:('%1 breakpoints removed.' bindWith:count).
"
self basicNew
input:Stdin;
cmd_list:'Array' readStream
self basicNew
input:Stdin;
cmd_list:'Array at:put:' readStream
self basicNew
input:Stdin;
cmd_list:'ReadEvalPrintLoop doIt' readStream
"
!
cmd_edit:lineStream
"edit a class or selector in an external editor"
|classOrMethodName cls methodName selector
code isNewClass editFullClass tmpFile modifiedTime|
isNewClass := editFullClass := false.
lineStream skipSeparators.
lineStream atEnd ifTrue:[
cls := lastEditedClass.
methodName := lastEditedSelector.
] ifFalse:[
classOrMethodName := lineStream
upToElementForWhich:[:ch |
ch isLetterOrDigit not and:[ch ~~ $_]
].
"/
(classOrMethodName isUppercaseFirst) ifTrue:[
(cls := Smalltalk classNamed:classOrMethodName) isNil ifTrue:[
stderr show:'edit: no such class: ',classOrMethodName,' ; create (y/n)? '.
(self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
isNewClass := true.
code :=
'"/ change the code as required, then save and exit the editor.
"/ To cancel this edit, leave the editor WITHOUT saving.
"/
Object
subclass:#%1
instanceVariableNames:''''
classVariableNames:''''
poolDictionaries:''''
category:''user classes''
' bindWith:classOrMethodName.
] ifFalse:[
lineStream skipSeparators.
lineStream atEnd ifFalse:[
methodName := lineStream upToSeparator.
methodName = 'class' ifTrue:[
cls := cls theMetaclass.
lineStream skipSeparators.
methodName := lineStream upToSeparator.
].
].
].
] ifFalse:[
methodName := classOrMethodName
].
].
isNewClass ifFalse:[
cls := cls ? lastEditedClass.
cls isNil ifTrue:[
stderr showCR:'edit usage:'.
stderr showCR:' #edit className selector'.
stderr showCR:' #edit className '.
stderr showCR:' #edit selector (class as in previous edit)'.
stderr showCR:' #edit (class/method as in previous edit)'.
^ self.
].
lastEditedClass := cls.
lastEditedSelector := methodName.
methodName isNil ifTrue:[
editFullClass := true.
code := cls source asString
] ifFalse:[
((selector := methodName asSymbolIfInterned) isNil
or:[ (cls implements:selector) not]) ifTrue:[
(self askYesNo:('"',methodName,'" is a new method; create (y/n)? ')) ifFalse:[^ self].
code :=
'"/ change the code as required, then save and exit the editor.
"/ To cancel this edit, leave the editor WITHOUT saving.
%1
"this is a new method"
self halt
' bindWith:methodName.
] ifFalse:[
code := (cls compiledMethodAt:selector) source.
].
].
].
[
|ok cmd|
tmpFile := Filename newTemporary.
tmpFile contents:code.
modifiedTime := tmpFile modificationTime.
cmd := '%1 "%2"'.
OperatingSystem isUNIXlike ifTrue:[
cmd := '%1 "%2" </dev/tty >/dev/tty 2>&1'.
].
ok := OperatingSystem
executeCommand:(cmd bindWith:(self editorCommand) with:tmpFile pathName)
inputFrom:Stdin
outputTo:Stdout
errorTo:Stderr
auxFrom:nil
environment:nil
inDirectory:nil
lineWise:false
newPgrp:false
showWindow:true
onError:[:status | false].
(ok and:[tmpFile modificationTime ~= modifiedTime]) ifTrue:[
isNewClass ifTrue:[
Compiler evaluate:tmpFile contentsOfEntireFile.
stderr showCR:'Class (re)defined.'
] ifFalse:[
editFullClass ifTrue:[
tmpFile fileIn.
stderr showCR:'Class (re)compiled.'
] ifFalse:[
cls compile:tmpFile contentsOfEntireFile classified:'*as yet uncategorized'.
stderr showCR:'Method (re)compiled.'
].
].
] ifFalse:[
stderr showCR:'No change.'
].
] ensure:[
tmpFile notNil ifTrue:[
tmpFile remove
]
].
"
Smalltalk readEvalPrintLoop
self new
input:Stdin;
cmd_edit:'MyClass foo' readStream
self new
input:Stdin;
cmd_edit:'Array class new:' readStream
"
"Modified: / 08-11-2016 / 22:46:12 / cg"
!
cmd_exit:lineStream
"exit directive - leaves the repl"
exitAction value
"Created: / 07-12-2006 / 18:55:46 / cg"
!
cmd_help:lineStream
stderr
nextPutAll:
'Everything entered up to an empty line or a line ending in "." is called a "chunk" and evaluated.
Lines ending with "\” prevent the above.
Lines starting with "#" (in the first column) are commands to the read-eval-print interpreter.
Valid commands are:
', (OperatingSystem isOSXlike ifTrue:[
' #qFix ............... fix locked xQuartz display (hack)
' ] ifFalse:['']) ,
' #exit ............... exit interpreter loop
#help ............... this text
#usage .............. command line arguments
#ide ................ open the IDE
#apropos word ....... list classes/selectors matching word
#list <what> ........ show source
class .............. class definition and comment
class selector ..... method source
#read <filename>..... read another script or source file
#use <package>....... use (load) a package
stx:libwidg .............. GUI package
stx:libtool .............. IDE tool package
stx:goodies/regex ........ regex package
stx:goodies/petitparser .. peg parser package
goodies/petitparser ...... default package prefix is "stx:"
default defaultPrefix .... change the default package prefix
#show <what> .......... show info
variables ............ interpreter variables
processes ............ processes
memory ............... memory usage
flags ................ flags
modules .............. loaded modules
packages ............. available packages to load
all .................. all of the above
#set <flag> ........... set a flag (value defaults to true)
print ................ print return values
nodebug .............. no debugger on error
confirmdebug ......... ask for debugger on error
trace ................ tracing execution
timing ............... timing execution
profiling ............ show execution profile
chunkFormat .......... traditional bang chunk format input mode
editor ............... command used with #edit directive
prefix defPrefix ..... change the default package prefix
#clear <flag> ......... same as: "#set <flag> false"
#debug ................ enter a MiniDebugger
#break class selector .... add a breakpoint
#delete <what> ........ delete breakpoint(s)
all .................. delete all breakpoints
class ................ delete breakpoints in class
class selector ....... delete this breakpoint
#edit <what> .......... open an external editor
class ................ on a class
class selector ....... on a method
<empty> .............. on previously edited method/last class
The MiniDebugger (if entered) shows its own help with "?".
'
"Created: / 07-12-2006 / 18:54:20 / cg"
"Modified: / 08-11-2016 / 22:53:53 / cg"
"Modified: / 09-02-2019 / 14:34:28 / Claus Gittinger"
!
cmd_ide:lineStream
"upen up the ide"
|builder app|
builder := NewLauncher open.
builder notNil ifTrue:[
app := builder application.
stderr showCR:'waiting for launcher to be closed...'.
"/ don't go back into the reader, as this will slow down the
"/ IDE (donnow why, at the moment)
[
Delay waitForSeconds:0.5.
app isOpen
] whileTrue.
].
!
cmd_language:lineStream
"language directive; i.e.
#language smalltalk
#language javascript
"
|lang|
lineStream skipSeparators.
lang := lineStream upToEnd withoutSeparators.
lang = 'smalltalk' ifTrue:[
compiler := Compiler.
^ self.
].
lang = 'javascript' ifTrue:[
compiler := JavaScriptCompiler.
^ self.
].
stderr
showCR:'? usage: #language smalltalk';
showCR:'? or: #language javascript'.
!
cmd_list:lineStream
"list directive; i.e.
#list <classname> ['class'] <selector>
"
|class selector source|
(self
getClassNameAndSelectorFrom:lineStream
specialWords:nil
into:[:classArg :selectorArg |
class := classArg.
selector := selectorArg.
]) ifFalse:[^ self].
selector isNil ifTrue:[
stderr nextPutAll:(class definition); cr.
stderr nextPutAll:(class commentOrDocumentationString); cr.
] ifFalse:[
source := class sourceCodeAt:selector asSymbol.
source isEmptyOrNil ifTrue:[
stderr nextPutLine:'Sorry, no sourcecode found'
] ifFalse:[
stderr nextPutAll:source; cr
].
].
"
(ReadEvalPrintLoop basicNew error:Stderr)
input:Stdin;
cmd_list:'Array' readStream
(ReadEvalPrintLoop basicNew error:Stderr)
input:Stdin;
cmd_list:'Array at:put:' readStream
(ReadEvalPrintLoop basicNew error:Stderr)
input:Stdin;
cmd_list:'ReadEvalPrintLoop doIt' readStream
"
!
cmd_qFix:lineStream
"qFix:
fix for a bug in xQuartz, which locks up my screen completely
from time to time (happens when doing popup views).
It seems that iconifying all views helps (for whatever reason)
to get out of the deadlock which results from a race condition in
grabFocus/grabPointer"
TopView allSubInstancesDo:[:t| t isPopUpView ifFalse:[ t collapse ]].
Delay waitForSeconds:1.
Transcript topView expand; raise.
'Please exit the REPL now, and press ''c'' to continue' printCR.
"Created: / 05-11-2018 / 14:33:59 / Claus Gittinger"
"Modified: / 07-11-2018 / 19:53:03 / Claus Gittinger"
!
cmd_read:lineStream
"read directive; i.e.
#read scriptFile
"
|filename newInput
savedPrompt savedPrint savedInput savedCurrentDirectory savedDoChunkFormat
savedTraceFlag savedProfileFlag savedNoDebugger|
lineStream skipSeparators.
filename := lineStream upToEnd withoutSeparators.
filename isEmptyOrNil ifTrue:[
stderr showCR:'? usage: #read <filename>'.
^ self.
].
currentDirectory := currentDirectory ? (Filename currentDirectory).
filename := filename asFilename.
filename isAbsolute ifFalse:[
filename := currentDirectory construct:filename.
].
StreamError ignoreIn:[
newInput := filename readStream.
].
newInput isNil ifTrue:[
stderr showCR:('Could not find file: "',filename pathName,'"').
^ self.
].
[
savedCurrentDirectory := currentDirectory.
savedDoChunkFormat := doChunkFormat.
savedTraceFlag := traceFlag.
savedProfileFlag := profilingFlag.
savedInput := inputStream.
savedPrint := printFlag.
savedPrompt := prompt.
currentDirectory := filename directory.
inputStream := newInput.
prompt := nil.
self
basicReadEvalPrintLoopWithInput:newInput
output:outputStream
error:errorStream
compiler:(compiler ? Compiler ? Parser)
prompt:false
print:false.
] ensure:[
newInput close.
doChunkFormat := savedDoChunkFormat.
currentDirectory := savedCurrentDirectory.
traceFlag := savedTraceFlag.
profilingFlag := savedProfileFlag.
inputStream := savedInput.
printFlag := savedPrint.
prompt := savedPrompt.
].
!
cmd_set:lineStream
self cmd_setOrClear:lineStream to:true
"Modified: / 07-12-2006 / 19:04:46 / cg"
!
cmd_setOrClear:lineStream to:aBoolean
"set/clear one of my internal flags"
|what flag|
flag := aBoolean.
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
lineStream skipSeparators.
"/ peek ahead for "false"
"/ so we can also say: #set <flag> f
flag ifTrue:[
lineStream atEnd ifFalse:[
flag := (lineStream peek == $f) not.
].
].
what notNil ifTrue:[
(what startsWith:'tra') ifTrue:[
traceFlag := flag.
^ self.
].
(what startsWith:'tim') ifTrue:[
timingFlag := flag.
^ self.
].
(what startsWith:'prof') ifTrue:[
profilingFlag := flag.
^ self.
].
(what startsWith:'chunk') ifTrue:[
doChunkFormat := flag.
^ self.
].
(what startsWith:'edi') ifTrue:[
flag ifTrue:[
"/ #set editor <cmd>
lineStream skipSeparators.
editorCommand := lineStream upToEnd withoutSeparators.
] ifFalse:[
editorCommand := nil.
].
^ self.
].
(what startsWith:'con') ifTrue:[
confirmDebugger := flag.
^ self.
].
(what startsWith:'node') ifTrue:[
noDebugger := flag.
^ self.
].
(what startsWith:'pri') ifTrue:[
printFlag := flag.
^ self.
].
(what startsWith:'prom') ifTrue:[
flag ifTrue:[
"/ #set prompt <prompt>
self prompt:(lineStream upToEnd withoutSeparators).
] ifFalse:[
"/ #clear prompt
self prompt:nil
].
^ self.
].
(what startsWith:'ans') ifTrue:[
flag ifTrue:[
"/ #set returnprompt <cmd>
lineStream skipSeparators.
self answerPrompt:(lineStream upToEnd withoutSeparators).
] ifFalse:[
"/ #clear the answer prompt
self answerPrompt:''.
].
^ self.
].
].
stderr
showCR:'? usage: set/clear <flag>';
showCR:'? (<flag> must be one of: print, nodebug, confirmdebug, trace, times, profile, chunk, prompt, answerprompt, editor)'.
self cmd_show:('flags' readStream).
"Modified: / 08-11-2016 / 22:49:17 / cg"
!
cmd_show:lineStream
"show directive:
show packages
show modules (= loaded packages)
show variables
etc.
"
|what showAll ok|
lineStream skipSeparators.
what := lineStream nextAlphaNumericWord.
ok := false.
what notNil ifTrue:[
showAll := (what startsWith:'all').
(showAll or:[ what startsWith:'var' ]) ifTrue:[
stderr showCR:'Variables:'; showCR:'----------'.
self showVariables.
ok := true.
].
(showAll or:[ what startsWith:'proc' ]) ifTrue:[
stderr cr; showCR:'Threads:'; showCR:'--------'.
MiniDebugger basicNew showProcesses.
ok := true.
].
("showAll or:[" what startsWith:'pack' "]") ifTrue:[
stderr cr; showCR:'Available Packages:'; showCR:'--------'.
self showPackages.
ok := true.
].
(showAll or:[ what startsWith:'mod' ]) ifTrue:[
stderr cr; showCR:'Modules:'; showCR:'--------'.
self showModules.
ok := true.
].
(showAll or:[ what startsWith:'mem' ]) ifTrue:[
|allMem|
stderr cr; showCR:'Memory:'; showCR:'-------'.
"/ allMem := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed
"/ + ObjectMemory newSpaceUsed.
stderr
"/ showCR:('overall: ',(allMem // 1024) printString,' Kb');
showCR:('used : ',(ObjectMemory bytesUsed // 1024) printString,' Kb');
showCR:('free : ',(ObjectMemory freeSpace // 1024) printString,' Kb');
show:('minorGC: ',(ObjectMemory scavengeCount) printString);
showCR:(' majorGC: ',(ObjectMemory garbageCollectCount) printString).
ok := true.
].
(showAll or:[ what startsWith:'bre' ]) ifTrue:[
stderr cr; showCR:'Breakpoints:'; showCR:'--------'.
self showBreakpoints.
ok := true.
].
(showAll or:[ what startsWith:'flag' ]) ifTrue:[
stderr cr; showCR:'Flags:'; showCR:'------'.
stderr
showCR:('print: ',self printFlag printString);
showCR:('nodebug: ',self noDebugger printString);
showCR:('confirmdebug:',self confirmDebugger printString);
showCR:('trace : ',(traceFlag ? false) printString);
showCR:('timing: ',(timingFlag ? false) printString);
showCR:('profiling: ',(profilingFlag ? false) printString);
showCR:('chunkFormat: ',(doChunkFormat ? false) printString);
showCR:('editor: ',self editorCommand printString);
showCR:('prefix: ',self defaultPackagePrefix printString);
showCR:('prompt: ',prompt printString);
showCR:('answerprompt:',self answerPrompt printString);
yourself.
ok := true.
].
].
ok ifFalse:[
stderr showCR:'? usage: show <what>'.
stderr showCR:'? (<what> must be one of: packages, modules, variables, flags, memory, processes)'.
].
"
(ReadEvalPrintLoop basicNew error:Stderr) cmd_show:'packages' readStream
"
"Modified: / 08-11-2016 / 22:46:51 / cg"
!
cmd_usage:lineStream
stderr
nextPutAll:'usage: ',OperatingSystem nameOfSTXExecutable asFilename baseName,' [options...]
--help .................. output full detailed usage info.
-R / --repl ............. read-eval-print-loop
-E / --eval <expr> ...... eval expr, then exit
-P / --print <expr> ..... eval expr, print, then exit
-f / --execute <file> ... eval exprs from file, then exit
-l / --load <file> ...... load file before starting
-q / --silent ........... suppress messages (& prompts in repl)
For a full list of options, please take a look at the documentation
in "doc/online/english/getstart/TOP.html".
'
!
cmd_use:lineStream
"use directive; i.e.
#use stx:goodies/xml
#use exept:mqtt
#use goodies/regression
"
|pkg s defaultPrefix|
lineStream skipSeparators.
pkg := lineStream upToEnd withoutSeparators.
pkg isEmpty ifTrue:[
stderr
showCR:'? usage: #use <package>';
showCR:'? or: #use default <packagePrefix>'.
^ self.
].
s := pkg readStream.
(s nextAlphaNumericWord) = 'default' ifTrue:[
defaultPrefix := s upToEnd withoutSeparators.
self defaultPackagePrefix:defaultPrefix.
^ self.
].
[
Smalltalk loadPackage:pkg.
] on:PackageLoadError do:[:ex|
"/ allow for some shortcuts...
(pkg includes:$:) ifTrue:[
stderr showCR:('Failed to load package: "',pkg,'"').
] ifFalse:[
"/ try stx standard package
pkg := (self defaultPackagePrefix), pkg.
ex restart.
].
].
"Created: / 07-12-2006 / 19:07:56 / cg"
!
directive:line
|s cmd|
s := line readStream.
s next. "/ skip the hash
s peek == $!! ifTrue:[
"/ skip shebang line
^ self.
].
s skipSeparators.
cmd := s nextAlphaNumericWord.
cmd notNil ifTrue:[
AbortAllOperationRequest handle:[:ex |
stderr showCR:('Directive aborted: ', ex description)
] do:[
Error handle:[:ex |
stderr showCR:('Caught in directive: ', ex description).
ex suspendedContext fullPrintAll.
] do:[
ControlInterrupt handle:[:ex |
MiniDebugger enter.
"/ stderr showCR:('Ignored in directive: ', ex description).
"/ ex reject.
"/ ex proceed.
] do:[
self
perform:('cmd_',cmd) asMutator with:s
ifNotUnderstood:[
stderr
showCR:'?? invalid command: %1. Type "#help" for help.' with:cmd.
].
].
].
].
].
"Created: / 07-12-2006 / 18:49:17 / cg"
"Modified: / 08-11-2016 / 21:59:16 / cg"
!
getClassNameAndSelectorFrom:lineStream specialWords:specialWords into:aBlock
"a helper for list and edit; parses class and selector name.
if the argument is one of the specialWords, return it.
otherwise, returns true if class/selector are ok,
or false if nothing reasonable was entered"
|words wordStream className class selector|
lineStream skipSeparators.
words := lineStream upToEnd asCollectionOfWords.
(words isEmpty) ifTrue:[
^ false.
].
wordStream := words readStream.
"/ search in classes:
className := wordStream next.
((specialWords ? #()) includes:className) ifTrue:[
^ className
].
class := Smalltalk classNamed:className.
class isNil ifTrue:[
stderr showCR:'no such class: ',className.
^ false.
].
(wordStream atEnd not and:[wordStream peek = 'class']) ifTrue:[
wordStream next.
class := class theMetaclass
].
(wordStream atEnd) ifFalse:[
selector := wordStream next.
].
aBlock value:class value:selector.
^ true
!
showBreakpoints
Smalltalk allClassesDo:[:cls |
cls theNonMetaclass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd isWrapped ifTrue:[
stderr showCR:(mthd whoString)
].
].
].
"
(ReadEvalPrintLoop basicNew error:Stderr) showBreakpoints
"
!
showModules
"lists loaded packages"
|printModule|
printModule :=
[:mod |
self errorStream
show:' ';
show:(mod package "libraryName");
showCR:' (',(mod type),')'.
].
stderr nextPutLine:'builtIn:'.
((ObjectMemory binaryModuleInfo
reject:[:m | m dynamic])
asSortedCollection:[:a :b | a name < b name]) do:printModule.
stderr nextPutLine:'dynamic:'.
((ObjectMemory binaryModuleInfo
select:[:m | m dynamic])
asSortedCollection:[:a :b | a name < b name]) do:printModule.
"
(ReadEvalPrintLoop basicNew error:Stderr) showModules
"
!
showPackages
"lists all known packages"
|all|
all := Set new.
Smalltalk knownLoadablePackagesDo:[:packageID :type :path |
all add:packageID
].
all := all asOrderedCollection sort.
all do:[:eachPackage |
stderr show:eachPackage.
(Smalltalk isPackageLoaded:eachPackage) ifTrue:[
stderr show:' (loaded)'.
].
stderr cr.
].
"
(ReadEvalPrintLoop basicNew error:Stderr) showPackages
(ReadEvalPrintLoop basicNew error:Stderr) showModules
"
!
showVariables
Workspace notNil ifTrue:[
Workspace workspaceVariables keys asOrderedCollection sort do:[:nm |
|holder|
holder := Workspace workspaceVariables at:nm.
stderr
show:nm;
show:' -> ';
showCR:holder value printString.
].
].
"
(ReadEvalPrintLoop basicNew error:Stderr) showVariables
"
! !
!ReadEvalPrintLoop methodsFor:'doit'!
doIt ^[123
+
234
.] value
! !
!ReadEvalPrintLoop methodsFor:'evaluation'!
basicReadEvalPrintLoopWithInput:input output:output error:error
compiler:compilerClass prompt:doPrompt print:doPrint
"{ Pragma: +optSpace }"
"the core of the interpreter loop;
extracted and parametrized, so it can be called recursively for included scripts.
If chunkFormat is true, chunks are read.
Otherwise, lines up to an empty line (or EOF) or a line ending in '.' are read,
unless the line ends with '\'.
A '#' character appearing in the first column of the first line turns off chunkmode,
which allows for convenient shell scripts containing a #/bin/stx as the first line."
exitAction := [^ self].
[
|lines chunk|
(doPrompt and:[prompt notEmptyOrNil]) ifTrue:[
error show:prompt.
].
input atEnd ifTrue:[
doPrint ifTrue:[ error cr ].
^ self.
].
input peek == $# ifTrue:[
self doChunkFormat:false.
].
self doChunkFormat ifTrue:[
input skipSeparators.
chunk := input nextChunk.
] ifFalse:[
lines := OrderedCollection new.
[
|line stillReading|
stillReading := false.
line := input nextLine.
line notEmptyOrNil ifTrue:[
line = '?' ifTrue:[
self cmd_help:nil.
doPrompt notNil ifTrue:[
error show:prompt.
].
] ifFalse:[
(line startsWith:'#') ifTrue:[
self directive:line.
(doPrompt and:[prompt notEmptyOrNil]) ifTrue:[
error show:prompt.
].
] ifFalse:[
(line endsWith:'\') ifTrue:[
stillReading := true.
line := line copyButLast.
].
lines add:line.
]
]
].
stillReading ifFalse:[
stillReading := line notEmptyOrNil and:[(line endsWith:$.) not]
].
stillReading
] whileTrue.
chunk := lines asStringWith:Character cr.
].
(chunk notEmptyOrNil
and:[chunk withoutSeparators notEmpty
and:[chunk withoutSeparators ~= '.']]
) ifTrue:[
self compileAndExexute:chunk with:compilerClass doPrompt:doPrompt doPrint:doPrint.
].
] loop.
"
Smalltalk readEvalPrintLoop.
(ReadEvalPrintLoop new
doChunkFormat:false;
prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
"Modified: / 08-11-2016 / 22:41:47 / cg"
"Modified (comment): / 09-02-2019 / 14:30:50 / Claus Gittinger"
!
compileAndExexute:chunk with:compilerClass doPrompt:doPrompt doPrint:doPrint
"abortAll is handled, but not asked for here!!"
AbortAllOperationRequest handle:[:ex |
ObjectMemory sendTraceOff.
stderr nextPutLine:('Evaluation aborted.')
] do:[
(Error, ControlInterrupt) handle:[:ex |
ObjectMemory sendTraceOff.
doPrompt ifFalse:[
ex reject
].
(self noDebugger
and:[ ex creator isControlInterrupt not]) ifTrue:[
stderr showCR:('Evaluation aborted: ', ex description).
] ifFalse:[
(self confirmDebugger not
or:[ ex creator isControlInterrupt
or:[ self askYesNo:('Error encountered: %1\Debug (y/n)? '
withCRs bindWith:ex description)]]
) ifTrue:[
MiniDebugger enterWithMessage:(ex errorString) mayProceed:true.
"/ if we arrive here, user typed 'c' - continue
ex mayProceed ifTrue:[
ex proceed.
].
].
].
ex return.
] do:[
|value ms us mthd|
Class withoutUpdatingChangesDo:[
mthd := compilerClass
compile:('doIt ^[',chunk,'] value') forClass:(self class)
inCategory:'doit' notifying:self
install:true.
].
mthd isMethod ifTrue:[
traceFlag == true ifTrue:[
MessageTracer debugTrace:[
value := self doIt. "/ not here now, but dynamically created
]
] ifFalse:[
profilingFlag == true ifTrue:[
MessageTally spyDetailedOn:[
value := self doIt. "/ not here now, but dynamically created
].
] ifFalse:[
us := Time microsecondsToRun:[
value := self doIt. "/ not here now, but dynamically created
].
timingFlag == true ifTrue:[
'execution time: ' printOn:stderr.
us < 1000 ifTrue:[
us < 1 ifTrue:[
stderr nextPutLine:'too small to measure (<1us)'.
] ifFalse:[
stderr print:us; nextPutLine:'us'.
]
] ifFalse:[
stderr print:((us / 1000) asFixedPoint:2); nextPutLine:'ms'.
].
].
].
].
(doPrint and:[self printFlag]) ifTrue:[
value isVoid ifFalse:[
stderr nextPutAll:(self answerPrompt).
stderr nextPutLine:(value displayString).
].
].
Workspace notNil ifTrue:[
Workspace rememberResultAsWorkspaceVariable:value.
].
].
].
].
"Modified: / 04-05-2019 / 15:51:16 / Claus Gittinger"
!
readEvalPrintLoop
"{ Pragma: +optSpace }"
"simple read-eval-print loop for non-graphical Minitalk.
If the chunkFormat-argument is true, chunks are read.
Otherwise, lines up to an empty line (or EOF) are read.
A '#' character appearing in the first column of the first line
switches to non-chunkMode."
ControlInterrupt handle:[:ex |
self errorStream showCR:('Caught: ', ex description).
self inputStream atEnd ifTrue:[
ex return.
].
MiniDebugger enter.
ex proceed.
"/ ex restart.
] do:[
|compilerClass|
"/ re-evaluate these in the loop, so they can be changed dynamically
stdin := self inputStream.
stdout := self outputStream.
stderr := self errorStream.
compilerClass := compiler ? Compiler ? Parser.
compilerClass isNil ifTrue:[
stderr showCR:('oops - no Compiler class found').
^ self.
].
StreamError handle:[:ex |
(stdin isOpen not or:[stdin atEnd]) ifTrue:[
stderr showCR:'<EOF>'.
ex return.
].
(stdout isOpen not) ifTrue:[
stderr showCR:'no output'.
].
(stderr isOpen not) ifTrue:[
].
] do:[
stdin signalAtEnd:true.
self
basicReadEvalPrintLoopWithInput:stdin output:stdout error:stderr
compiler:compilerClass prompt:true print:true.
].
].
"/ self errorStream showCR:('done.').
"
(ReadEvalPrintLoop new
doChunkFormat:false;
prompt:'>') readEvalPrintLoop
"
"
Stdin atEnd
Stdin clearEOF
Smalltalk readEvalPrintLoop
(ReadEvalPrintLoop new prompt:'>') readEvalPrintLoop
"
"Created: / 07-12-2006 / 17:27:21 / cg"
"Modified: / 08-11-2016 / 22:42:21 / cg"
! !
!ReadEvalPrintLoop methodsFor:'queries'!
autoDefineVariables
"when evaluating with --eval, auto define any variables"
^ #workspace
! !
!ReadEvalPrintLoop class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !