REBOL [
	Title: "Color REBOL Code in HTML"
	Date: 23-Oct-2009
	File: %color-code.r
	Author: "Carl Sassenrath"
	Purpose: {
		Colorize source code based on datatype.	 Result is HTML <pre> block.
		Works with R3
		Sample CSS: http://www.ross-gill.com/styles/rebol-code.css
	}
	History: [
		29-May-2003 "Fixed deep parse rule bug."
	]
	library: [
		level: 'intermediate
		platform: none
		type: [tool]
		domain: 'text-processing
		tested-under: none
		support: none
		license: none
		see-also: none
	]
]

color-code: use [out emit emit-var rule value][
	out: none
	envelop: func [data][either block? data [data][compose [(data)]]]
	emit: func [data][data: reduce envelop data until [append out take data empty? data]]

	emit-var: func [value start stop /local type][
		either none? :value [type: "cmt"][
			if path? :value [value: first :value]
			type: either word? :value [
				any [
					all [value? :value any-function? get :value "function"]
					all [value? :value datatype? get :value "datatype"]
				]
			][
				any [replace to-string type?/word :value "!" ""]
			]
		]
		either type [ ; (Done this way so script can color itself.)
			emit ["-[" {-var class="dt-} type {"-} "]-"
			copy/part start stop "-[" "-/var-" "]-"]
		][
			emit copy/part start stop
		]
	]

	rule: use [str new][
		[
			some [
				str:
				some [" " | tab] new: (emit copy/part str new) |
				newline (emit "^/") |
				#";" [thru newline | to end] new:
					(emit-var none str new) |
				[#"[" | #"("] (emit first str) rule |
				[#"]" | #")"] (emit first str) break |
				skip (
					set [value new] load/next str
					emit-var :value str new
				) :new
			]
		]
	]

	func [
		"Return color source code as HTML."
		text [string!] "Source code text"
	][
		out: make binary! 3 * length? text
		set [value text] load/next/header detab text
		emit copy/part head text text
		parse/all text rule
		out: to-string out

		foreach [from to] reduce [ ; (join avoids the pattern)
			"&" "&amp;" "<" "&lt;" ">" "&gt;"
			join "-[" "-" "<" join "-" "]-" ">"
		][
			replace/all out from to
		]

		insert out {<pre class="rebol-script">}
		append out {</pre>}
	]
]

;Example: write %color-code.html color-code read %color-code.r