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
	]
]