REBOL [
    Title: "Link Up"
    File: %link-up.r
    Version: 0.1.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"
    Exports: [link-up]
]

to-link: :to-url

link-up: use [links hypertext add-link][
    hypertext: use [uri letter digit word space punct chars paren mk ex][
        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 [
                mk: uri ex: (repend links [mk ex])
                | some [chars | punct] some space ; non-uri words, line not required
                | skip
            ]
        ]
    ]

    add-link: use [style link][
        style: stylize [
            link: txt 0.0.200 400x20 as-is para [origin: margin: 0x0 wrap?: false][
                attempt [browse to-link face/data]
            ][
                write clipboard:// to-link face/data
            ]
        ]

        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/font: make parent/font [
                offset: 0x0 space/y: 0 align: 'left
                color: first colors: link-colors
            ]
            link/offset: caret-to-offset parent start
            link/size/x: parent/size/x
            link/size: size-text link
            link/size/x: min link/size/x parent/size/x - link/offset/x
            link/saved-area: true
            append parent/pane link
            parent
        ]
    ]

    func [
        "Adds links to a face"
        face [object!] "Face to add links to"
        /colors "Optional link colors" normal [tuple!] hover [tuple!]
    ][
        colors: reduce [any [normal normal: 0.0.204] any [hover normal]]
        links: copy []
        face/pane: copy []
        if string? face/text [
            parse/all face/text hypertext
            foreach [start end] links [add-link face start end colors]
        ]
        face
    ]
]