Add links to text face for Rebol 2

linkify-face.r

Rebol [
    Title: "Link Up"
    File: %linkify-face.r
    Version: 0.0.1
    Home: http://www.ross-gill.com/page/Beyond_Regular_Expressions
    Date: 8-Aug-2010
    Purpose: "To identify URIs in face/text and overlay with links"
    Author: "Christopher Ross-Gill"
]

linkify-face: use [links hypertext make-link][
    hypertext: use [uri letter digit word space punct chars paren mark extent][
        letter: charset [#"a" - #"z"]
        digit: charset [#"0" - #"9"]
        word: charset [#"_" #"0" - #"9" #"A" - #"Z" #"a" - #"z"] ; per regex
        space: charset "^/^- ()<>^"'" ; for curly quotes, need unicode (R3)
        punct: charset "!'#$%&`*+,-./:;=?@[/]^^{|}~" ; regex 'punct without ()<>
        chars: complement union space punct
        paren: ["(" some [chars | punct | "(" some [chars | punct] ")"]")"]
        
        uri: [
            [
                  letter some [word | "-"] ":" [1 3 "/" | letter | digit | "%"]
                | "www" 0 3 digit "."
                | some [letter | digit] "." 2 4 letter
            ]
            some [opt [some punct] some [chars | paren] opt "/"]
        ]

        [
            any [
                mark: uri extent: (keep reduce [mark extent])
                | some [chars | punct] some space ; non-uri words, line not required
                | skip
            ]
        ]
    ]

    make-link: use [style link][
        style: stylize [
            link: txt 0.0.204 400x20 as-is para [origin: margin: 0x0] [
                attempt [browse to-url value]
            ][
                write clipboard:// to-url value
            ]
        ]

        func [
            parent [object!]
            start [string!]
            end [string!]
            link-colors [block!]
        ][
            link: make-face style/link
            link/text: link/data: copy/part start end
            link/color: none
            link/offset: caret-to-offset parent start
            link/size: size-text link
            link/font: make parent/font [
                offset: 0x0
                color: first colors: link-colors
            ]
            link/saved-area: yes
            link
        ]
    ]

    func [
        "Adds links to a face"
        face [object!] "Face to add links to"
        /colors "Optional link colors" normal [tuple!] hover [tuple!]
    ][
        if string? face/text [
            colors: reduce [
                any [normal normal: 0.0.204]
                any [hover normal]
            ]

            links: collect [
                parse/all face/text bind/copy hypertext 'keep
            ]

            face/pane: collect [
                foreach [start end] links [
                    keep make-link face start end colors
                ]
            ]
        ]
    ]
]