# HG changeset patch # User Claus Gittinger # Date 1525621603 -7200 # Node ID 15ce04593d5410aed17d621b320cd3874ce0ea40 # Parent d6ccee71b5080c921f04a75b9932096652618a04 #FEATURE by cg class: ReadEvalPrintLoop class definition added: #askYesNo: #cmd_apropos: #cmd_list: #confirmDebugger #confirmDebugger: #debuggerUsed #debuggerUsed: #getClassNameAndSelectorFrom:into: comment/format in: #basicReadEvalPrintLoopWithInput:output:error:compiler:prompt:print: #cmd_help: changed: #cmd_edit: #cmd_setOrClear:to: #cmd_show: #directive: class: ReadEvalPrintLoop class comment/format in: #documentation diff -r d6ccee71b508 -r 15ce04593d54 ReadEvalPrintLoop.st --- 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 [; 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 ............ on previously edited method/last class + #apropos word ....... list classes/selectors matching word + #list ........ 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 ['class'] + " + + |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 '. - self errorStream showCR:'? ( must be one of: trace, times, profile, chunk, editor)'. + self errorStream + showCR:'? usage: set/clear '; + showCR:'? ( 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,