--- a/ReadEvalPrintLoop.st Sun May 06 13:20:56 2018 +0200
+++ b/ReadEvalPrintLoop.st Sun May 06 17:46:43 2018 +0200
@@ -19,7 +19,7 @@
instanceVariableNames:'inputStream outputStream errorStream compiler prompt
doChunkFormat traceFlag timingFlag profilingFlag printFlag
exitAction currentDirectory lastEditedClass lastEditedSelector
- editorCommand'
+ editorCommand confirmDebugger debuggerUsed'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -44,7 +44,8 @@
documentation
"
A simple read-eval-print loop for non-GUI or stscript operation.
- Invoked, for example if stx is started with a --repl argument.
+ 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:
@@ -79,6 +80,32 @@
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
+!
+
doChunkFormat
"true if currently reading chunk format"
@@ -221,6 +248,97 @@
!ReadEvalPrintLoop methodsFor:'directives'!
+askYesNo:message
+ self errorStream 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:[
+ self errorStream 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|
+
+ 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:[
+ self errorStream 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.
+ sortedList slicesOf:numCols do:[:eachGroupOfN |
+ self errorStream
+ spaces:2;
+ nextPutLine:(
+ (eachGroupOfN
+ collect:[:nm |
+ (nm contractTo:limit) paddedTo:limit
+ ]
+ ) 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_clear:lineStream
self cmd_setOrClear:lineStream to:false
@@ -246,7 +364,6 @@
cls := lastEditedClass.
methodName := lastEditedSelector.
] ifFalse:[
-
classOrMethodName := lineStream
upToElementForWhich:[:ch |
ch isLetterOrDigit not and:[ch ~~ $_]
@@ -273,6 +390,11 @@
lineStream skipSeparators.
lineStream atEnd ifFalse:[
methodName := lineStream upToSeparator.
+ methodName = 'class' ifTrue:[
+ cls := cls theMetaclass.
+ lineStream skipSeparators.
+ methodName := lineStream upToSeparator.
+ ].
].
].
] ifFalse:[
@@ -299,8 +421,8 @@
] ifFalse:[
((selector := methodName asSymbolIfInterned) isNil
or:[ (cls implements:selector) not]) ifTrue:[
- errStream show:('"',methodName,'" is a new method; create (y/n)? ').
- (self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
+ (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.
@@ -368,6 +490,10 @@
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"
@@ -415,6 +541,10 @@
class .............. on a class
class selector ..... on a method
<empty> ............ on previously edited method/last class
+ #apropos word ....... list classes/selectors matching word
+ #list <what> ........ show source
+ class .............. class definition and comment
+ class selector ..... method source
The MiniDebugger (if entered) shows its own help with "?".
'
@@ -423,6 +553,45 @@
"Modified: / 08-11-2016 / 22:53:53 / cg"
!
+cmd_list:lineStream
+ "list directive; i.e.
+ #list <classname> ['class'] <selector>
+ "
+
+ |class selector source errStream|
+
+ errStream := self errorStream.
+
+ (self
+ getClassNameAndSelectorFrom:lineStream
+ into:[:classArg :selectorArg |
+ class := classArg.
+ selector := selectorArg.
+ ]) ifFalse:[^ self].
+
+ selector isNil ifTrue:[
+ errStream nextPutAll:(class definition).
+ errStream nextPutAll:(class commentOrDocumentationString).
+ ] ifFalse:[
+ source := class sourceCodeAt:selector asSymbol.
+ source isEmptyOrNil ifTrue:[
+ errStream nextPutLine:'Sorry, no sourcecode found'
+ ] ifFalse:[
+ errStream nextPutAll:source
+ ].
+ ].
+
+ "
+ self basicNew
+ input:Stdin;
+ cmd_list:'Array' readStream
+
+ self basicNew
+ input:Stdin;
+ cmd_list:'Array at:put:' readStream
+ "
+!
+
cmd_read:lineStream
"read directive; i.e.
#read scriptFile
@@ -486,6 +655,8 @@
!
cmd_setOrClear:lineStream to:aBoolean
+ "set/clear one of my internal flags"
+
|what|
lineStream skipSeparators.
@@ -517,9 +688,14 @@
].
^ self.
].
+ (what startsWith:'con') ifTrue:[
+ confirmDebugger := aBoolean.
+ ^ self.
+ ].
].
- self errorStream showCR:'? usage: set/clear <flag>'.
- self errorStream showCR:'? (<flag> must be one of: trace, times, profile, chunk, editor)'.
+ self errorStream
+ showCR:'? usage: set/clear <flag>';
+ showCR:'? (<flag> must be one of: trace, times, profile, chunk, editor, confirmDebug)'.
"Modified: / 08-11-2016 / 22:49:17 / cg"
!
@@ -590,7 +766,8 @@
showCR:('timing: ',(timingFlag ? false) printString);
showCR:('profiling: ',(profilingFlag ? false) printString);
showCR:('chunkFormat: ',(doChunkFormat ? false) printString);
- showCR:('editor: ',self editorCommand printString).
+ showCR:('editor: ',self editorCommand printString);
+ showCR:('confirmDebug:',self confirmDebugger printString).
ok := true.
].
].
@@ -668,8 +845,7 @@
perform:('cmd_',cmd) asMutator with:s
ifNotUnderstood:[
self errorStream
- show:'?? invalid command: '; show:cmd;
- showCR:'. Type "#help" for help.'
+ show:'?? invalid command: %1. Type "#help" for help.' with:cmd.
].
].
].
@@ -680,6 +856,40 @@
"Modified: / 08-11-2016 / 21:59:16 / cg"
!
+getClassNameAndSelectorFrom:lineStream into:aBlock
+ "a helper for list and edit; parses class and selector name.
+ returns 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.
+ class := Smalltalk classNamed:className.
+ class isNil ifTrue:[
+ self errorStream 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
+!
+
showModules
|errStream printModule|
@@ -754,8 +964,8 @@
"{ Pragma: +optSpace }"
- "the core of the interpreter loop; extracted and parametrized, so it can be called recursive
- for included scripts.
+ "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.
A '#' character appearing in the first column of the first line turns off chunkmode,