Friday 21 September 2012

Editor with undo

Standard rebol has its editor:
It's very useful to test your script, since pushing CTRL+E you test your script.
However i's missing a very important feature: the undo!
Mr. Romano  Paolo Tenca filled this gap, his original script is here.
The following code alter the standard editor, adding the undo function. First of all the script create the undo function, the substitute the the key shortcut with the the same plus the undo. Let's see the script:
Rebol []
undo:   make object! bind bind [; the double bind to use this object just in system/view and in ctx-text, see the end of the script
    undo-max: 1000   ; numebr of undo, none = unlimited
    undo-add: func [face] [
        if all [in face 'undo not flag-face? face hide][
            insert clear face/undo at copy face/text index? caret
            if all [undo-max undo-max < length? head face/undo] [remove head face/undo]
            face/undo: tail face/undo
        ]
    ]
    undo-get: func [face] [
        face/text: head caret: first face/undo
        face/line-list: none
        remove face/undo
        face/dirty?: true
    ]
    insert tail keymap [
        #"^z" undo
        #"^y" redo
        #"^u" undo-all
    ]
    ;for esc
    set 'hilight-all func [face /only ] [
        either empty? face/text [unlight-text][
            highlight-start: head face/text
            highlight-end: tail face/text
        ]
        if all [not only in face 'esc][face/esc: copy face/text]
    ]
    move: func [event ctrl plain] [
        either event/shift [any [highlight-start highlight-start: caret]][unlight-text]
        caret: either event/control ctrl plain
        if event/shift [either caret = highlight-start [unlight-text][highlight-end: caret]]
    ]
    move-y: func [face delta /local pos tmp tmp2][
        tmp: offset-to-caret face delta + pos: caret-to-offset face caret
        tmp2: caret-to-offset face tmp
        either tmp2/y <> pos/y [tmp][caret]
    ]
    set 'edit-text func [
        face event action
        /local key liney swap-text tmp tmp2 page-up page-down face-size
    ] [
        face-size: face/size - either face/edge [2 * face/edge/size][0]
        key: event/key
        if flag-face? face hide swap-text: [
            tmp: face/text face/text: face/data face/data: tmp
            caret: either error? try [index? caret][tail face/text][at face/text index? caret]
        ]
        textinfo face line-info 0
        liney: line-info/size/y
        if char? key [
            either find keys-to-insert key [
                undo-add face
                insert-char face key
            ][key: select keymap key]
        ]
        if word? key [
            page-up: [move-y face face-size - liney - liney * 0x-1]
            page-down: [move-y face face-size - liney * 0x1]
            do select [
                left [move event [back-word caret][back caret]]
                right [move event [next-word caret][next caret]]
                up [move event page-up [move-y face liney * 0x-1]]
                down [move event page-down [move-y face liney * 0x1]]
                page-up [move event [head caret] page-up]
                page-down [move event [tail caret] page-down]
                home [move event [head caret][beg-of-line caret]]
                end [move event [tail caret][end-of-line caret]]
                back-char [
                    undo-add face
                    any [
                        delete-selected-text
                        head? caret
                        either event/control [
                            tmp: caret
                            remove/part caret: back-word tmp tmp
                        ][remove caret: back caret]
                    ]
                    face/dirty?: true
                ]
                del-char [
                    undo-add face
                    any [
                        delete-selected-text
                        tail? caret
                        either event/control [remove/part caret next-word caret][remove caret]
                    ]
                    face/dirty?: true
                ]
                enter [
                    if flag-face? face return [
                        if flag-face? face hide swap-text
                        action face face/data
                        if flag-face? face tabbed [focus next-field face]
                        exit
                    ]
                    undo-add face
                    insert-char face newline
                ]
                all-text [hilight-all/only face]
                copy-text [copy-text face unlight-text]
                cut-text [
                    undo-add face
                    copy-selected-text face
                    delete-selected-text
                    face/dirty?: true
                ]
                paste-text [
                    undo-add face
                    delete-selected-text
                    face/line-list: none
                    face/dirty?: true
                    caret: insert caret read clipboard://
                ]
                clear-tail [
                    undo-add face
                    remove/part caret end-of-line caret
                    face/dirty?: true
                ]
                tab-char [
                    if flag-face? face tabbed [
                        either in face 'refocus [
                            face/refocus event/shift
                        ][
                            tmp2: either event/shift [back-field face][next-field face]
                            if flag-face? face hide swap-text
                            action face face/data
                            focus tmp2
                        ]
                        exit
                    ]
                    undo-add face
                    insert-char face tab
                ]
                ;new
                undo [
                    if all [in face 'undo not head? face/undo][
                        insert face/undo at copy face/text index? caret
                        face/undo: back face/undo
                        undo-get face
                    ]
                ]
                redo [
                    if all [in face 'undo not tail? face/undo][
                        face/undo: insert face/undo at copy face/text index? caret
                        undo-get face
                    ]
                ]
                undo-all [
                    if all [in face 'esc flag-face? face field][
                        clear face/text
                        if all [in face 'undo not flag-face? face hide][clear face/undo]
                        if string? face/esc [insert face/text face/esc]
                        if flag-face? face hide swap-text
                        if flag-face? face tabbed [focus next-field face]
                        exit
                    ]
                ]
            ] key
        ]
        if face: focal-face [
            if flag-face? face hide [
                view*/highlight-start: view*/highlight-end: none
                insert/dup clear face/data "*" length? face/text
                do swap-text
            ]
            tmp: caret-to-offset face caret
            tmp2: face/para/scroll
            if all [tmp/x < 0 tmp2/x < 0] [face/para/scroll/x: tmp2/x - tmp/x]
            if all [tmp/y < 0 tmp2/y < 0] [face/para/scroll/y: tmp2/y - tmp/y]
            action: face-size - tmp
            if action/x < 5 [face/para/scroll/x: tmp2/x + action/x - 5]
            if action/y < liney [face/para/scroll/y: tmp2/y + action/y - liney]
            show face
        ]
    ]
]   in system/view 'self in ctx-text 'self
;base-effect: []
ctx-edit: mold :ctx-edit
changes: [
    {[tabs: 28 origin: 4x4]}
    {[tabs: 28 origin: 4x4] with [
        undo: []
        colors: [254.254.254 255.255.255]
    ]}

    {Ctrl-V - paste text}
    {Ctrl-V - paste text^/^-^-Ctrl-Z - undo^/^-^-Ctrl-Y - redo}
]
foreach [original changed] changes [replace/all ctx-edit original changed]
ctx-edit: do ctx-edit
editor none

1 comment:

  1. I put a do-able version of that (with a few color and aesthetic changes) at http://re-bol.com/editor.r

    Just open the REBOL interpreter and:

    do http://re-bol.com/editor.r

    ReplyDelete