"{ 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"

!

error:aStream

    "assign an error stream"

    errorStream := aStream.

    "Created: / 07-12-2006 / 17:33:39 / cg"

!

errorStream

    "return the current error stream"

    errorStream notNil ifTrue:[^ errorStream].

    ^ Processor activeProcess stderr

    "Created: / 07-12-2006 / 19:12:27 / cg"

!

input:aStream

    "assign an input stream"

    inputStream := 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"

!

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

    "assign an output stream"

    outputStream := 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"

!

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

    ^ (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.

    ].

    "/ 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:[

                ].

                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 |

                            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:[

            stderr nextPutLine:'no such method'.

            ^ self.

        ].

        (self askYesNo:('no such method in %1, but inherited from %2.\Add breakpoint there (y/n)?'

                       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