REBOL [
    Title: "eText"
    Date: 3-Sep-2002
    Name: 'eText
    Version: 1.2.1
    File: %etext.r
    Author: "Andrew Martin"
    Needs: [
    %Common%20Parse%20Values.r 
    %ML.r
]
    Purpose: "Processes plain text to HTML."
    eMail: Al.Bri@xtra.co.nz
    Web: http://valley.150m.com
    library: [
        level: 'advanced 
        platform: none 
        type: 'tool 
        domain: [file-handling text-processing] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

make object! [
	Link_Base: none
	Link_Wiki: false
	Space: charset [#" " #"^-"]
	Separator: charset [#"." #"!" #" " #"," #"?" #";" #":"]
	Empty: [any Space newline]
	Inline!: make object! [
		Text: Block: Before: After: none
		Plain: function [Value [block! string! tag! none!]][String][
			String: copy/part Before After
			if not empty? String [
				append Block String
				]
			if not none? Value [
				repend Block Value
				]
			]
		Pair: function [Mark [char!] HtmlDialect [block!]][NonMark Temporary][
			NonMark: exclude Graphic charset to string! Mark
			compose/deep [
				Temporary: (Mark) copy Text [some (NonMark) any [opt #" " some (NonMark)]]
				(Mark)
				(to-paren reduce ['Plain HtmlDialect])
				(to-paren [After: Temporary])
				Before:
				]
			]
		Link: make object! [
			Word: [Alpha any [AlphaDigit | #"-"] opt {'s} opt #"/"]
			Text: Link: URL: none
			URL_Mail: func [URL [string!]] [
				if 2 <= length? URL [
					URL: first load/next URL
					if email? URL [URL: join "mailto:" URL]
					]
				URL
				]
			ImageAnchor: func [Text [string!] URL [string!]][
				URL: URL_Mail URL
				all [
					file? URL
					URL: join Link_Base URL
					]
				Plain either any [
					found? find/last URL %.jpg
					found? find/last URL %.gif
					found? find/last URL %.png
					][
					['img/src URL]
					][
					['a/href URL Text]
					]
				]
			Rule: [
				[
					After: [
						#"^"" copy Text to #"^"" skip
						#" " [
							#"%" #"^"" copy Link to #"^"" skip (
								insert replace/all Link #" " "%20" #"%"
								)
							| copy Link URI
							]
						#" " copy URL URI
						](
						Link: first load/next Link
						all [
							file? Link
							Link: join Link_Base Link
							]
						Plain [
							'a/href URL_Mail URL reduce [
								'img/src Link Text
								]
							]
						) Before:
					]
				| [
					After: [
						{"} copy Text to {" } {" } [
							#"%" #"^"" copy Link to #"^"" skip (
								insert replace/all Link #" " "%20" #"%"
								)
							| copy Link URI
							]
						] (ImageAnchor Text Link) Before:
					]
				| After: copy Link URI (ImageAnchor copy Link Link) Before:
				| [
					After: [
						{?"} copy Link to {"} skip
						| "?" copy Link Word
						](
						Text: copy Link
						Link: rejoin [
							Link_Base
							to-file replace/all Link #" " "%20"
							either Link_Wiki [""] [
								either #"/" = last Link [%index.html][%.html]
								]
							]
						Plain ['a/href Link Text]
						) Before:
					]
				]
			]
		DoubleQuote: make object! [
			Mark: #"^""
			NonMark: exclude Graphic charset to-string Mark
			Rule: [
				After: Mark copy Text [NonMark any [NonMark | #" "]] Mark (
					Plain [rejoin ["“" Text "”"]]
					) Before:
				]
			]
		SingleQuote: make object! [
			Mark: #"'"
			Div: none
			NonMark: exclude Graphic charset to-string Mark
			Rule: [
				After: #" " Mark copy Text [NonMark some [NonMark | #" "]]
					Mark copy Div Separator(
					Plain [rejoin [#" " "‘" Text "’" Div]]
					) Before:
				]
			]
		Superscript: make object! [
			Rule: [
				After: #"^^" copy Text [some Alpha | Digits] (
					Plain reduce [  Text  ]
					) Before:
				]
			]
		Single: func [Mark [string! char!] Replacement [string!]][
			compose [After: (Mark) (to-paren compose [Plain (Replacement)]) Before:]
			]
		Rules: compose [
			(Link/Rule)
			| (DoubleQuote/Rule)
			| (SingleQuote/Rule)
			| (Pair #"_" ['u Text])
			| (Pair #"~" ['i Text])
			;| (Pair #"+" ['ins Text])
			;| (Pair #"-" ['del Text])	; Need a better choice for 'Del, not hyphen.
			| (Pair #"*" ['b Text])
			| (Single newline "
")
			| (Single {---} "—")
			| (Single {--} "–")
			| (Single {&} "&")
			| (Single {<} "<")
			| (Single {>} ">")
			| (Single {(c)} "©")	| (Single {(C)} "©")
			| (Single {(r)} "®")	| (Single {(R)} "®")
			| (Single {(tm)} "™")	| (Single {(TM)} "™")
			| (Single {-tm} "™")	| (Single {-TM} "™")
			| (Single {A^^`} {À}) |	(Single {a^^`} {à})
			| (Single {A^^'} {Á}) |	(Single {a^^'} {Á})
			| (Single {A^^~} {Ã}) |	(Single {a^^~} {ã})
			| (Single {A^^"} {Ä}) |	(Single {a^^"} {ä})
			| (Single {A^^*} {Å}) |	(Single {a^^*} {å})
			| (Single {A^^E} {Æ}) |	(Single {a^^e} {æ})
			| (Single {,C} {Ç}) |	(Single {,c} {&ccdel;})
			| (Single {E^^`} {È}) |	(Single {e^^`} {è})
			| (Single {E^^'} {É}) |	(Single {e^^'} {é})
			| (Single {E^^"} {Ë}) |	(Single {e^^"} {ë})
			| (Single {I^^`} {Ì}) |	(Single {i^^`} {ì})
			| (Single {I^^'} {Í}) |	(Single {i^^'} {í})
			| (Single {I^^"} {Ï}) |	(Single {i^^"} {ï})
			| (Single {D^^-} {Ð}) |	(Single {d^^-} {ð})
			| (Single {N^^~} {Ñ}) |	(Single {n^^~} {ñ})
			| (Single {O^^`} {Ò}) |	(Single {o^^`} {ò})
			| (Single {O^^'} {Ó}) |	(Single {o^^'} {ó})
			| (Single {O^^~} {Õ}) |	(Single {o^^~} {õ})
			| (Single {O^^"} {Ö}) |	(Single {o^^"} {ö})
			| (Single {O^^/} {Ø}) |	(Single {o^^/} {ø})
			| (Single {O^^E} {Œ}) |	(Single {o^^e} {œ})
			| (Single {U^^`} {Ù}) |	(Single {u^^`} {ù})
			| (Single {U^^'} {Ú}) |	(Single {u^^'} {ú})
			| (Single {U^^"} {Ü}) |	(Single {u^^"} {ü})
			| (Single {Y^^'} {Ý}) |	(Single {y^^'} {ý})
			| (Single {Y^^"} {Ÿ}) |	(Single {y^^"} {ÿ})
			| (Single {S^^z} {ß})
			| (Single {P|} {Þ}) |	(Single {p|} {þ})
			| (Single {~!} {¡}) |	(Single {~?} {¿})
			| (Single {c^^/} {¢}) |	(Single {L^^-} {£})
			| (Single {Y^^-} {&Yen;})
			| (Single {o^^$} {¤})
			| (Single {||} {¦})
			| (Single {<<} {«})	| (Single {>>} {»})
			| (Single {-,} {¬})
			| (Single {^^-} {¯})	| (Single {^^o} {°}) | (Single {^^o-} {º})
			; { 1/4 } { ¼ }	{ 1/2 } { ½ }	{ 3/4 } { ¾ }
			| (Single {''} {´})
			| (Single {^^/u} {µ})
			| (Single {P^^!} {¶})
			| (Single {sO} {§})
			| (Single {^^.} {·})
			| (Single {,,} {¸})
			| (Single {...} {…})
			| (Single { +- } { ± })
			| (Single { * } { × })
			| (Single {-:} {÷})
			;| (Single { / } { ÷ })	; Slash is often used as a divider or alternative.
			| (Single {A^^} {Â})	| (Single {a^^} {â})
			| (Single {E^^} {Ê})	| (Single {e^^} {ê})
			| (Single {I^^} {Î})	| (Single {i^^} {î})
			| (Single {O^^} {Ô})	| (Single {o^^} {ô})
			| (Single {U^^} {Û})	| (Single {u^^} {û})
			;{ pi } {π}
			| (Single {sqrt} {√})	; {Ö}
			| (Superscript/Rule)
			| skip
			]
		Dialect: func [String [string!]][
			Block: make block! 10
			Before: String
			After: none
			parse/case/all String [some Rules (Plain None) end]
			either empty? Block [
				String
				][
				Block
				]
			]
		Literal-Rules: compose [
			(Single {&} "&")
			| (Single {<} "<")
			| (Single {>} ">")
			| skip
			]
		Literal: func [String [string!]][
			Block: make block! 10
			Before: String
			After: none
			parse/case/all String [some Literal-Rules (Plain None) end]
			either empty? Block [
				String
				][
				Block
				]
			]
		]
	Inline: get in Inline! 'Dialect
	Literal: get in Inline! 'Literal
	Line: Heading: Block: Previous: none
	Text-Line: [Graphic any Printable]
	Text: [copy Line Text-Line empty]
	H: [
		opt Empty
		Text
		[
			some "*" (Heading: 'h1)
			| some "=" (Heading: 'h2)
			| some "-" (Heading: 'h3)
			| some "~" (Heading: 'h4)
			| some "_" (Heading: 'h5)
			| some "." (Heading: 'h6)
			] empty (repend Block [Heading Inline Line])
		]
	IP: [Text (repend Block ['p/class "Initial" Inline Line])]
	RP: [2 Empty Text (repend Block [
 'p/class "Initial" Inline Line])]
	P: [[Empty | tab | #" "] Text (repend Block ['p Inline Line])]
	Align!: make object! [
		Type: 'left
		Rule: [#" " (Type: 'center) | tab (Type: 'right) | none (Type: 'left)]
		]
	Align: Align!/Rule
	Center: make object! [
		Lines: make block! 10
		Rule: [
			some [
				#" " copy Line [Graphic any Printable] empty (
					if not empty? Lines [
						append Lines 

						]
					append Lines Inline Line
					)
				](
				repend Block ['div/align "center" Lines]
				Lines: make block! 10
				)
			]
		]
	Table: make object! [
		Type: 'th
		Mark: #"|"
		NonBar: exclude Printable charset to-string Mark
		Cells: make block! 10
		BarCell: [Align copy Line any NonBar any [#" " | tab]]
		TabCell: [Align copy Line any Printable]
		Append-Cell: does [
			repend Cells [
				make path! reduce [Type 'align] Align!/Type
				either none? Line [""][Inline trim Line]
				]
			]
		Row: [
			[
				opt [some [Mark some #"-"] opt Mark empty]
				some [Mark BarCell (Append-Cell)] opt Mark empty
				]
			| TabCell (Append-Cell) some [tab TabCell (Append-Cell)] empty
			]
		Rows: make block! 10
		Rule: [
			opt Empty
			(
				Type: 'th
				Rows: make block! 10
				Cells: make block! 10
				)
			some [
				Row (
					repend Rows ['tr Cells]
					Type: 'td
					Cells: make block! 10
					)
				] (
				repend Block ['table Rows]
				)
			]
		]
	Quote: make object! [
		Quotes: make string! 100
		Rule: [
			opt Empty
			some [
				2 [tab | #" "] copy Line some [Printable | tab] empty (
					append Quotes rejoin [trim/tail Line newline]
					)
				] (
				repend Block ['blockquote reduce ['pre Literal detab Quotes]]
				clear Quotes
				)
			]
		]
	BlockQuote: make object! [
		Center: no
		NonQuote: exclude Graphic charset {"}
		Lines: make block! 10
		Common: function [L [string! block!]] [bq] [
			bq: [
				'i reduce [
					'blockquote either string? L [inline L] [L]
					]
				]
			repend Block either Center [
				[
					'div/align "center" reduce bq
					]
				] [
				bq
				]
			Center: no
			]
		Rule: [
			[
				opt [#" " (Center: true)] (Lines: make block! 10)
				#"^"" copy Line [some [NonQuote | { "} | {" } | { }]] #"^"" empty (
					Common Line
					)
				]
			| [
				opt [#" " (Center: true)] (Lines: make block! 10)
				#"^"" copy Line [some [NonQuote | { "} | {" } | { }]] empty (
					repend Lines [Line 
]
					)
				any [
					opt #" " copy Line [some [NonQuote | { "} | {" } | { }]] empty (
						repend Lines [Line 
]
						)
					]
				opt #" " copy Line [some [NonQuote | { "} | {" } | { }]] #"^"" empty (
					append Lines Line
					Common Lines
					)
				]
			]
		]
	List: make object! [
		ULI: [#"*" [tab | #" "] Text]
		OLI: [#"0" [tab | #" "] Text]
		Term: Definition: none
		DT: [copy Term Text-Line empty]
		DD: [[tab | #" "] copy Definition Text-Line empty]
		Br: [opt Empty]
		Item: func [Block [block!] /DL][
			repend Block either DL [
				['dt Inline Term 'dd Inline Definition]
				] [
				['li Inline Line]
				]
			]
		Nest: func [Outer [block!] 'Word [word!] Items [block!]][
			repend Outer [Word Items]
			make block! length? Items
			]
		LIs: make block! 1
		UL: [some [Br ULI (Item LIs) | UL1 | OL1 | DL1] (LIs: Nest Block ul LIs)]
		OL: [some [Br OLI (Item LIs) | OL1 | UL1 | DL1] (LIs: Nest Block ol LIs)]
		DL: [some [Br DT DD (Item/DL LIs) | DL1 | UL1 | OL1] (LIs: Nest Block dl LIs)]
		Tab1: [tab | #" "]
		LI1s: make block! 1
		UL1: [some [Br Tab1 ULI (Item LI1s) | UL2 | OL2 | DL2] (LI1s: Nest LIs ul LI1s)]
		OL1: [some [Br Tab1 OLI (Item LI1s) | OL2 | UL2 | DL2] (LI1s: Nest LIs ol LI1s)]
		DL1: [some [Br Tab1 DT Tab1 DD (Item/DL LI1s) | DL2 | UL2 | OL2] (LI1s: Nest LIs dl LI1s)]
		Tab2: [2 Tab1]
		LI2s: make block! 1
		UL2: [some [Br Tab2 ULI (Item LI2s) | UL3 | OL3 | DL3] (LI2s: Nest LI1s ul LI2s)]
		OL2: [some [Br Tab2 OLI (Item LI2s) | OL3 | UL3 | DL3] (LI2s: Nest LI1s ol LI2s)]
		DL2: [some [Br Tab2 DT Tab2 DD (Item/DL LI2s) | DL3 | UL3 | OL3] (LI2s: Nest LI1s dl LI2s)]
		Tab3: [3 Tab1]
		LI3s: make block! 1
		UL3: [some [Br Tab3 ULI (Item LI3s) | UL4 | OL4 | DL4] (LI3s: Nest LI2s ul LI3s)]
		OL3: [some [Br Tab3 OLI (Item LI3s) | OL4 | UL4 | DL4] (LI3s: Nest LI2s ol LI3s)]
		DL3: [some [Br Tab3 DT Tab3 DD (Item/DL LI3s) | DL4 | UL4 | OL4] (LI3s: Nest LI2s dl LI3s)]
		Tab4: [4 Tab1]
		LI4s: make block! 1
		UL4: [some [Br Tab4 ULI (Item LI4s) | UL5 | OL5 | DL5] (LI4s: Nest LI3s ul LI4s)]
		OL4: [some [Br Tab4 OLI (Item LI4s) | OL5 | UL5 | DL5] (LI4s: Nest LI3s ol LI4s)]
		DL4: [some [Br Tab4 DT Tab4 DD (Item/DL LI4s) | DL5 | UL5 | OL5] (LI4s: Nest LI3s dl LI4s)]
		Tab5: [5 Tab1]
		LI5s: make block! 1
		UL5: [some [Br Tab5 ULI (Item LI5s) | UL6 | OL6 | DL6] (LI5s: Nest LI4s ul LI5s)]
		OL5: [some [Br Tab5 OLI (Item LI5s) | OL6 | UL6 | DL6] (LI5s: Nest LI4s ol LI5s)]
		DL5: [some [Br Tab5 DT Tab5 DD (Item/DL LI5s) | DL6 | UL6 | OL6] (LI5s: Nest LI4s dl LI5s)]
		Tab6: [6 Tab1]
		LI6s: make block! 1
		UL6: [some [Br Tab6 ULI (Item LI6s) | UL7 | OL7 | DL7] (LI6s: Nest LI5s ul LI6s)]
		OL6: [some [Br Tab6 OLI (Item LI6s) | OL7 | UL7 | DL7] (LI6s: Nest LI5s ol LI6s)]
		DL6: [some [Br Tab6 DT Tab6 DD (Item/DL LI6s) | DL7 | UL7 | OL7] (LI6s: Nest LI5s dl LI6s)]
		Tab7: [7 Tab1]
		LI7s: make block! 1
		UL7: [some [Br Tab7 ULI (Item LI7s)] (LI7s: Nest LI6s ul LI7s)]
		OL7: [some [Br Tab7 OLI (Item LI7s)] (LI7s: Nest LI6s ol LI7s)]
		DL7: [some [Br Tab7 DT Tab7 DD (Item/DL LI7s)] (LI7s: Nest LI6s dl LI7s)]
		Rule: [opt Empty [UL | OL | DL]]
		]
	VerticalSpace: [some [empty (append Block 'br)]]
	Statements: make object! [
		Lines: make block! 1
		Rule: [
			some [Text (append Lines append Inline Line 
)] (
				remove back tail Lines
				repend Block ['p/class "Initial" Lines]
				Lines: make block! 10
				)
			]
		]
	BulletDivider: [
		Empty " *" empty Empty (
			append Block [
				
 div/align "center" "•" 

				]
			)
		]
	LineDivider: [
		Empty 3 #"-" any #"-" empty Empty (append Block 
)
		]
	Rules: compose/deep [
		any [
			BulletDivider
			| LineDivider
			| H opt [(Quote/Rule) | (List/Rule)| (Table/Rule) | (BlockQuote/Rule) | IP]
			| (Quote/Rule)
			| (List/Rule)
			| (Table/Rule)
			| (BlockQuote/Rule)
			| (Center/Rule)
			| RP
			| P
			| VerticalSpace
			| (Statements/Rule)
			]
		end
		]
	set 'eText func [
		"Processes plain text into HTML."
		eText [string!]	"The plain text."
		/Wiki	"Format for a Wiki."
		/Base Base_URL [url! file! string!]	"Base URL for references."
		][
		Link_Wiki: Wiki
		Link_Base: either Base [Base_URL] [""]
		Block: make block! 1000
		if not empty? eText [
			if newline <> last eText [append eText newline]
			parse/all eText Rules
			]
		Block
		]
	]