;; ============================================
;; Script: mini-edit-do.r
;; downloaded from: www.REBOL.org
;; on: 13-Mar-2018
;; at: 4:07:08.910747 UTC
;; owner: luce80 [script library member who can
;; update this script]
;; ============================================
Rebol [
    title: "Mini-edit-do"
    file: %mini-edit-do.r
    author: "Marco Antoniazzi"
    Copyright: "(C) 2012-2017 Marco Antoniazzi. All Rights reserved."
    email: [luce80 AT libero DOT it]
    date: 09-09-2017
    version: 0.8.0
    Purpose: "Helps test short programs (substitutes console)"
    History: [
        0.0.1 [30-04-2012 "First version"]
        0.5.1 [01-05-2012 "Fixed using view and quit"]
        0.5.2 [05-05-2012 "Added undo and redo"]
        0.5.3 [10-05-2012 "Fixed last probe"]
        0.5.4 [12-05-2012 "Added halt and other minor fixes"]
        0.5.5 [20-05-2012 "Fixed error inside prin and script header"]
        0.5.6 [03-06-2012 "Fixed bug when deleting all"]
        0.5.7 [08-06-2012 "Fixed undo after clear all"]
        0.5.8 [29-07-2012 "Fixed arg1 etc. in err?"]
        0.5.9 [09-08-2012 "Fixed ^X and save after clear all, arg1, do-face"]
        0.6.1 [03-01-2013 "Added pseudo-console"]
        0.6.2 [03-01-2013 "Fixed focus before undo/redo"]
        0.6.3 [16-03-2013 "Fixed last line being a comment"]
        0.6.4 [06-04-2013 "Fixed mini console button do script"]
        0.6.5 [16-06-2013 "Fixed mini console resizing"]
        0.6.6 [28-07-2013 "Improved word selection and skipping for area-scroll-style"]
        0.6.7 [30-12-2013 "Fixed word selection and skipping for area-scroll-style"]
        0.7.0 [25-01-2014 "Added mini-source level debugger"]
        0.7.1 [14-05-2017 "Fixes bug when closing foreing window"]
        0.8.0 [09-09-2017 "Added live VID and live Draw"]
    ]
    comment: {30-Apr-2012 GUI automatically generated by VID_build. Author: Marco Antoniazzi.
        Derived directly from ParseAid.r
    }
    library: [
        level: 'intermediate
        platform: 'all
        type: 'tool
        domain: [debug testing]
        tested-under: [View 2.7.8.3.1]
        support: none
        license: 'BSD
        see-also: %parse-aid.r
    ]
    todo: {
        - options: 
            - set max area-results length
            - set max dumped obj length
            - choose between head or tail of dumped obj
        - patch ALL functions to use err? (to output errors to my prog)
        - add "Mini help/source"
        - add profiler
        - add prettyfier
    }
    Help: {
        The *MINI* source level debugger is REALLY minimal (and buggy). I can not patch "if" and "either" so
        you have to write "dif" and "deither" to use a patched version.
    }
]

    err?: func [blk /local arg1 arg2 arg3 message err][;derived from 11-Feb-2007 Guest2
        if not error? set/any 'err try blk [return get/any 'err]
        err: disarm err
        arg1: any [attempt [get in err 'arg1] 'unset]
        arg2: get in err 'arg2
        arg3: get in err 'arg3
        message: get err/id
        if block? message [bind message 'arg1]
        prin* ["** ERROR:" form reduce message newline]
        prin* ["** Near:" either block? err/near [mold/only err/near][err/near] newline]
        throw
    ]
; patches
    doing: false
    old-length: 0
    old-prin: :prin old-print: :print ; use these to output to console
    old-probe: func [value] [old-print mold :value :value]
    old-quit: :quit
    quit: does [
        ; closing all windows (except ours) is similar to quitting ...
        foreach face next System/view/screen-face/pane [unview/only face]
    ]
    halt: does [] ; avoid opening console
    prin*: func [value][
        set-face/no-show output-face append get-face output-face form reduce value
        system/view/vid/vid-feel/move-drag output-face/vscroll/pane/3 1 ; autoscroll down
    ]
    prin: func [value] [
        either all [(100000 + old-length) > length? get-face output-face doing] [ ; avoid fill mem
            set-face/no-show output-face append get-face output-face form err? [reduce value]
            system/view/vid/vid-feel/move-drag output-face/vscroll/pane/3 1 ; autoscroll down
            wait 0.0001 ; avoid blocking the gui
        ][
            if confirm/with "ERROR. Probable infinite loop. Clear Results?" ["Yes" "Cancel"] [reset-face output-face]
            throw
        ]
        exit ; force unsetting result
    ]
    print: func [value] [prin value prin newline]
    probbed: none
    probe: func [value] [probbed: get 'value print mold :value :value]
    *isolator: context [
        func: make function! [
            "Defines a user function with given spec and body." 
            [catch] 
            spec [block!] {Help string (opt) followed by arg words (and opt type and string)} 
            body [block!] "The body block of the function"
        ][
            throw-on-error [make function! spec compose/deep [err? [(body)]]]
        ]
        view: func ; taken from "REBOL Word Browser (Dictionary)" Author: "Carl Sassenrath"
            first get in system/words 'view
            head insert copy/deep second get in system/words 'view [new: true]
    ]
    do-face: func [face value] [ ; (needs to work for functions and blocks)
        err?[do get in face 'action face either value [value][face/data]]
    ]
    do-face-alt: func [face value] [
        err?[do get in face 'alt-action face either value [value][face/data]]
    ]
    resize-face: func [
        "Resize a face."
        face
        size [number! pair!]
        /x "Resize only width"
        /y "Resize only heigth"
        /no-show "Do not show change yet"
        /local access
        ][
        either all [
            access: get in face 'access
            in access 'resize-face*
        ][
            access/resize-face* face size x y
        ][
            face/size: size * (add 1x0 to-integer not x 0x1 to-integer not y)
        ]
        if not no-show [show face]
        face
    ]
;
context [ ; protect our functions from being redefined
; file, undo
    change_title: func [/modified] [
        clear find/tail main-window/text "- "
        either modified [append main-window/text "*" saved?: no][saved?: yes]
        append main-window/text to-string last split-path any [job-name %Untitled]
        main-window/changes: [text] show main-window
    ]
    open_file: func [/local file-name job] [
        until [
            file-name: request-file/title/keep/only/filter "Load a Rebol file" "Load" "*.r"
            if none? file-name [exit]
            exists? file-name
        ]

        job-name: file-name
        job: read file-name
        set-face input-face job
        code: copy job

        named: yes
        change_title
        saved?: yes
    ]
    save_file: func [/as /local file-name filt ext response job] [
        ;if empty? job [return false]
        if not named [as: true]

        if as [
            filt: "*.r"
            ext: %.r
            file-name: request-file/title/keep/only/save/filter "Save as Rebol file" "Save" filt
            if none? file-name [return false]
            if not-equal? suffix? file-name ext [append file-name ext]
            response: true
            if exists? file-name [response: request rejoin [{File "} last split-path file-name {" already exists, overwrite it?}]]
            if response <> true [return false]
            job-name: file-name
            named: yes
        ]
        flash/with join "Saving to: " job-name main-window

        job: get-face input-face
        write job-name job
        code: copy job

        wait .8
        unview
        change_title
        saved?: yes
    ]
    undo: does [
        if system/view/focal-face <> input-face/ar [focus input-face/ar]
        input-face/undo
        if strict-equal? code get-face input-face [change_title]
    ]
    redo: does [
        if system/view/focal-face <> input-face/ar [focus input-face/ar]
        input-face/redo
        if strict-not-equal? code get-face input-face [change_title/modified]
    ]
; do
    test: func [text /console /local script result temp] [
        if all [not console get-face check-clear-res] [clear-face area-results old-length: 0]
        if all [console get-face check-clear-res-cons] [clear-face area-console-results]
        err? [
            probbed: none
            text: rejoin ["[" copy text "^/]"]
            script: attempt [load/header text]
            if none? script [script: load text insert script make system/script/header [] ]
            system/script/header: script/1 ; replace our header with the script's one
            doing: true
            set/any 'result do bind script *isolator
            text: none recycle
            old-length: old-length + length? get-face area-results
            if not unset? get/any 'result [
                temp: copy/part mold :result 100000
                if (length? temp) = 100000 [append temp "..."]
                either console [
                    print ["==" temp]
                ][
                    if not equal? mold :probbed temp [ ; avoid reprinting last result
                        print temp
                    ]
                ]
            ]
            doing: false
        ]
        get/any 'result
    ]
    test-code: {
    n: 1
    loop 10 [
        n: n + 1
        a: n
    ]
    deither 1 > 0 [print 1 n: 3][print 2]
    }
    codeg: []
    stepped: false
    source-debug: func [/step /local eval_code] [
        if all [get-face check-clear-res-debug] [clear-face area-debug-results old-length: 0]
        if step [stepped: true]
        dprin: func [value] [
            ;either all [(100000 + old-length) > length? get-face area-source doing] [ ; avoid fill mem
                set-face/no-show area-source append get-face area-source form err? [reduce value]
                system/view/vid/vid-feel/move-drag area-source/vscroll/pane/3 1 ; autoscroll down
                ;wait 0.0001 ; avoid blocking the gui
            ;][
            ;   if confirm/with "ERROR. Probable infinite loop. Clear Results?" ["Yes" "Cancel"] [reset-face area-source]
            ;   throw
            ;]
            exit ; force unsetting result
        ]
        dprobe: func [value] [probbed: get 'value dprin mold/only :value :value]
        ; patch natives
        natives: [loop while repeat for forall foreach ]
        foreach word natives[
            set load join 'native- word get word
        ]
        loop: func [count [integer!] block [block!]] [native-loop count [eval_code block]]
        while: func [cond-block [block!] body-block [block!]] [native-while [eval_code cond-block] [eval_code body-block]]
        repeat: func ['word [word!] value [integer! series!] body [block!]] [native-repeat :word value [eval_code body]]
        for: func [[catch throw] 'word [word!] start [number! series! money! time! date! char!] end [number! series! money! time! date! char!] bump [number! money! time! char!] body [block!] ][native-for :word start end bump [eval_code body]]
        forall: func [[catch throw] 'word [word!] body [block!] ][forall :word [eval_code body]]

        ; these are unpatchables so rename them
        dif: func [condition then-block [block!]] [if condition [eval_code then-block]]
        deither: func [condition true-block [block!] false-block [block!]] [either condition [eval_code true-block][eval_code false-block]]

        old-length: 0
        point_code: func [code] [
            ;old-print ["=>" mold code]
            nl: new-line? code
            if nl [new-line code off]
            insert code ###>>
            if nl [new-line code on]
            clear-face area-source
            dprobe head codeg
            remove code
            if nl [new-line code on]
            ;if block? code [eval_code]
        ] 
        eval_code: func [[throw] code] [
            ;old-print ["ent"  codeg]
            ;if not doing [return 0]
            
            either step [
                either empty? codeg [
                    codeg: load get-face area-test
                    ;if confirm "End of code reached. Reset it to beginning?" [codeg: load get-face area-test]
                ][
                    point_code code
                    set [value codeg] do/next code
                    print ["==" get/any 'value]
                ]
            ][
                native-while [not empty? code] [
                    point_code code
                    set [value code] do/next code
                    if not doing [codeg: tail codeg throw get/any 'value]
                    print ["==" get/any 'value]
                    attempt [wait load get-face field-wait]
                ]
                ; show that we are at the end (because we have finished)
                insert tail code [
                ###>>] ; keep this on a new line
                clear-face area-source
                dprobe head codeg
                remove back tail code
            ]
            
            get/any 'value
        ]
        doing: true
        ;old-print "1stendev"
        catch[eval_code codeg]
        if not stepped [codeg: none recycle]
        ;old-print "endev"
        
        doing: false
        old-length: old-length + length? get-face area-source
        ; restore original natives
        foreach word natives[
            set word get load join 'native- word
        ]
        ;codeg: none
    ]
; gui
    ;do %gui/area-scroll-style.r ;Copyright: {GNU Less General Public License (LGPL) - Copyright (C) Didier Cadieu 2004} 
    do decompress ; %area-scroll-style.r Copyright: {GNU Less General Public License (LGPL) - Copyright (C) Didier Cadieu 2004} 
        64#{
        eJztWUuP4zYSvutXcL2HeQCK2pNgEQgz24e95JLbIhhAsAO2RFnaliWtJLfdGyS/fb+qIinKdvd0JxPsZSczsUTWu8iqj1SkB6Pj 
        cXpsTKrop/6PUVkko/nQNU2q6EUd66nCxKEtulQVnRlVpoeEXjcqGsxilF4xqovi56n7mWjiph6nVJWHNgdFPm2Y7pxA8UxU1qd4 
        bOrCDHGvB+3YotW+ezBKK5kDcd4NRd3u1GROkypr0xRKbMbgNysVTaVayZzODd5HvAtzInSQYqfI5kHv1Eo3Y6fsy1QZdUZPpE2X 
        60ZN+55smVQ9RnAnqkvVdq25VVOZkNkqM6ea3KnHlMZGimysTLEzMT0TIUzc96na161an9aQBALLnuz1sMP4PNANtQxQJElCzL6R 
        FMRoLBN9ggA4mRR6wshen9SNyPYyxI0k1SpRBhlFAGABvX/8O4gzeYE7azK8dIHIINQ+irx6FBmkYw2DmCkaq+4IQyLK/ZCqB7eA 
        KvcwNmXKUQItD8XHupiqVK3/pqIjsolQ6b43baF0+6gyHlJ51+N5Q0G2IlXWmmPi5U/DAeti2I1QXIUU1TUKl0rRrTK4WbeT2Znh 
        lkmSD8K8tFBmNqqlmFtJ2BdF3LUNrCsbvYtpLYHgqOYJS9kdJiik3J+TBjNMy8HLczOOlMF7o+QFvo9mYrb3bkOwjAfdHAyFht5S 
        Xs6JHlQkD8ybeE41s1iK0pgG+/Bfh3Gye24UoihvjJbtkcwbNBylXc6jZPLumnEb+YE9CS3VjWW/SnhuP2+nSZl9Pz3eyjAvdyvx 
        vHLAmAOszt4MWI+8YGaWxrS7qQqEbDbL+ARWWeefjU3Eqb+aji8kIuB6hSLa6peJp2GnjouLFAWsb372wygYbz+o97KhNO0MnuIV 
        558SkXZzutm849jzjN9tUfiadGUJN5KTKJx/oUm0Bhsn2sziqqW4ainu0Yrxv0+Jc0sq9PnC4oXBEkNIlJ9rJi0ssvQn61eg86lM 
        YS6SrSvVq27ribYs1bvRNCjRvW5hrS1lbAAX5OOg+1uV+UJFxVGmOVV36DX3t2BrOmj6oD75xSxD1EdFoyVZf3/zjf1HZvtSw0bQ 
        6+htJIsU1WkqM7GEuje5LJo33PThwQNW3fg4TmafPNSoV1HQzr03vhQEY890f+vXXza2b65v8Ed99L7N2zobDDf9O53fq0nXzTxH 
        UWpHM0wJF9oKJTdgZDNIla1Yi2IlIKbSo8MiZIStNIFu279BggZCpTiogxeqvQLRirglOWJIrRrQKa+ATwY7CXXOMerKGJwEwmAS 
        zYf+/x0FFa2JtVyZ/5YX27XVSCWHE8ra44d6rO8a5N/Z47p0U0YeuF2PxOzRZSTmueeS8LJIPOMkB+FLkfo6kbikdAuWB21ohBFY 
        iT2VhhTl04mhGCppPQkog+682/fdiJY0VnU5qbclkKV5h+F2wlb37/cGYev2VMo3i2DxkreG/mENgI4V+bCRKrXXrQYMlX0gXhKV 
        RbbABypvesA6CjlKhXWeK1JeaeAkov7ravuPFcUCL4zNNOqXt7SqG9J5qyKLM5mbRIPv8wqVzLKh9sODWdW5hHjQ7Q5o+aKghD2/ 
        bgtzurUW096X5eLFKmkyt4FPDNqtbYQ0yDRYw0s0KUypD83EfmYRLP5hxUAR76nqa2SG0zOvpTU20JftO2Mi6esNoRFo+O1cw2uF 
        PyH3x9Vz3PUlN3iSFfEz+0+vZcfKSRkA46nu7zo9FGmSzH2r6a3kz89K9jhuAeEEvXHqXmWURCQSzv/VivOgtgSzymRVSeYlTxzu 
        jV10L/GPRTvfWLxk7NNrZbwgaZH/j9pGoydThN0+n+qudXcAqKmJjAjwsOiffvgQKLg8knMqvdOTinBuNxYr0KB/JfQ0WEo+WkeE 
        WVN3gvUo55YowhNVJnCK7aEB6hSojiKJnlBaGTfJiMVQSxDHoMlyMH5yVqSM4GzzsYe1RaFWd5zn+ZgYl3UD21K0SAoNB89zIGNj 
        PHWxbYdUZ2mh/rL9YRtvf9v+uP28/Wn7z1+5Zw/6uDgLUC9FKwjrNI7pPPXGOmWRJMM8jx2j+dVHUwtCn2PKYuYT7bfq46flkUrE 
        8dbiwhUMSiXL1gq9nOWgXQRoEjlAw4ntWecK+5d4ZDnCGL0zFxExDwYZtk0NGIJK/MbXeAtAiu7YStjOXS7qUQMGFB7+zM0iNv8+ 
        6MbSkVHvA6soel1+8Ec4wVRkS1J0B0iMsccoKtfaOgv4PY39Kkh4kTS6GxFhjSlfKUt4r4gK7KLoRXP4JBLCn7mKKDGswCQVWKpS 
        dnU4tdQWl0XnRNi6qa2+tJ+kAbD1olqmODHezUMrvPQiayrQ8QJp9oQ4oCr6Cy4Cl+4UDwA7eG/d6glUvEDDnxerr+kqn4GP+tHV 
        FiH7DpCze5CLzoUsvqM83SwH4+DyQlBleJnBz8sb0nnI35G+9spjFuFO4mQrmUYmEjaMgztXDso5CyioyPzeGGMTARecxfrC2QtX 
        g1D5NBByuXqZdOhtqXOpsZEJkumFcCqnek/1jJN3LUewBINyeeCWh880RcMlmJ7/n9cXhO8rZ1xwoK0cErInO7sc7cRO4mOYeg5e 
        5nkqoMFBMmCMzrqGNOIdvPOoxKLD62a7vr6cPL9nhVMhqLGYlLsvjEaDpy80y6mzL0vumwabBGqn2LUFPLr1axcpUtvrevA42jU1 
        f+8YXlbCyJu571VPkkQellok5jCpVFd3aAhQrjmDuQKH7d3hgfozX2f4j1zoBQx8GG771e4vSBydizBIVF2cVEIRZJw4Lm4J6VaU 
        rgrVm1kDWLL5XECi3ZHgyscKGwLG8osM+cIT3lHOiJy/LQolfemyZ575mtp/EVq6r0fJWhh5ZW+Qk0f1wcqZ76er5+U41tNS4trK 
        sfdngbHZ/OzTNH8S8Pf7klh6n/dAr4FVY1qRtKlSxlpy7cQfx3A+2tcT0uPPC9nml1/fvotXEY4KY8/fItzcSm3jlYpgQOxmgOca 
        s6ftKWeSUKhiIki5r/s4YLKLZKJDcI5sHnFupk5C5cKTSZEGUZKCCudStaLrXgxgCUKg8vx42FglL1BwXbh+gfBlvJ7TsQjCK1V5 
        SEkfCllnqMseRuxZDT8p8/PngG7Eud3LtVFcxp6J13QfdJVumTwmpQKEpyi0jG6h/ohlgTmBASCO1/Q3sO3CoHjt7Ik2/wXptxid 
        eyAAAA== 
        }
    resize-faces: func [siz [pair!] /move] [
        foreach [face dir] reduce [text-results 0x1 area-results 0x1 field-console 0x1 text-command 0x1 text-debug-results 0x1 area-debug-results 0x1 area-vid-results 0x1 area-draw-results 0x1] [face/offset: face/offset + (siz * dir)]
        foreach [face dir] reduce [area-test 1x1 area-results 1x0 field-console 1x0 area-console-results 1x1 area-source 1x1 area-debug-results 1x0 area-vid 0x1 panel-gui 1x1 area-draw 0x1 box-drawings 1x1] [resize-face/no-show face face/size + (siz * dir)]
        either not move [
            foreach [face dir] reduce [panels 1x1 panel-edit 1x1 panel-console 1x1 panel-debug 1x1 panel-vid 1x1 panel-draw 1x1] [resize-face/no-show face face/size + (siz * dir)]
        ][
            ; "undo" vertical moving and resizing
            foreach [face dir] reduce [field-console 0x-1 text-command 0x-1] [face/offset: face/offset + (siz * dir)]
            foreach [face dir] reduce [area-results 0x-1 area-console-results 0x-1] [resize-face/no-show face face/size + (siz * dir)]
        ]
    ]
    feel-move: [
        engage-super: :engage
        engage: func [face action event /local prev-offset] [
            engage-super face action event
            if find [over away] action [
                prev-offset: face/offset
                face/offset: 0x1 * (face/old-offset + event/offset) ; We cannot modify face/old-offset but why not use it?
                face/offset: 0x1 * second confine face/offset face/size area-test/offset + 0x100 area-results/offset + area-results/size - 0x100
                face/offset: face/offset + 4x0 ; ?? must add spacing

                if prev-offset <> face/offset [
                    resize-faces/move (face/offset - prev-offset * 0x1)
                    show main-window
                ]
            ]
        ]
    ]
    append system/view/VID/vid-styles area-style ; add to master style-sheet
    ; panels
        panel-edit: layout/tight [
            do [sp: 4x4] origin sp space sp
            Across
            btn "(O)pen..." #"^O" [open_file]
            btn "(S)ave" #"^S" [save_file]
            pad (sp * -1x0)
            btn "as..." [save_file/as]
            btn "Undo" #"^z" [undo]
            btn "(R)edo" #"^r" [redo]
            btn "(D)o script" #"^D" 70 yellow [test get-face area-test]
            btn "H(a)lt" #"^A" red [if doing [doing: false make error! "Halt"]]
            btn "Clear (T)est" #"^T" [if confirm "Are you sure?" [clear-face area-test job-name: none named: no change_title/modified]]
            btn "Clear R(e)sults" #"^e" [clear-face output-face old-length: 0]
            pad 0x1
            check-clear-res: check-line "before every do" off
            return
            Below
            style area-scroll area-scroll 650x200 hscroll vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16]
            text-test: text bold "Test"
            area-test: area-scroll {print "Hello world!"} with [append init [deflag-face self/ar 'tabbed ]]
            button-balance: button "-  -  - - ----- - -  -  -" 650x6 gray feel feel-move edge [size: 1x1] font [size: 6]
            text-results: text bold "Results"
            area-results: area-scroll silver read-only
        ]
        {panel-console: layout/tight [
            do [sp: 4x4] origin sp space sp
            style area-scroll area-scroll 650x200 hscroll vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16]
            area-console: area-scroll {>> probe "Hello world!"} panel-edit/size - 1x1 - 8x8 with [append init [deflag-face self/ar 'tabbed ]]
            do [
                super-engage: get in area-console/ar/feel 'engage
                area-console/ar/feel/engage: func [face action event /local code result][
                    either #"^M" = event/key  [
                        set-face/no-show area-console append get-face area-console newline ; append newline
                        code: find/tail/last get-face area-console {>> }
                        ;insert console-history code
                        result: test/console rejoin ["[" copy code "]"]
                    ][
                        super-engage face action event
                    ]
                ]
            ]
        ]}
        console-history: copy []
        panel-console: layout/tight [
            do [sp: 4x4] origin sp space sp
            style area-scroll area-scroll hscroll vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16]
            across
            pad 251
            btn "Do script" 70 yellow [do-face field-console none]
            btn "H(a)lt" #"^A" red [if doing [doing: false make error! "Halt"]]
            pad 77
            btn "Clear R(e)sults" #"^e" [clear-face output-face old-length: 0]
            pad 0x1
            check-clear-res-cons: check-line "before every do" off
            below
            text bold "Results =="
            area-console-results: area-scroll panel-edit/size - 8x108 silver read-only
            text-command: text bold "Command >>"
            field-console: field {probe "Hello world!"} panel-edit/size/x - 1 - 8 font-name font-fixed with [
                append init [deflag-face self 'tabbed deflag-face self 'on-unfocus]
            ] feel [
                super-engage: :engage
                engage: func [face action event /local code][
                    if action = 'key [
                        switch event/key [
                            up [
                                console-history: back console-history
                                code: pick console-history 1 
                                if code [set-face face code focus face]
                            ]
                            down [
                                console-history: next console-history
                                if tail? console-history [console-history: back console-history]
                                code: pick console-history 1
                                if code [set-face face code focus face]
                            ]
                        ]
                    ]
                    super-engage face action event
                ]
            ] [ ; action function
                if get-face check-clear-res-cons [clear-face area-console-results] 
                use [code][
                    code: copy get-face face
                    code: any [pick parse/all code "^/" 1 ""]
                    if (pick back tail console-history 1) <> code [console-history: back insert tail console-history code]
                    test/console code
                ]
            ]
        ]
        panel-debug: layout/tight [
            do [sp: 4x4] origin sp space sp
            Across
            pad 27x0
            btn "Ste(p) debug" #"^p" 70 yellow [if not stepped [codeg: load get-face area-test] doing: true source-debug/step]
            text "Speed (wait)"
            field-wait: field "0.1" 30x22
            text "secs"
            btn "R(u)n debug" #"^u" 70 yellow [codeg: load get-face area-test doing: true source-debug]
            btn "H(a)lt" #"^A" red [if doing [doing: false ]]
            pad 77
            btn "Clear R(e)sults" #"^e" [clear-face output-face old-length: 0]
            pad 0x1
            check-clear-res-debug: check-line "before every do" off
            return
            Below
            style area-scroll area-scroll 650x200 hscroll vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16]
            text-source: text bold "Source"
            area-source: area-scroll silver read-only with [append init [deflag-face self/ar 'tabbed]]
            ;button-balance: button "-----" 650x6 gray feel feel-move edge [size: 1x1] font [size: 6]
            text-debug-results: text bold "Results"
            area-debug-results: area-scroll silver read-only
        ]
        panel-vid: layout/tight [
            do [sp: 4x4] origin sp space sp
            Across
            btn "(O)pen..." #"^O" [open_file]
            btn "(S)ave" #"^S" [save_file]
            pad (sp * -1x0)
            btn "as..." [save_file/as]
            btn "Undo" #"^z" [undo]
            btn "(R)edo" #"^r" [redo]
            btn "Refresh" 70 yellow [update-gui]
            pad 46x0
            btn "Clear VI(D)" #"^D" [if confirm "Are you sure?" [clear-face area-vid update-gui job-name: none named: no change_title/modified]]
            below
            guide
            style area-scroll area-scroll 230x395 vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16] 
            text-vid: text bold "VID block"
            area-vid: area-scroll {across^/text "Hello world!"^/btn "OK" [alert "All right"]} hscroll with [
                append init [
                    deflag-face self/ar 'tabbed
                    self/ar/feel: make self/ar/feel [
                        old-engage: :engage
                        engage: func [face action event][   
                            old-engage face action event
                            if event/type = 'key [update-gui]
                        ]
                    ]
                ]
            ] 
            area-vid-results: area-scroll 230x35 silver read-only font-name font-sans-serif
            return
            text-gui: text bold "GUI" 
            panel-gui: panel 415x435 edge [size: 1x1] []
            do [attempt [panel-gui/pane: layout/offset load get-face area-vid 0x0]]
        ]
        panel-draw: layout/tight [
            do [sp: 4x4] origin sp space sp
            Across
            btn "(O)pen..." #"^O" [open_file]
            btn "(S)ave" #"^S" [save_file]
            pad (sp * -1x0)
            btn "as..." [save_file/as]
            btn "Undo" #"^z" [undo]
            btn "(R)edo" #"^r" [redo]
            btn "Refresh" 70 yellow [update-draw]
            pad 46x0
            btn "Clear Dra(w)" #"^w" [if confirm "Are you sure?" [clear-face area-draw update-draw job-name: none named: no change_title/modified]]
            below
            guide
            style area-scroll area-scroll 230x395 vscroll font-name font-fixed para [origin: 2x0]; Tabs: 16] 
            text-draw: text bold "Draw block"
            area-draw: area-scroll {pen green^/fill-pen orange^/circle 30x30 20} hscroll with [
                append init [
                    deflag-face self/ar 'tabbed
                    self/ar/feel: make self/ar/feel [
                        old-engage: :engage
                        engage: func [face action event][   
                            old-engage face action event
                            if event/type = 'key [update-draw]
                        ]
                    ]
                ]
            ] 
            area-draw-results: area-scroll 230x35 silver read-only font-name font-sans-serif
            return
            text-drawings: text bold "Drawings" 
            box-drawings: box 415x435 white effect [draw [] ]; reduce [pen 0.100.0 fill-pen 100.100.0 circle 30x30 20]]
            do [attempt [box-drawings/effect/draw: load get-face area-draw]]
        ]
        set 'output-face area-results ; make it global
        set 'input-face area-test ; make it global
    update-gui: has [lay][
        doing: true
        clear area-vid-results/ar/text
        area-vid-results/ar/colors/1: silver
        either attempt [lay: layout/offset load get-face area-vid 0x0][
            panel-gui/pane: lay
            show panel-gui
            
            if "" <> get-face area-vid-results [area-vid-results/ar/colors/1: red + 100]
        ][area-vid-results/ar/colors/1: red + 100]
        show area-vid-results
        doing: false
    ]
    update-draw: has [error][
        doing: true
        clear area-draw-results/ar/text
        area-draw-results/ar/colors/1: silver
        if any [ 
            error? set/any 'error try [box-drawings/effect/draw: load get-face area-draw]
            error? set/any 'error try [show box-drawings]
            ][
                ; print mold error: disarm error ; does not work
                area-draw-results/ar/colors/1: red + 100
                clear box-drawings/effect/draw
        ]
        show area-draw-results
        doing: false
    ]
    show-pane: func [face [object!] pane [object!] input [object!] output [object!]][
        if get-face face [set 'output-face output set 'input-face input focus input panels/pane: pane show panels]
    ]
    main-window: center-face layout [
        style radio-line radio-line font [style: 'bold]
        do [sp: 4x4] origin sp space sp
        Across
        radio-line "Mini editor" on [show-pane face panel-edit area-test area-results]
        radio-line "Mini console" off [show-pane face panel-console field-console area-console-results]
        radio-line "Mini source level debugger" off [set-face area-source/ar get-face area-test show-pane face panel-debug area-source area-debug-results]
        ;radio-line "Mini function builder" off
        btn-?: btn "?" sky keycode [f1] [
            ssh: System/script/header
            if not value? 'help-win [; avoid opening win more then once
                help-win: view/new layout [ below space sp
                    text 600 bold center ssh/Title
                    text 600 center rejoin ["Version: " ssh/Version either ssh/Version <> pick tail ssh/history -2 [rejoin [" (" pick tail ssh/history -2 ")"]][""] " , " ssh/Date ". Copyright (C) " now/year " " ssh/Author]
                    text 600 bold center "USE AT YOUR OWN RISK"
                    across
                    info-help: info 600x100 as-is trim/auto ssh/Help wrap edge [size: 1x1]
                    pad -20
                    slider info-help/size/y * 0x1 + 16x0 with [append init [redrag 250 / 300]] [scroll-para info-help face]
                    key (escape) (0x0 - sp) [unview]
                ]
            ]
        ]
        radio-line "Live VID" off [show-pane face panel-vid area-vid area-vid-results]
        radio-line "Live Draw" off [show-pane face panel-draw area-draw area-draw-results]
        return
        panels: box panel-edit/size + 1x1 edge [size: 1x1] with [pane: panel-edit] ; + 1x1 is because edge [size: 1x1]
        at -1000x-10000
        key keycode [f2] [focus input-face]
        key escape (sp * 0x-1) [ask_close]
        do [
            code: copy area-test/text
            old-add_to_undo-list: get in area-test/ar 'add_to_undo-list
            area-test/ar/add_to_undo-list: func [key] [change_title/modified old-add_to_undo-list key]
        ]
    ]
    main-window/user-data: reduce ['size main-window/size]
    insert-event-func func [face event /local siz] [
        if event/face = main-window [
            switch event/type [
                close [
                    ask_close
                    return none
                ]
                resize [
                    face: system/view/screen-face/pane/1
                    siz: face/size - face/user-data/size     ; compute size difference
                    face/user-data/size: face/size          ; store new size

                    resize-faces siz
                    button-balance/offset: button-balance/offset + (siz * 0x1)
                    button-balance/size: button-balance/size + (siz * 1x0)
                    show face
                ]
                scroll-line [either event/offset/y < 0 [scroll-drag/back/page area-test/vscroll] [scroll-drag/page area-test/vscroll]]
                ;key [the-key: event/key]
            ]
        ]
        if all [event/type = 'close value? 'help-win event/face = help-win] [unset 'help-win]
        event
    ]
    ask_close: does [
        either not saved? [
            switch request ["Exit without saving?" "Yes" "Save" "No"] reduce [
                yes [old-quit]
                no [if save_file [old-quit]]
            ]
        ][
            if confirm "Exit now?" [old-quit]
            ;old-quit
        ]
    ]
; main
    
    job-name: none
    named: no
    saved?: yes
    main-title: join copy System/script/header/title " - Untitled"
    view/title/options main-window main-title reduce ['resize 'min-size main-window/size + system/view/title-size + 8x10 + system/view/resize-border]
] ; context