hg/stx-libbasic: comparison ReadEvalPrintLoop.st

equal deleted inserted replaced

-:d6ccee71b508
+:15ce04593d54
 Object subclass:#ReadEvalPrintLoop
 	instanceVariableNames:'inputStream outputStream errorStream compiler prompt
 		doChunkFormat traceFlag timingFlag profilingFlag printFlag
 		exitAction currentDirectory lastEditedClass lastEditedSelector
-		editorCommand'
+		editorCommand confirmDebugger debuggerUsed'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'System-Support'
 !
 !
 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:
 #exit           - exit the rep-loop
 #show ...       - show various infos
 compiler:something
 "assign a compiler to use;could 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
 !
 doChunkFormat
 "true if currently reading chunk format"
 ^ self
 ! !
 !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
 "Created: / 07-12-2006 / 19:04:50 / cg"
 !
 lineStream skipSeparators.
 lineStream atEnd ifTrue:[
 cls := lastEditedClass.
 methodName := lastEditedSelector.
 ] ifFalse:[
 classOrMethodName := lineStream
 upToElementForWhich:[:ch |
 ch isLetterOrDigit not and:[ch ~~ $_]
 ].
 "/
 '                   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
 ].
 editFullClass := true.
 code := cls source asString
 ] ifFalse:[
 ((selector := methodName asSymbolIfInterned) isNil
 or:[ (cls implements:selector) not]) ifTrue:[
-errStream show:('"',methodName,'" is a new method; create (y/n)? ').
+(self askYesNo:('"',methodName,'" is a new method; create (y/n)? ')) ifFalse:[^ self].
-(self inputStream nextLine withoutSeparators startsWith:'y') ifFalse:[^ self].
 code :=
 '"/ change the code as required, then save and exit the editor.
 "/ To cancel this edit, leave the editor WITHOUT saving.
 %1
 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"
 !
 #debug ................. enter a MiniDebugger
 #edit <what> ........ open an external editor
 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 "?".
 '
 "Created: / 07-12-2006 / 18:54:20 / cg"
 "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
 "Modified: / 07-12-2006 / 19:04:46 / cg"
 !
 cmd_setOrClear:lineStream to:aBoolean
+"set/clear one of my internal flags"
 |what|
 lineStream skipSeparators.
 what := lineStream nextAlphaNumericWord.
 what notNil ifTrue:[
 ] ifFalse:[
 editorCommand := nil.
 ].
 ^ self.
 ].
-].
+(what startsWith:'con') ifTrue:[
-self errorStream showCR:'? usage: set/clear <flag>'.
+confirmDebugger := aBoolean.
-self errorStream showCR:'? (<flag> must be one of: trace, times, profile, chunk, editor)'.
+^ self.
+].
+].
+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"
 !
 cmd_show:lineStream
 errStream
 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:('editor:      ',self editorCommand printString);
+showCR:('confirmDebug:',self confirmDebugger printString).
 ok := true.
 ].
 ].
 ok ifFalse:[
 ] do:[
 self
 perform:('cmd_',cmd) asMutator with:s
 ifNotUnderstood:[
 self errorStream
-show:'?? invalid command: '; show:cmd;
+show:'?? invalid command: %1. Type "#help" for help.' with:cmd.
-showCR:'. Type "#help" for help.'
 ].
 ].
 ].
 ].
 ].
 "Created: / 07-12-2006 / 18:49:17 / cg"
 "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|
 basicReadEvalPrintLoopWithInput:input output:output error:error
 compiler:compilerClass prompt:prompt print:doPrint
 "{ Pragma: +optSpace }"
-"the core of the interpreter loop; extracted and parametrized, so it can be called recursive
+"the core of the interpreter loop;
-for included scripts.
+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,
 which allows for convenient shell scripts containing a #/bin/stx as the first line."

changeset 22735	15ce04593d54
parent 22577	d47c7e41eda5
child 22736	db668a5e0106