Truncate long outputs, PORT!s
Truncate long outputs, PORT!s

PORT! is a common verbose output result, the dumping of which takes
up too much space on the screen.  R3-Alpha would show nothing, this
changes the default skin to give a small stub to tell you it's a port.

Also includes a truncation so that only the first 20 lines of the first
2048 lines of molded output will be shown.

codebybrett/ren-c,draegtun/ren-c,codebybrett/ren-c,giuliolunati/ren-c,kealist/ren-c,codebybrett/ren-c,rgchris/ren-c,hostilefork/rebol,kealist/ren-c,draegtun/ren-c,draegtun/ren-c,giuliolunati/ren-c,kealist/ren-c,giuliolunati/ren-c,draegtun/ren-c,codebybrett/ren-c,hostilefork/rebol,codebybrett/ren-c,kealist/ren-c,rgchris/ren-c,rgchris/ren-c,hostilefork/rebol,hostilefork/rebol,kealist/ren-c,draegtun/ren-c,giuliolunati/ren-c,rgchris/ren-c,giuliolunati/ren-c,rgchris/ren-c,hostilefork/rebol
REBOL [
    System: "REBOL [R3] Language Interpreter and Run-time Environment"
    Title: "Host Console (Rebol's Read-Eval-Print-Loop, ie. REPL)"
    Rights: {
        Copyright 2016-2017 Rebol Open Source Contributors
        REBOL is a trademark of REBOL Technologies
    }
    License: {
        Licensed under the Apache License, Version 2.0
        See: http://www.apache.org/licenses/LICENSE-2.0
    }
    Description: {
        This is a rich, skinnable console for Rebol--where basically all the
        implementation is itself userspace Rebol code.  Documentation for the
        skinning hooks exist here:

        https://github.com/r3n/reboldocs/wiki/User-and-Console

        The HOST-CONSOLE Rebol function is invoked in a loop by a small C
        main function (see %host-main.c).  HOST-CONSOLE does not itself run
        arbitrary user code with DO.  That would be risky, because it actually
        is not allowed to fail or be canceled with Ctrl-C.  Instead, it just
        gathers input...and produces a block which is returned to C to
        actually execute.

        This design allows the console to sandbox potentially misbehaving
        skin code, and fall back on a default skin if there is a problem.
        It also makes sure that that user code doesn't see the console's
        implementation in its backtrace.

        !!! While not implemented in C as the R3-Alpha console was, this
        code relies upon the INPUT function to communicate with the user.
        INPUT is a black box that reads whole lines from the "console port",
        which is implemented via termios on POSIX and the Win32 Console API
        on Windows:

        https://blog.nelhage.com/2009/12/a-brief-introduction-to-termios/
        https://docs.microsoft.com/en-us/windows/console/console-functions

        Someday in the future, the console port itself should offer keystroke
        events and allow the line history (e.g. Cursor Up, Cursor Down) to be
        implemented in Rebol as well.
     }
]

; Define console! object for skinning - stub for elsewhere?
;
console!: make object! [
    name: _
    repl: true      ;-- used to identify this as a console! object (quack!)
    is-loaded:  false ;-- if true then this is a loaded (external) skin
    was-updated: false ;-- if true then console! object found in loaded skin
    last-result: _  ;-- last evaluated result (sent by HOST-CONSOLE)

    ;; APPEARANCE (can be overridden)

    prompt:   {>>}
    result:   {==}
    warning:  {!!}
    error:    {**}                 ;; not used yet
    info:     to-string #{e29398}  ;; info sign!
    greeting: _

    print-prompt: proc [] [
        ;
        ; !!! Previously the HOST-CONSOLE hook explicitly took an (optional)
        ; FRAME! where a debug session was focused and a stack depth integer,
        ; which was put into the prompt.  This feature is not strictly
        ; necessary (just helpful), and made HOST-CONSOLE seem less generic.
        ; It would make more sense for aspects of the debugger's state to
        ; be picked up from the environment somewhere (who's to say the
        ; focus-frame and focus-level are the only two relevant things)?
        ;
        ; For now, comment out the feature...and assume if it came back it
        ; would be grafted here in the PRINT-PROMPT.
        ;
        comment [
            ; If a debug frame is in focus then show it in the prompt, e.g.
            ; as `if:|4|>>` to indicate stack frame 4 is being examined, and
            ; it was an `if` statement...so it will be used for binding (you
            ; can examine the condition and branch for instance)
            ;
            if focus-frame [
                if label-of focus-frame [
                    write-stdout unspaced [label-of focus-frame ":"]
                ]
                write-stdout unspaced ["|" focus-level "|"]
            ]
        ]

        ; We don't want to use PRINT here because it would put the cursor on
        ; a new line.
        ;
        write-stdout identity block? prompt then [
            unspaced prompt
        ] else [
            form prompt
        ]
        write-stdout space
    ]

    print-result: procedure [v [<opt> any-value!]]  [
        last-result: :v
        case [
            null? :v [
                ; Historically Rebol wouldn't print any eval result in the
                ; case of things that "didn't return a value".  Trying to
                ; do otherwise e.g. by printing `;-- null` is annoying.
                ;
                ; (It might be useful feedback for commands which have none of
                ; their own output, however.)
            ]

            port? :v [
                ; PORT!s are returned by many operations on files, to
                ; permit chaining.  They contain many fields so their
                ; molding is excessive, and there's not a ton to learn
                ; about them.  Cut down the output more than the mold/limit.
                ;
                print [result "#[port! [...] [...]]"]
            ]
        ]
        else [
            ; print the first 20 lines of the first 2048 characters of mold
            ;
            pos: molded: mold/limit :v 2048
            loop 20 [
                pos: (next find pos newline) else [break]
            ] then [
                insert clear pos "..."
            ]
            print [result (molded)]
        ]
    ]

    print-warning:  proc [s] [print [warning reduce s]]
    print-error:    proc [e [error!]] [print e]

    print-halted: proc [] [
        print "[interrupted by Ctrl-C or HALT instruction]"
    ]

    print-info:     proc [s] [print [info space space space reduce s]]
    print-greeting: proc []  [boot-print greeting]
    print-gap:      proc []  [print-newline]

    ;; BEHAVIOR (can be overridden)

    input-hook: func [
        {Receives line input, parse/transform, send back to CONSOLE eval}

        return: "BLANK! if canceled, otherwise processed string input"
            [blank! string!]
    ][
        input
    ]

    dialect-hook: func [
        {Receives code block, parse/transform, send back to CONSOLE eval}
        b [block!]
    ][
        ; !!! As with the notes on PRINT-PROMPT, the concept that the
        ; debugger parameterizes the HOST-CONSOLE function directly is being
        ; phased out.  So things like showing the stack level in the prompt,
        ; or binding code into the frame with focus, is something that would
        ; be the job of a "debugger skin" which extracts its parameterization
        ; from the environment.  Once these features are thought out more,
        ; that skin can be implemented (or the default skin can just look
        ; for debug state, and not apply debug skinning if it's not present.)
        ;
        comment [
            if focus-frame [
                bind code focus-frame
            ]
        ]

        b
    ]

    shortcuts: make object! compose/deep [
        d: [dump]
        h: [help]
        q: [quit]
        dt: [delta-time]
        dp: [delta-profile]

        list-shortcuts: [print system/console/shortcuts]
        changes: [
            say-browser
            browse (join-all [
                https://github.com/metaeducation/ren-c/blob/master/CHANGES.md#
                join-all ["" system/version/1 system/version/2 system/version/3]
            ])
        ]
        topics: [
            say-browser
            browse https://r3n.github.io/topics/
        ]
    ]

    ;; HELPERS (could be overridden!)

    add-shortcut: proc [
        {Add/Change console shortcut}
        name  [any-word!]
            {shortcut name}
        block [block!]
            {command(s) expanded to}
    ][
        extend shortcuts name block
    ]
]


start-console: procedure [
    "Called when a REPL is desired after command-line processing, vs quitting"

    <static>
        o (system/options) ;-- shorthand since options are often read/written
][
    ; Instantiate console! object into system/console for skinning.  This
    ; object can be updated %console-skin.reb if in system/options/resources

    loud-print "Starting console..."
    loud-print ""
    proto-skin: make console! []
    skin-error: _

    if all [
        skin-file: %console-skin.reb
        not find o/suppress skin-file
        o/resources
        exists? skin-file: join-of o/resources skin-file
    ][
        trap/with [
            new-skin: do load skin-file

            ;; if loaded skin returns console! object then use as prototype
            all [
                object? new-skin
                did select new-skin 'repl ;; quacks like REPL, it's a console!
            ] then [
                proto-skin: new-skin
                proto-skin/was-updated: true
                proto-skin/name: default ["updated"]
            ]

            proto-skin/is-loaded: true
            proto-skin/name: default ["loaded"]
            append o/loaded skin-file

        ] func [error] [
            skin-error: error       ;; show error later if --verbose
            proto-skin/name: "error"
        ]
    ]

    proto-skin/name: default ["default"]

    system/console: proto-skin

    ; Make the error hook store the error as the last one printed, so the
    ; WHY command can access it.  Also inform people of the existence of
    ; the WHY function on the first error delivery.
    ;
    proto-skin/print-error: adapt :proto-skin/print-error [
        if not system/state/last-error [
            system/console/print-info "Note: use WHY for error information"
        ]

        system/state/last-error: e
    ]

    ; banner time
    ;
    if o/about [
        ;-- print fancy boot banner
        ;
        boot-print make-banner boot-banner
    ] else [
        boot-print [
            "Rebol 3 (Ren-C branch)"
            mold compose [version: (system/version) build: (system/build)]
            newline
        ]
    ]

    boot-print boot-welcome

    ; verbose console skinning messages
    loud-print [newline {Console skinning:} newline]
    if skin-error [
        loud-print [
            {  Error loading console skin  -} skin-file LF LF
            skin-error LF LF
            {  Fix error and restart CONSOLE}
        ]
    ] else [
       loud-print [
            space space
            proto-skin/is-loaded ?? {Loaded skin} !! {Skin does not exist}
            "-" skin-file
            spaced [
                "(CONSOLE" (proto-skin/was-updated ?! {not}) "updated)"
            ]
        ]
    ]
]


host-console: function [
    {Rebol ACTION! that is called from C in a loop to implement the console}

    return: "Code submission for C caller to run in a sandbox, or exit status"
        [block! group! integer!] ;-- Note: RETURN is hooked/overridden!!!
    prior "BLOCK! or GROUP! that last invocation of HOST-CONSOLE requested"
        [blank! block! group!]
    result "The result from evaluating PRIOR, unless error (then use STATUS)"
        [<opt> any-value!]
    status "BLANK! if no error, or ERROR! if problem (includes HALT, QUIT...)"
        [blank! error!]
][
    ; We hook the RETURN function so that it actually returns an instruction
    ; that the code can build up from multiple EMIT statements.

    instruction: copy []

    emit: function [
        {Builds up sandboxed code to submit to C, hooked RETURN will finalize}

        item "ISSUE! directive, STRING! comment, ((composed)) code BLOCK!"
            [block! issue! string!]
        <with> instruction
    ][
        really* case [
            issue? item [
                if not empty? instruction [append/line instruction '|]
                insert instruction item
            ]
            string? item [
                append/line instruction compose [comment (item)]
            ]
            block? item [
                if not empty? instruction [append/line instruction '|]
                append/line instruction composeII/deep/only item
            ]
        ]
    ]

    return: function [
        {Hooked RETURN function which finalizes any gathered EMIT lines}

        state "Describes the RESULT that the next call to HOST-CONSOLE gets"
            [integer! tag! group! datatype!]
        <with> instruction prior
        <local> return-to-c (:return) ;-- capture HOST-CONSOLE's RETURN
    ][
        switch state [
            <prompt> [
                emit [system/console/print-gap]
                emit [system/console/print-prompt]
                emit [reduce [
                    system/console/input-hook
                ]] ;-- gather first line (or BLANK!), put in BLOCK!
            ]
            <halt> [
                emit [halt]
                emit [fail {^-- Shouldn't get here, due to HALT}]
            ]
            <die> [
                emit [quit/with 1] ;-- catch-all bash code for general errors
                emit [fail {^-- Shouldn't get here, due to QUIT}]
            ]
            <bad> [
                emit #no-unskin-if-error
                emit [fail ["Bad REPL continuation:" ((uneval result))]]
                emit [print ((mold uneval prior))]
            ]
        ] also [
            return-to-c instruction
        ]

        return-to-c <- switch type of state [
            (integer!) [ ;-- just tells the calling C loop to exit() process
                assert [empty? instruction]
                state
            ]
            (datatype!) [ ;-- type assertion, how to enforce this?
                emit spaced ["^-- Result should be" an state]
                instruction
            ]
            (group!) [ ;-- means "submit user code"
                assert [empty? instruction]
                state
            ]
        ] else [
            emit [fail [{Bad console instruction:} ((mold state))]]
        ]
    ]

    if not prior [ ;-- First call, do startup and command-line processing
        ;
        ; !!! We get some properties passed from the C main() as a BLOCK! in
        ; result.  These should probably be injected into the environment
        ; somehow instead.
        ;
        assert [not status | block? result | length of result = 3]
        set [exec-path: argv: boot-exts:] result
        return (host-start exec-path argv boot-exts :emit :return)
    ]

    ; BLOCK! code execution represents an instruction sent by the console to
    ; itself.  Some #directives may be at the head of these blocks.
    ;
    directives: [] unless if block? prior [
        collect [
            parse prior [some [set i: issue! (keep i)]]
        ]
    ]

    ; QUIT handling (uncaught THROW/NAME with the name as the QUIT ACTION!)
    ;
    ; !!! R3-Alpha permitted arbitrary values for parameterized QUIT, which
    ; would be what DO of a script would return.  But if not an integer,
    ; they have to be mapped to an operating system exit status:
    ;
    ; https://en.wikipedia.org/wiki/Exit_status
    ;
    all [
        error? status
        status/id = 'no-catch
        :status/arg2 = :QUIT ;; name
    ] then [
        assert [unset? 'result]

        return <- 1 unless case [
            null? :status/arg1 [0] ;-- plain QUIT, no /WITH, call that success

            blank? :status/arg1 [0] ;-- consider blank also to be success

            integer? :status/arg1 [status/arg1] ;-- may be out of status range

            error? :status/arg1 [1] ;-- !!! integer error mapping deprecated
        ]
    ]

    ; HALT handling (uncaught THROW/NAME with the name as the HALT ACTION!)
    ;
    all [
        error? status
        status/id = 'no-catch
        :status/arg2 = :HALT ;; name
    ] then [
        assert [unset? 'result]
        if find directives #quit-if-halt [
            return 128 + 2 ; standard cancellation exit status for bash
        ]
        if find directives #console-if-halt [
            emit [start-console]
            return <prompt>
        ]
        if find directives #unskin-if-halt [
            print "** UNSAFE HALT ENCOUNTERED IN CONSOLE SKIN"
            print "** REVERTING TO DEFAULT SKIN"
            system/console: make console! []
            print mold prior ;-- Might help debug to see what was running
        ]
        emit #unskin-if-halt
        emit [system/console/print-halted]
        return <prompt>
    ]

    if error? status [
        assert [unset? 'result]

        ; Errors can occur during HOST-START, before the SYSTEM/CONSOLE has
        ; a chance to be initialized (it may *never* be initialized if the
        ; interpreter is being called non-interactively from the shell).
        ;
        if object? system/console [
            emit [system/console/print-error ((status))]
        ] else [
            emit [print ((status))]
        ]
        if find directives #die-if-error [
            return <die>
        ]
        if find directives #halt-if-error [
            return <halt>
        ]
        if find directives #countdown-if-error [
            emit #console-if-halt
            emit [
                print-newline
                print "** Hit Ctrl-C to break into the console in 5 seconds"

                repeat n 25 [
                    if remainder n 5 = 1 [
                        write-stdout form (5 - to-integer (n / 5))
                    ] else [
                        write-stdout "."
                    ]
                    wait 0.25
                ]
                print-newline
            ]
            emit {Only gets here if user did not hit Ctrl-C}
            return <die>
        ]
        if block? prior [
            case [
                find directives #host-console-error [
                    print "** HOST-CONSOLE ACTION! ITSELF RAISED ERROR"
                    print "** SAFE RECOVERY NOT LIKELY, BUT TRYING ANYWAY"
                ]
                not find directives #no-unskin-if-error [
                    print "** UNSAFE ERROR ENCOUNTERED IN CONSOLE SKIN"
                ]
                print mold status
            ] also [
                print "** REVERTING TO DEFAULT SKIN"
                system/console: make console! []
                print mold prior ;-- Might help debug to see what was running
            ]
        ]
        return <prompt>
    ]

    assert [blank? status] ;-- no failure or halts during last execution

    if group? prior [ ;-- plain execution of user code
        emit [system/console/print-result ((uneval :result))]
        return <prompt>
    ]

    ; If PRIOR is BLOCK!, this is a continuation the console sent to itself.
    ; RESULT can be:
    ;
    ; GROUP! - code to be run in a sandbox on behalf of the user
    ; BLOCK! - block of gathered input lines so far, need another one
    ;
    assert [block? prior]

    if group? result [
        if empty? result [return <prompt>] ;-- user just hit enter, don't run
        return result ;-- GROUP! signals we're running user-requested code
    ]

    if not block? result [
        return <bad>
    ]

    ;-- INPUT-HOOK ran, block of strings ready

    assert [not empty? result] ;-- should have at least one item

    if blank? last result [
        ;
        ; It was aborted.  This comes from ESC on POSIX (which is the ideal
        ; behavior), Ctrl-D on Windows (because ReadConsole() can't trap ESC),
        ; Ctrl-D on POSIX (just to be compatible with Windows).
        ;
        return <prompt>
    ]

    trap/with [
        ;
        ; Note that LOAD/ALL makes BLOCK! even for a single item,
        ; e.g. `load/all "word"` => `[word]`
        ;
        code: load/all delimit result newline
        assert [block? code]

    ] error -> [
        ;
        ; If loading the string gave back an error, check to see if it
        ; was the kind of error that comes from having partial input
        ; (scan-missing).  If so, CONTINUE and read more data until
        ; it's complete (or until an empty line signals to just report
        ; the error as-is)
        ;
        if error/id = 'scan-missing [
            ;
            ; Error message tells you what's missing, not what's open and
            ; needs to be closed.  Invert the symbol.
            ;
            switch error/arg1 [
                "}" ["{"]
                ")" ["("]
                "]" ["["]
            ] also unclosed -> [
                ;
                ; Backslash is used in the second column to help make a
                ; pattern that isn't legal in Rebol code, which is also
                ; uncommon in program output.  This enables detection of
                ; transcripts, potentially to replay them without running
                ; program output or evaluation results.
                ;
                write-stdout unspaced [unclosed #"\" space space]
                emit compose/deep [reduce [
                    (result)
                    system/console/input-hook
                ]]

                return block!
            ]
        ]

        ; Could be an unclosed double quote (unclosed tag?) which more input
        ; on a new line cannot legally close ATM
        ;
        emit [system/console/print-error ((error))]
        return <prompt>
    ]

    if did shortcut: select system/console/shortcuts try first code [
        ;
        ; Shortcuts like `q => [quit]`, `d => [dump]`
        ;
        if (bound? code/1) and (set? code/1) [
            ;
            ; Help confused user who might not know about the shortcut not
            ; panic by giving them a message.  Reduce noise for the casual
            ; shortcut by only doing so when a bound variable exists.
            ;
            emit [system/console/print-warning ((
                spaced [
                    uppercase to string! code/1
                        "interpreted by console as:" mold :shortcut
                ]
            ))]
            emit [system/console/print-warning ((
                spaced ["use" to get-word! code/1 "to get variable."]
            ))]
        ]
        take code
        insert code shortcut
    ]

    ; There is a question of how it should be decided whether the code in the
    ; CONSOLE should be locked as read-only or not.  It may be a configuration
    ; switch, as it also may be an option for a module or a special type of
    ; function which does not lock its source.
    ;
    lock code

    ; Run the "dialect hook", which can transform the completed code block
    ;
    emit #unskin-if-halt ;-- Ctrl-C during dialect hook is a problem
    emit [as group! system/console/dialect-hook ((code))]
    return group! ;-- a group RESULT should come back to HOST-CONSOLE
]


why: procedure [
    "Explain the last error in more detail."
    'err [<end> word! path! error! blank!] "Optional error value"
][
    err: default [system/state/last-error]

    if match [word! path!] err [
        err: get err
    ]

    if error? err [
        say-browser
        err: lowercase unspaced [err/type #"-" err/id]
        browse join-of http://www.rebol.com/r3/docs/errors/ [err ".html"]
    ] else [
        print "No information is available."
    ]
]


upgrade: procedure [
    "Check for newer versions."
][
    ; Should this be a console-detected command, like Q, or is it meaningful
    ; to define this as a function you could call from code?
    ;
    do <upgrade>
]


; The ECHO routine has to collaborate specifically with the console, because
; it is often desirable to capture the input only, the output only, or both.
;
; !!! The features that tie the echo specifically to the console would be
; things like ECHO INPUT, e.g.:
;
; https://github.com/red/red/issues/2487
;
; They are not implemented yet, but ECHO is moved here to signify the known
; issue that the CONSOLE must collaborate specifically with ECHO to achieve
; this.
;
echo: procedure [
    {Copies console I/O to a file.}

    'instruction [file! string! block! word!]
        {File or template with * substitution, or command: [ON OFF RESET].}

    <static>
    target ([%echo * %.txt])
    form-target
    sub ("")
    old-input (copy :input)
    old-write-stdout (copy :write-stdout)
    hook-in
    hook-out
    logger
    ensure-echo-on
    ensure-echo-off
][
    ; Sample "interesting" feature, be willing to form the filename by filling
    ; in the blank with a substitute string you can change.
    ;
    form-target: default [func [return: [file!]] [
        either block? target [
            as file! unspaced replace (copy target) '* (
                either empty? sub [[]] [unspaced ["-" sub]]
            )
        ][
            target
        ]
    ]]

    logger: default [func [value][
        write/append form-target either char? value [to-string value][value]
        value
    ]]

    ; Installed hook; in an ideal world, WRITE-STDOUT would not exist and
    ; would just be WRITE, so this would be hooking WRITE and checking for
    ; STDOUT or falling through.  Note WRITE doesn't take CHAR! right now.
    ;
    hook-out: default [proc [
        value [string! char! binary!]
            {Text to write, if a STRING! or CHAR! is converted to OS format}
    ][
        old-write-stdout value
        logger value
    ]]

    ; It looks a bit strange to look at a console log without the input
    ; being included too.  Note that hooking the input function doesn't get
    ; the newlines, has to be added.
    ;
    hook-in: default [
        chain [
            :old-input
                |
            func [value] [
                logger value
                logger newline
                value ;-- hook still needs to return the original value
            ]
        ]
    ]

    ensure-echo-on: default [does [
        ;
        ; Hijacking is a NO-OP if the functions are the same.
        ; (this is indicated by a BLANK! return vs an ACTION!)
        ;
        hijack 'write-stdout 'hook-out
        hijack 'input 'hook-in
    ]]

    ensure-echo-off: default [does [
        ;
        ; Restoring a hijacked function with its original will
        ; remove any overhead and be as fast as it was originally.
        ;
        hijack 'write-stdout 'old-write-stdout
        hijack 'input 'old-input
    ]]

    case [
        word? instruction [
            switch instruction [
                on [ensure-echo-on]
                off [ensure-echo-off]
                reset [
                    delete form-target
                    write/append form-target "" ;-- or just have it not exist?
                ]
            ] else [
                word: to-uppercase word
                fail [
                    "Unknown ECHO command, not [ON OFF RESET]"
                        |
                    unspaced ["Use ECHO (" word ") to force evaluation"]
                ]
            ]
        ]

        string? instruction [
            sub: instruction
            ensure-echo-on
        ]

        any [block? instruction | file? instruction] [
            target: instruction
            ensure-echo-on
        ]
    ]
]

REBOL [
    System: "REBOL [R3] Language Interpreter and Run-time Environment"
    Title: "Host Console (Rebol's Read-Eval-Print-Loop, ie. REPL)"
    Rights: {
        Copyright 2016-2017 Rebol Open Source Contributors
        REBOL is a trademark of REBOL Technologies
    }
    License: {
        Licensed under the Apache License, Version 2.0
        See: http://www.apache.org/licenses/LICENSE-2.0
    }
    Description: {
        This is a rich, skinnable console for Rebol--where basically all the
        implementation is itself userspace Rebol code.  Documentation for the
        skinning hooks exist here:

        https://github.com/r3n/reboldocs/wiki/User-and-Console

        The HOST-CONSOLE Rebol function is invoked in a loop by a small C
        main function (see %host-main.c).  HOST-CONSOLE does not itself run
        arbitrary user code with DO.  That would be risky, because it actually
        is not allowed to fail or be canceled with Ctrl-C.  Instead, it just
        gathers input...and produces a block which is returned to C to
        actually execute.

        This design allows the console to sandbox potentially misbehaving
        skin code, and fall back on a default skin if there is a problem.
        It also makes sure that that user code doesn't see the console's
        implementation in its backtrace.

        !!! While not implemented in C as the R3-Alpha console was, this
        code relies upon the INPUT function to communicate with the user.
        INPUT is a black box that reads whole lines from the "console port",
        which is implemented via termios on POSIX and the Win32 Console API
        on Windows:

        https://blog.nelhage.com/2009/12/a-brief-introduction-to-termios/
        https://docs.microsoft.com/en-us/windows/console/console-functions

        Someday in the future, the console port itself should offer keystroke
        events and allow the line history (e.g. Cursor Up, Cursor Down) to be
        implemented in Rebol as well.
     }
]

; Define console! object for skinning - stub for elsewhere?
;
console!: make object! [
    name: _
    repl: true      ;-- used to identify this as a console! object (quack!)
    is-loaded:  false ;-- if true then this is a loaded (external) skin
    was-updated: false ;-- if true then console! object found in loaded skin
    last-result: _  ;-- last evaluated result (sent by HOST-CONSOLE)

    ;; APPEARANCE (can be overridden)

    prompt:   {>>}
    result:   {==}
    warning:  {!!}
    error:    {**}                 ;; not used yet
    info:     to-string #{e29398}  ;; info sign!
    greeting: _

    print-prompt: proc [] [
        ;
        ; !!! Previously the HOST-CONSOLE hook explicitly took an (optional)
        ; FRAME! where a debug session was focused and a stack depth integer,
        ; which was put into the prompt.  This feature is not strictly
        ; necessary (just helpful), and made HOST-CONSOLE seem less generic.
        ; It would make more sense for aspects of the debugger's state to
        ; be picked up from the environment somewhere (who's to say the
        ; focus-frame and focus-level are the only two relevant things)?
        ;
        ; For now, comment out the feature...and assume if it came back it
        ; would be grafted here in the PRINT-PROMPT.
        ;
        comment [
            ; If a debug frame is in focus then show it in the prompt, e.g.
            ; as `if:|4|>>` to indicate stack frame 4 is being examined, and
            ; it was an `if` statement...so it will be used for binding (you
            ; can examine the condition and branch for instance)
            ;
            if focus-frame [
                if label-of focus-frame [
                    write-stdout unspaced [label-of focus-frame ":"]
                ]
                write-stdout unspaced ["|" focus-level "|"]
            ]
        ]

        ; We don't want to use PRINT here because it would put the cursor on
        ; a new line.
        ;
        write-stdout identity block? prompt then [
            unspaced prompt
        ] else [
            form prompt
        ]
        write-stdout space
    ]

    print-result: proc [v [<opt> any-value!]]  [
        last-result: :v
        case [
            null? :v [
                ; Historically Rebol wouldn't print any eval result in the
                ; case of things that "didn't return a value".  Trying to
                ; do otherwise e.g. by printing `;-- null` is annoying.
                ;
                ; (It might be useful feedback for commands which have none of
                ; their own output, however.)
            ]
        ]
        else [
            print [result (mold :v)]
        ]
    ]

    print-warning:  proc [s] [print [warning reduce s]]
    print-error:    proc [e [error!]] [print e]

    print-halted: proc [] [
        print "[interrupted by Ctrl-C or HALT instruction]"
    ]

    print-info:     proc [s] [print [info space space space reduce s]]
    print-greeting: proc []  [boot-print greeting]
    print-gap:      proc []  [print-newline]

    ;; BEHAVIOR (can be overridden)

    input-hook: func [
        {Receives line input, parse/transform, send back to CONSOLE eval}

        return: "BLANK! if canceled, otherwise processed string input"
            [blank! string!]
    ][
        input
    ]

    dialect-hook: func [
        {Receives code block, parse/transform, send back to CONSOLE eval}
        b [block!]
    ][
        ; !!! As with the notes on PRINT-PROMPT, the concept that the
        ; debugger parameterizes the HOST-CONSOLE function directly is being
        ; phased out.  So things like showing the stack level in the prompt,
        ; or binding code into the frame with focus, is something that would
        ; be the job of a "debugger skin" which extracts its parameterization
        ; from the environment.  Once these features are thought out more,
        ; that skin can be implemented (or the default skin can just look
        ; for debug state, and not apply debug skinning if it's not present.)
        ;
        comment [
            if focus-frame [
                bind code focus-frame
            ]
        ]

        b
    ]

    shortcuts: make object! compose/deep [
        d: [dump]
        h: [help]
        q: [quit]
        dt: [delta-time]
        dp: [delta-profile]

        list-shortcuts: [print system/console/shortcuts]
        changes: [
            say-browser
            browse (join-all [
                https://github.com/metaeducation/ren-c/blob/master/CHANGES.md#
                join-all ["" system/version/1 system/version/2 system/version/3]
            ])
        ]
        topics: [
            say-browser
            browse https://r3n.github.io/topics/
        ]
    ]

    ;; HELPERS (could be overridden!)

    add-shortcut: proc [
        {Add/Change console shortcut}
        name  [any-word!]
            {shortcut name}
        block [block!]
            {command(s) expanded to}
    ][
        extend shortcuts name block
    ]
]


start-console: procedure [
    "Called when a REPL is desired after command-line processing, vs quitting"

    <static>
        o (system/options) ;-- shorthand since options are often read/written
][
    ; Instantiate console! object into system/console for skinning.  This
    ; object can be updated %console-skin.reb if in system/options/resources

    loud-print "Starting console..."
    loud-print ""
    proto-skin: make console! []
    skin-error: _

    if all [
        skin-file: %console-skin.reb
        not find o/suppress skin-file
        o/resources
        exists? skin-file: join-of o/resources skin-file
    ][
        trap/with [
            new-skin: do load skin-file

            ;; if loaded skin returns console! object then use as prototype
            all [
                object? new-skin
                did select new-skin 'repl ;; quacks like REPL, it's a console!
            ] then [
                proto-skin: new-skin
                proto-skin/was-updated: true
                proto-skin/name: default ["updated"]
            ]

            proto-skin/is-loaded: true
            proto-skin/name: default ["loaded"]
            append o/loaded skin-file

        ] func [error] [
            skin-error: error       ;; show error later if --verbose
            proto-skin/name: "error"
        ]
    ]

    proto-skin/name: default ["default"]

    system/console: proto-skin

    ; Make the error hook store the error as the last one printed, so the
    ; WHY command can access it.  Also inform people of the existence of
    ; the WHY function on the first error delivery.
    ;
    proto-skin/print-error: adapt :proto-skin/print-error [
        if not system/state/last-error [
            system/console/print-info "Note: use WHY for error information"
        ]

        system/state/last-error: e
    ]

    ; banner time
    ;
    if o/about [
        ;-- print fancy boot banner
        ;
        boot-print make-banner boot-banner
    ] else [
        boot-print [
            "Rebol 3 (Ren-C branch)"
            mold compose [version: (system/version) build: (system/build)]
            newline
        ]
    ]

    boot-print boot-welcome

    ; verbose console skinning messages
    loud-print [newline {Console skinning:} newline]
    if skin-error [
        loud-print [
            {  Error loading console skin  -} skin-file LF LF
            skin-error LF LF
            {  Fix error and restart CONSOLE}
        ]
    ] else [
       loud-print [
            space space
            proto-skin/is-loaded ?? {Loaded skin} !! {Skin does not exist}
            "-" skin-file
            spaced [
                "(CONSOLE" (proto-skin/was-updated ?! {not}) "updated)"
            ]
        ]
    ]
]


host-console: function [
    {Rebol ACTION! that is called from C in a loop to implement the console}

    return: "Code submission for C caller to run in a sandbox, or exit status"
        [block! group! integer!] ;-- Note: RETURN is hooked/overridden!!!
    prior "BLOCK! or GROUP! that last invocation of HOST-CONSOLE requested"
        [blank! block! group!]
    result "The result from evaluating PRIOR, unless error (then use STATUS)"
        [<opt> any-value!]
    status "BLANK! if no error, or ERROR! if problem (includes HALT, QUIT...)"
        [blank! error!]
][
    ; We hook the RETURN function so that it actually returns an instruction
    ; that the code can build up from multiple EMIT statements.

    instruction: copy []

    emit: function [
        {Builds up sandboxed code to submit to C, hooked RETURN will finalize}

        item "ISSUE! directive, STRING! comment, ((composed)) code BLOCK!"
            [block! issue! string!]
        <with> instruction
    ][
        really* case [
            issue? item [
                if not empty? instruction [append/line instruction '|]
                insert instruction item
            ]
            string? item [
                append/line instruction compose [comment (item)]
            ]
            block? item [
                if not empty? instruction [append/line instruction '|]
                append/line instruction composeII/deep/only item
            ]
        ]
    ]

    return: function [
        {Hooked RETURN function which finalizes any gathered EMIT lines}

        state "Describes the RESULT that the next call to HOST-CONSOLE gets"
            [integer! tag! group! datatype!]
        <with> instruction prior
        <local> return-to-c (:return) ;-- capture HOST-CONSOLE's RETURN
    ][
        switch state [
            <prompt> [
                emit [system/console/print-gap]
                emit [system/console/print-prompt]
                emit [reduce [
                    system/console/input-hook
                ]] ;-- gather first line (or BLANK!), put in BLOCK!
            ]
            <halt> [
                emit [halt]
                emit [fail {^-- Shouldn't get here, due to HALT}]
            ]
            <die> [
                emit [quit/with 1] ;-- catch-all bash code for general errors
                emit [fail {^-- Shouldn't get here, due to QUIT}]
            ]
            <bad> [
                emit #no-unskin-if-error
                emit [fail ["Bad REPL continuation:" ((uneval result))]]
                emit [print ((mold uneval prior))]
            ]
        ] also [
            return-to-c instruction
        ]

        return-to-c <- switch type of state [
            (integer!) [ ;-- just tells the calling C loop to exit() process
                assert [empty? instruction]
                state
            ]
            (datatype!) [ ;-- type assertion, how to enforce this?
                emit spaced ["^-- Result should be" an state]
                instruction
            ]
            (group!) [ ;-- means "submit user code"
                assert [empty? instruction]
                state
            ]
        ] else [
            emit [fail [{Bad console instruction:} ((mold state))]]
        ]
    ]

    if not prior [ ;-- First call, do startup and command-line processing
        ;
        ; !!! We get some properties passed from the C main() as a BLOCK! in
        ; result.  These should probably be injected into the environment
        ; somehow instead.
        ;
        assert [not status | block? result | length of result = 3]
        set [exec-path: argv: boot-exts:] result
        return (host-start exec-path argv boot-exts :emit :return)
    ]

    ; BLOCK! code execution represents an instruction sent by the console to
    ; itself.  Some #directives may be at the head of these blocks.
    ;
    directives: [] unless if block? prior [
        collect [
            parse prior [some [set i: issue! (keep i)]]
        ]
    ]

    ; QUIT handling (uncaught THROW/NAME with the name as the QUIT ACTION!)
    ;
    ; !!! R3-Alpha permitted arbitrary values for parameterized QUIT, which
    ; would be what DO of a script would return.  But if not an integer,
    ; they have to be mapped to an operating system exit status:
    ;
    ; https://en.wikipedia.org/wiki/Exit_status
    ;
    all [
        error? status
        status/id = 'no-catch
        :status/arg2 = :QUIT ;; name
    ] then [
        assert [unset? 'result]

        return <- 1 unless case [
            null? :status/arg1 [0] ;-- plain QUIT, no /WITH, call that success

            blank? :status/arg1 [0] ;-- consider blank also to be success

            integer? :status/arg1 [status/arg1] ;-- may be out of status range

            error? :status/arg1 [1] ;-- !!! integer error mapping deprecated
        ]
    ]

    ; HALT handling (uncaught THROW/NAME with the name as the HALT ACTION!)
    ;
    all [
        error? status
        status/id = 'no-catch
        :status/arg2 = :HALT ;; name
    ] then [
        assert [unset? 'result]
        if find directives #quit-if-halt [
            return 128 + 2 ; standard cancellation exit status for bash
        ]
        if find directives #console-if-halt [
            emit [start-console]
            return <prompt>
        ]
        if find directives #unskin-if-halt [
            print "** UNSAFE HALT ENCOUNTERED IN CONSOLE SKIN"
            print "** REVERTING TO DEFAULT SKIN"
            system/console: make console! []
            print mold prior ;-- Might help debug to see what was running
        ]
        emit #unskin-if-halt
        emit [system/console/print-halted]
        return <prompt>
    ]

    if error? status [
        assert [unset? 'result]

        ; Errors can occur during HOST-START, before the SYSTEM/CONSOLE has
        ; a chance to be initialized (it may *never* be initialized if the
        ; interpreter is being called non-interactively from the shell).
        ;
        if object? system/console [
            emit [system/console/print-error ((status))]
        ] else [
            emit [print ((status))]
        ]
        if find directives #die-if-error [
            return <die>
        ]
        if find directives #halt-if-error [
            return <halt>
        ]
        if find directives #countdown-if-error [
            emit #console-if-halt
            emit [
                print-newline
                print "** Hit Ctrl-C to break into the console in 5 seconds"

                repeat n 25 [
                    if remainder n 5 = 1 [
                        write-stdout form (5 - to-integer (n / 5))
                    ] else [
                        write-stdout "."
                    ]
                    wait 0.25
                ]
                print-newline
            ]
            emit {Only gets here if user did not hit Ctrl-C}
            return <die>
        ]
        if block? prior [
            case [
                find directives #host-console-error [
                    print "** HOST-CONSOLE ACTION! ITSELF RAISED ERROR"
                    print "** SAFE RECOVERY NOT LIKELY, BUT TRYING ANYWAY"
                ]
                not find directives #no-unskin-if-error [
                    print "** UNSAFE ERROR ENCOUNTERED IN CONSOLE SKIN"
                ]
                print mold status
            ] also [
                print "** REVERTING TO DEFAULT SKIN"
                system/console: make console! []
                print mold prior ;-- Might help debug to see what was running
            ]
        ]
        return <prompt>
    ]

    assert [blank? status] ;-- no failure or halts during last execution

    if group? prior [ ;-- plain execution of user code
        emit [system/console/print-result ((uneval :result))]
        return <prompt>
    ]

    ; If PRIOR is BLOCK!, this is a continuation the console sent to itself.
    ; RESULT can be:
    ;
    ; GROUP! - code to be run in a sandbox on behalf of the user
    ; BLOCK! - block of gathered input lines so far, need another one
    ;
    assert [block? prior]

    if group? result [
        if empty? result [return <prompt>] ;-- user just hit enter, don't run
        return result ;-- GROUP! signals we're running user-requested code
    ]

    if not block? result [
        return <bad>
    ]

    ;-- INPUT-HOOK ran, block of strings ready

    assert [not empty? result] ;-- should have at least one item

    if blank? last result [
        ;
        ; It was aborted.  This comes from ESC on POSIX (which is the ideal
        ; behavior), Ctrl-D on Windows (because ReadConsole() can't trap ESC),
        ; Ctrl-D on POSIX (just to be compatible with Windows).
        ;
        return <prompt>
    ]

    trap/with [
        ;
        ; Note that LOAD/ALL makes BLOCK! even for a single item,
        ; e.g. `load/all "word"` => `[word]`
        ;
        code: load/all delimit result newline
        assert [block? code]

    ] error -> [
        ;
        ; If loading the string gave back an error, check to see if it
        ; was the kind of error that comes from having partial input
        ; (scan-missing).  If so, CONTINUE and read more data until
        ; it's complete (or until an empty line signals to just report
        ; the error as-is)
        ;
        if error/id = 'scan-missing [
            ;
            ; Error message tells you what's missing, not what's open and
            ; needs to be closed.  Invert the symbol.
            ;
            switch error/arg1 [
                "}" ["{"]
                ")" ["("]
                "]" ["["]
            ] also unclosed -> [
                ;
                ; Backslash is used in the second column to help make a
                ; pattern that isn't legal in Rebol code, which is also
                ; uncommon in program output.  This enables detection of
                ; transcripts, potentially to replay them without running
                ; program output or evaluation results.
                ;
                write-stdout unspaced [unclosed #"\" space space]
                emit compose/deep [reduce [
                    (result)
                    system/console/input-hook
                ]]

                return block!
            ]
        ]

        ; Could be an unclosed double quote (unclosed tag?) which more input
        ; on a new line cannot legally close ATM
        ;
        emit [system/console/print-error ((error))]
        return <prompt>
    ]

    if did shortcut: select system/console/shortcuts try first code [
        ;
        ; Shortcuts like `q => [quit]`, `d => [dump]`
        ;
        if (bound? code/1) and (set? code/1) [
            ;
            ; Help confused user who might not know about the shortcut not
            ; panic by giving them a message.  Reduce noise for the casual
            ; shortcut by only doing so when a bound variable exists.
            ;
            emit [system/console/print-warning ((
                spaced [
                    uppercase to string! code/1
                        "interpreted by console as:" mold :shortcut
                ]
            ))]
            emit [system/console/print-warning ((
                spaced ["use" to get-word! code/1 "to get variable."]
            ))]
        ]
        take code
        insert code shortcut
    ]

    ; There is a question of how it should be decided whether the code in the
    ; CONSOLE should be locked as read-only or not.  It may be a configuration
    ; switch, as it also may be an option for a module or a special type of
    ; function which does not lock its source.
    ;
    lock code

    ; Run the "dialect hook", which can transform the completed code block
    ;
    emit #unskin-if-halt ;-- Ctrl-C during dialect hook is a problem
    emit [as group! system/console/dialect-hook ((code))]
    return group! ;-- a group RESULT should come back to HOST-CONSOLE
]


why: procedure [
    "Explain the last error in more detail."
    'err [<end> word! path! error! blank!] "Optional error value"
][
    err: default [system/state/last-error]

    if match [word! path!] err [
        err: get err
    ]

    if error? err [
        say-browser
        err: lowercase unspaced [err/type #"-" err/id]
        browse join-of http://www.rebol.com/r3/docs/errors/ [err ".html"]
    ] else [
        print "No information is available."
    ]
]


upgrade: procedure [
    "Check for newer versions."
][
    ; Should this be a console-detected command, like Q, or is it meaningful
    ; to define this as a function you could call from code?
    ;
    do <upgrade>
]


; The ECHO routine has to collaborate specifically with the console, because
; it is often desirable to capture the input only, the output only, or both.
;
; !!! The features that tie the echo specifically to the console would be
; things like ECHO INPUT, e.g.:
;
; https://github.com/red/red/issues/2487
;
; They are not implemented yet, but ECHO is moved here to signify the known
; issue that the CONSOLE must collaborate specifically with ECHO to achieve
; this.
;
echo: procedure [
    {Copies console I/O to a file.}

    'instruction [file! string! block! word!]
        {File or template with * substitution, or command: [ON OFF RESET].}

    <static>
    target ([%echo * %.txt])
    form-target
    sub ("")
    old-input (copy :input)
    old-write-stdout (copy :write-stdout)
    hook-in
    hook-out
    logger
    ensure-echo-on
    ensure-echo-off
][
    ; Sample "interesting" feature, be willing to form the filename by filling
    ; in the blank with a substitute string you can change.
    ;
    form-target: default [func [return: [file!]] [
        either block? target [
            as file! unspaced replace (copy target) '* (
                either empty? sub [[]] [unspaced ["-" sub]]
            )
        ][
            target
        ]
    ]]

    logger: default [func [value][
        write/append form-target either char? value [to-string value][value]
        value
    ]]

    ; Installed hook; in an ideal world, WRITE-STDOUT would not exist and
    ; would just be WRITE, so this would be hooking WRITE and checking for
    ; STDOUT or falling through.  Note WRITE doesn't take CHAR! right now.
    ;
    hook-out: default [proc [
        value [string! char! binary!]
            {Text to write, if a STRING! or CHAR! is converted to OS format}
    ][
        old-write-stdout value
        logger value
    ]]

    ; It looks a bit strange to look at a console log without the input
    ; being included too.  Note that hooking the input function doesn't get
    ; the newlines, has to be added.
    ;
    hook-in: default [
        chain [
            :old-input
                |
            func [value] [
                logger value
                logger newline
                value ;-- hook still needs to return the original value
            ]
        ]
    ]

    ensure-echo-on: default [does [
        ;
        ; Hijacking is a NO-OP if the functions are the same.
        ; (this is indicated by a BLANK! return vs an ACTION!)
        ;
        hijack 'write-stdout 'hook-out
        hijack 'input 'hook-in
    ]]

    ensure-echo-off: default [does [
        ;
        ; Restoring a hijacked function with its original will
        ; remove any overhead and be as fast as it was originally.
        ;
        hijack 'write-stdout 'old-write-stdout
        hijack 'input 'old-input
    ]]

    case [
        word? instruction [
            switch instruction [
                on [ensure-echo-on]
                off [ensure-echo-off]
                reset [
                    delete form-target
                    write/append form-target "" ;-- or just have it not exist?
                ]
            ] else [
                word: to-uppercase word
                fail [
                    "Unknown ECHO command, not [ON OFF RESET]"
                        |
                    unspaced ["Use ECHO (" word ") to force evaluation"]
                ]
            ]
        ]

        string? instruction [
            sub: instruction
            ensure-echo-on
        ]

        any [block? instruction | file? instruction] [
            target: instruction
            ensure-echo-on
        ]
    ]
]
