REBOL [
    Title: "BBcode"
    Date: 5-Jan-2009/1:06:26+1:00
    Name: 'bbcode
    Version: 0.1.0
    File:    %bbcode.r
    Author:  "David 'Oldes' Oliva"
    Email:   oliva.david@seznam.cz
    Home:    http://box.lebeda.ws/~hmm/
    Owner: none
    Rights: none
    Needs: none
    Tabs: 4
    Usage: [
    	test-cases: [
			{text [b]bold[/b] abc}  {text bold abc}
			{text [b]bold [i]italic[/b]}  {text bold italic}
			{[s]strikethrough text[/s]}  {strikethrough text}
			{[url]http://example.org[/url]}  {http://example.org}
			{[url=http://example.com]Example[/url]}  {Example}
			{[url=http://example.com][b]Example[/url]}  {Example}
			{[b][ul][li]Jenny[/li][li]Alex[/li][li]Beth[/li][/ul][/b]}  {}
			{[ul][li]bla[li]bla}  {}
			{[ul][li][b]bla[li]bla}  {}
			{[ul][li]bla[li][ol][li]bla[/ol]}  {}
			{[code]xx[b]yy[/b]zz[/code]}  {xx[b]yy[/b]zz}
			{[list][*]aaa[*]bbb[/list]}  {}
			{[list=a][*]aaa[*]bbb[/list]}  {
  1. aaa
  2. bbb
}
			{[list=A][*]aaa[*]bbb[/list]}  {
  1. aaa
  2. bbb
}
			{[/b]} {}
			{aa[b="]bb} {aa[b="]bb}
			{[quote]blabla} {
blabla
}
			{[quote=Carl]blabla} {
Carl
blabla
}
			{[img]http://www.google.com/intl/en_ALL/images/logo.gif[/img]} {}
			{[url=http://http://www.google.com/][img]http://www.google.com/intl/en_ALL/images/logo.gif[/url][/img]}
			 {}
			{[img]1.gif [img]2.gif} { }
			{text [size=tiny]tiny} {text tiny}
			{[h1]header[/h1]} {
header
}
			{[color]ee[/color][color=#F00]red[color=#00FF00]green} {eeredgreen}
			{}  {<a>}
			{multi^/line}  {multi^/
line}
			{invalid [size]size[/size]}  {invalid size}
			{[align=right]right}  {
right
}
			{[email]x@x.cz[/email] [email=x@x.cz]email [b]me[/email]}  {x@x.cz email me}
		]
		foreach [src result] test-cases [
			print ["<==" src]
			print ["==>" tmp: bbcode src]
			print either tmp = result ["OK"][join "ERR " result]
			print "---"
		]
	]
    Purpose: {Basic BBCode implementation. For more info about BBCode check http://en.wikipedia.org/wiki/BBCode}
    Comment: none
    History: [
    	0.1.0 5-Jan-2009 "Initial version"
	]
	Type: [tool dialect function]
    Library: [
        level:    'advanced
        platform: 'all
        type:     [tool dialect function]
        domain:   [dialects files html markup parse text text-processing web]
    ]

    Content: none
]

ctx-bbcode: context [
	ch-normal:    complement charset "[<^/"
	ch-attribute: complement charset {"'<>]}
	ch-hexa: charset [#"a" - #"f" #"A" - #"F" #"0" - #"9"]
	ch-name: charset [#"a" - #"z" #"A" - #"Z" #"*" #"0" - #"9"]
	ch-url:  charset [#"a" - #"z" #"A" - #"Z" #"0" - #"9" "./:~+-%#\_=&?@"]
	opened-tags: copy []
	rl-attribute: [#"=" copy attr any ch-attribute]

	allow-html-tags?: false
	attr: none
	html: copy ""
			
	close-tags: func[tags [block!]][
		foreach tag head reverse tags [
			append html case [
				tag = "url" [""]
				find ["list" "color" "quote" "size" "align" "email"] tag [""]
				
				true [
					rejoin [""]
				]
			]
		]
	]
	
	enabled-tags: [
		"b" "i" "s" "u" "del" "h1" "h2" "h3" "h4" "h5"
		"ins" "dd" "dt" "ol" "ul" "li" "url" "list" "*"
		"color" "quote" "img" "size" "rebol" "align" "email"
	]
	
	set 'bbcode func["Converts BBCode markup into HTML" code [string! binary! file! url!] "Input with BBCode tags" /local tmp tag][
		clear html
		if any [file? code url? code][code: read/binary code]
		parse/all code [
			any [
				(attr: none)
				copy tmp some ch-normal (append html tmp)
				|
				"[url]" copy tmp some ch-url opt "[/url]" (
					append html rejoin [{} tmp {}]
				)
				|
				"[email]" copy tmp some ch-url opt "[/email]" (
					append html rejoin [{} tmp {}]
				)
				|
				"[img]" copy tmp some ch-url opt "[/img]" (
					append html rejoin [{}]
					
				) 
				|
				"[code]" copy tmp to "[/code]" thru "]" (
					append html rejoin [{} tmp {}]
				)
				|
				"[rebol]" copy tmp to "[/rebol]" thru "]" (
					append html rejoin [{} tmp {}]
					;TODO: add REBOL code colorizer
				)
				|
				#"[" [
					;normal opening tags
					copy tag some ch-name opt rl-attribute			
					#"]" (
						if tag = "*" [tag: "li"]
						append html either find enabled-tags tag [
							if find ["li"] tag [
								;closed already opened tag
								if all [
									tmp: find/last opened-tags tag 
									none? find tmp "ol"
									none? find tmp "ul"
								][
									close-tags copy tmp
									clear tmp
								]
							]
							append opened-tags tag
							switch/default tag [
								"url"  [rejoin [{}]]
								"color" [
									either all [attr parse attr [
										#"#" [6 ch-hexa | 3 ch-hexa]
									]][
										append opened-tags "span"
										rejoin [{}]
									][
										;;Should the invalid tag be visible?
										;rejoin either attr [
										;	["[" tag "=" attr "]"]
										;][	["[" tag "]"] ]
										""
									]
								]
								"quote" [
									append opened-tags ["fieldset" "blockquote"]
									either attr [
										rejoin [{
} attr {
}]
									][
										{
}
									]
								]
								"list" [
									if none? attr [attr: ""]
									parse/case attr [
										[
											  "a" (tmp: {
    })
											| "A" (tmp: {
      })
											| "i" (tmp: {
        })
											| "I" (tmp: {
          })
											| "1" (tmp: {
            })
										] (append opened-tags "ol")
										| (append opened-tags "ul" tmp: {