TextMate Bundle Support File (R3C)

textmate.reb

Rebol [
    Title: "TextMate Support"
    Author: "Christopher Ross-Gill"
    Date: 8-Feb-2021
    Type: module
    Name: rgchris.textmate
    Exports: [tm textmate neaten envelop form-error]
]

tm: make object! [
    form: make object! [
        snippet-special: charset "$\`}"

        snippet: make action! [
            [snippet [text!]]
            [
                head parse snippet: copy snippet [
                    any [
                        and snippet-special
                        insert #"\" skip
                        |
                        skip
                    ]
                ]
            ]
        ]
    ]

    ; don't recall what this was used for
    adjust-line-index: make action! [
        [
            index [integer!]
            line [text!]
        ]
        [
            ; need to count based on character value, more efficient
            length of to text! copy/part to binary! line index
        ]
    ]

    load-selection-range: make action! [
        [
            value [text!]
            digit: selections: line: column: mark: range:
        ]
        [
            digit: charset "0123456789"
            range: make block! 3
            collect [
                parse value [
                    some [
                        mark:
                        copy line some digit
                        (line: load line)
                        [
                            #":" copy column some digit
                            (column: load column)
                            |
                            (column: 1)
                        ]
                        (append range as-pair column line)
                        |
                        #"-"
                        (append range 'range)
                        |
                        #"x"
                        (append range 'block)
                        |
                        [#"&" | end]
                        (
                            parse range [
                                pair! end
                                (keep first range)
                                |
                                pair! ['range | 'block] pair! end
                                (keep/only sort copy range)
                            ]
                            clear range
                        )
                        |
                        skip
                    ]
                    end
                ]
            ]
            else [
                fail ["Could not parse selection range:" mold mark]
            ]
        ]
    ]

    column-of: make action! [
        [pair [pair!]]
        [to integer! pair/x]
    ]

    line-of: make action! [
        [pair [pair!]]
        [to integer! pair/y]
    ]

    prin: make action! [
        [out [binary! text! block!]]
        [
            write-stdout switch type-of out [
                binary! [out]
                text! [as binary! out]
                block! [as binary! unspaced out]
            ]
        ]
    ]

    ; Responses

    respond: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit
        ]
    ]

    discard: make action! [
        [] [quit/with 200]
    ]

    replace-text: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit/with 201
        ]
    ]

    replace-document: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit/with 202
        ]
    ]

    as-text: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit/with 203
        ]
    ]

    as-snippet: make action! [
        [
            out [binary! text! block!]
            /no-indent
        ]
        [
            prin out
            quit/with either no-indent [208] [204]
        ]
    ]

    as-html: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit/with 205
        ]
    ]

    as-tooltip: make action! [
        [out [binary! text! block!]]
        [
            ; STDERR << out if out
            prin out
            quit/with 206
        ]
    ]

    as-new-document: make action! [
        [out [binary! text! block!]]
        [
            prin out
            quit/with 207
        ]
    ]
]

textmate: make map! collect [
    keep []  ; force empty

    for-each [name value] body-of list-env [
        if name: parse name ["TM" some "_"] [
            if name == "SELECTION" [
                keep 'selection-original
                keep copy value
            ]

            keep name: to word! replace/all lowercase copy name "_" "-"

            comment [
                scope {source.rebol variable.other.litword.rebol attr.os-version.10.14.6 attr.rev-path.reb.textmate.Support.tmbundle.Rebol.Bundles.TextMate.Application_Support.Library.Chris.Users dyn.caret.mixed.columnar dyn.selection}
            ]

            keep/only switch name [
                'app-path 'bundle-path
                'mate 'query 'scm-commit-window
                'directory 'filename 'filepath 'git
                'current-theme-path 'project-directory 'project-filepath 'selected-file
                'theme-path 'support-path 'bundle-support [
                    local-to-file value
                ]

                'selected-files [
                    collect [
                        parse value [
                            some [
                                change "\ " " "
                                |
                                change " " "^!"
                                |
                                skip
                            ]
                        ]

                        for-each file split head value "^!" [
                            keep local-to-file file
                        ]
                    ]
                ]

                'properties-path [
                    collect [
                        for-each file split head value ":" [
                            keep local-to-file file
                        ]
                    ]
                ]

                'columns 'column-number
                'input-start-column 'input-start-line 'input-start-line-index
                'line-index 'line-number 'pid 'tab-size [
                    to integer! value
                ]

                'selection [
                    tm/load-selection-range value
                ]

                'scope 'scope-left [
                    split value " "
                ]

                'soft-tabs 'file-is-untitled [do value]
                'project-uuid 'bundle-item-uuid 'document-uuid [
                    to url! unspaced [urn:uuid: value]
                ]

                default [value]
            ]
        ]
    ]
]

neaten: make action! [
    [
        block [block!]
        /pairs
        /flat
    ]
    [
        new-line/all/skip block not flat either pairs [2] [1]
    ]
]

envelop: make action! [
    [value]
    [
        case [
            null? :value [make block! 0]
            void? :value [make block! 0]
            path? value [
                collect [
                    until [
                        keep value/1
                        tail? value: next value
                    ]
                ]
            ]
            'else [compose [(value)]]
        ]
    ]
]

form-error: make action! [
    [error [error!]]
    [
        unspaced [
            "** " form error/type " Error: " case [
                text? error/message [error/message]
                block? error/message [
                    collect [
                        for-each part error/message [
                            case [
                                text? part [keep part]
                                get-word? part [keep form get in :error to word! part]
                            ]
                        ]
                    ]
                ]
            ]
            "^/** Where: " form copy/part error/where any [
                find/last error/where [catch if]
                tail error/where
            ]
            "^/** Near: " copy/part mold error/near 80
            "^/** File: " form error/file
            "^/** Line: " form error/line
        ]
    ]
]