"{ 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:'inputStream outputStream errorStream compiler prompt

		doChunkFormat traceFlag timingFlag profilingFlag printFlag

		exitAction currentDirectory lastEditedClass lastEditedSelector

		editorCommand confirmDebugger noDebugger debuggerUsed

		returnValuePrinting'

	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'!

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"

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

    ^ false

!

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

!

cmd_debug:lineStream

    MiniDebugger enter.

!

cmd_edit:lineStream

    "edit a class or selector in an external editor"

    |errStream classOrMethodName cls methodName selector 

     code isNewClass editFullClass tmpFile modifiedTime|

    errStream := self errorStream.

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

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

            errStream showCR:'edit usage:'.

            errStream showCR:'   #edit className selector'.

            errStream showCR:'   #edit className '.

            errStream showCR:'   #edit selector (class as in previous edit)'.

            errStream 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'.

        ].

        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].