• see also:
• etext [2/2]
• || [help]

[REBOL] Re: String compose

From: al::bri::xtra::co::nz at: 16-Mar-2001 21:27

Marcus wrote:

> text: {
>     Dear (recipients),
>     Now, this is nothing special at all, just a simple
>     example (but a good one). If you don't get the idea
>     maybe you should (mail Marcus "mail me")
>     and I'll explain it to you.}

Better would be:

text: {
    :now
    Dear :Recipients,
    Now, this is nothing special at all, just a simple
    example (but a good one). If you don't get the idea
    maybe you should :[mail Marcus "mail me"]
    and I'll explain it to you.}

I've discovered in my eText software that the:
        :Word
    or:
        :[block of Rebol script]
    contructs seem quite nice and simple. It's also less easy to confuse
with asides in normal text and mimics the use of Rebol's get-word as used in
paths.

Andrew Martin
ICQ: 26227169 http://members.nbci.com/AndrewMartin/
-><-

-- Attached file included as plaintext by Listar --
-- File: eText.r

[
Rebol [
	Name: 'eText
	Title: "eText"
	File: %"eText.r"
	Author: "Andrew Martin"
	Acknowledgements: "Carl Sassenrath"
	Date: 18/Feb/2001
	]

unit [
	%ASCII.r
	%URI.r
	%HTML.r
	]

eText!: make object! [
	Context: none
	Alpha: ASCII/Alpha
	AlphaDigit: ASCII/AlphaDigit
	Define: function [
		eText [string!]	{The text to convert.}
		][
		SetWord String Value
		][
		Context: make block! 0
		parse/case/all eText [
			some [
				BlockQuote
				| copy SetWord [Alpha some AlphaDigit] ":" Gap copy String to newline skip (
					if any [
						error? try [Value: load String]
						word? Value
						block? Value
						][
						Value: String
						]
					repend Context [
						to set-word! SetWord
						Value
						]
					)
				| skip
				]
			]
		Context: make object! Context
		eText
		]
	Space: ASCII/Space
	CharacterSet: ASCII/CharacterSet
	HT: ASCII/HT
	SP: ASCII/SP
	Printable: ASCII/Printable
	Gap: [HT | 2 SP]
	BlockQuoteLine: [Gap Gap copy Value to newline]
	BlockQuote: [some [BlockQuoteLine newline]]
	Value: Text: New: none
	NonBlockCharacter: exclude CharacterSet charset ")]"
	BlockContent: [
		some Space
		| ";"[thru newline | to end]
		| "[" any BlockContent "]"
		| "(" any BlockContent ")"
		| Text: NonBlockCharacter (
			set [Value New] load/next Text
			) :New
		]
	Script: function [
		{Executes embedded script in the eText.}
		eText [string!] {The eText to process.}
		][
		Start End Value Result Word Script
		][
		parse/case/all Define eText [
			some [
				BlockQuote
				| Start: ":" copy Script [
					"[" any BlockContent "]" (Word: false) | Alpha any AlphaDigit (Word: true)
					] End: (
					Script: bind load Script in Context 'self
					either Word [
						Result: get Script
						][
						if unset? set/any 'Result do Script [
							Result: ""
							]
						]
					End: change/part Start mold Result End
					) :End
				| skip
				]
			end
			]
		eText
		]
	CharacterSubstitute: func [Text [string!]][
		foreach [Search Replacement][
			{ & } { &amp; }
			{ < } { < }
			{ > } { > }
			{A^^`} {&Agrave;}	{a^^`} {&agrave;}
			{A^^'} {&Aacute;}	{a^^'} {&Aacute;}
			{A^^~} {&Atilde;}	{a^^~} {&atilde;}
			{A^^"} {&Auml;}	{a^^"} {&auml;}
			{A^^*} {&Aring;}	{a^^*} {&aring;}
			{A^^E} {&AElig;}	{a^^e} {&aelig;}
			{,C} {&Ccedil;}	{,c} {&ccdel;}
			{E^^`} {&Egrave;}	{e^^`} {&egrave;}
			{E^^'} {&Eacute;}	{e^^'} {&eacute;}
			{E^^"} {&Euml;}	{e^^"} {&euml;}
			{I^^`} {&Igrave;}	{i^^`} {&igrave;}
			{I^^'} {&Iacute;}	{i^^'} {&iacute;}
			{I^^"} {&Iuml;}	{i^^"} {&iuml;}
			{D^^-} {&ETH;}	{d^^-} {&eth;}
			{N^^~} {&Ntilde;}	{n^^~} {&ntilde;}
			{O^^`} {&Ograve;}	{o^^`} {&ograve;}
			{O^^'} {&Oacute;}	{o^^'} {&oacute;}
			{O^^~} {&Otilde;}	{o^^~} {&otilde;}
			{O^^"} {&Ouml;}	{o^^"} {&ouml;}
			{O^^/} {&Oslash;}	{o^^/} {&oslash;}
			{O^^E} {&OElig;}	{o^^e} {&oelig;}
			{U^^`} {&Ugrave;}	{u^^`} {&ugrave;}
			{U^^'} {&Uacute;}	{u^^'} {&uacute;}
			{U^^"} {&Uuml;}	{u^^"} {&uuml;}
			{Y^^'} {&Yacute;}	{y^^'} {&yacute;}
			{Y^^"} {&Yuml;}	{y^^"} {&yuml;}
			{S^^z} {&szlig;}
			{P|} {&THORN;}	{p|} {&thorn;}
			{~!} {&iexcl;}	{~?} {&iquest;}
			{c^^/} {&cent;}	{L^^-} {&pound;}	{Y^^-} {&Yen;}	{o^^$} {&curren;}
			{||} {&brvbar;}
			{(c)} {&copy;}	{(r)} {&reg;}	{-tm} {&trade;}	{(tm)} {&trade;}
			{(C)} {&copy;}	{(R)} {&reg;}	{-TM} {&trade;}	{(TM)} {&trade;}
			{<<} {&laquo;}	{>>} {&raquo;}
			{-,} {&not;}
			{^^-} {&macr;}	{^^o} {&deg;}	{^^o-} {&ordm;}
			{ 1/4 } { &frac14; }	{ 1/2 } { &frac12; }	{ 3/4 } { &frac34; }
			{''} {&acute;}
			{^^/u} {&micro;}
			{P^^!} {&para;}
			{sO} {&sect;}
			{^^.} {&middot;}
			{,,} {&cedil;}
			{...} {&hellip;}
			{ +- } {&plusmn;}
			{ * } {&times;}
			{-:} {&divide;}
			; { / } { &divide; }	; Slash is often used as a divider or alternative marker.
			{A^^} {&Acirc;}	{a^^} {&acirc;}
			{E^^} {&Ecirc;}	{e^^} {&ecirc;}
			{I^^} {&Icirc;}	{i^^} {&icirc;}
			{O^^} {&Ocirc;}	{o^^} {&ocirc;}
			{U^^} {&Ucirc;}	{u^^} {&ucirc;}
			{ pi } {&pi;}
			{sqrt} {&radic;}	; {<font face="symbol">&#214;</font>}
			"^^*" "&star;"
			"^^_" "&under;"
			"^^~" "&tilde;"
			"^^`" "&backtick;"
			"^^^^" "&caret;"
			][
			replace/case/all Text Search Replacement
			]
		Text
		]

	Alpha: ASCII/Alpha
	Alphanumeric: ASCII/Alphanumeric
	Graphic: ASCII/Graphic
	SP: ASCII/SP
	Digit: ASCII/Digit
	Hexadecimal: ASCII/Hexadecimal
	Number: [some Digit opt ["." some Digit]]
	Email: URI/Email
	FileRef: URI/FileRef
	LinkRef: URI/LinkRef
	URL: URI/AbsoluteURL
	Bold?: Underline?: Italic?: Fixed?: none
	Mark: Text: Value: Value2: MarkEnd: TextEnd: ValueEnd: Value2End: Result: none
	NonDash: exclude Graphic charset "-"
	NonPlus: exclude Graphic charset "+"
	PairMarkup: charset "~`*_+-"
	NonPairMarkup: exclude Graphic PairMarkup
	NonQuoteText: exclude Printable charset {"}
	Rules: [
		[
			Mark: {"} copy Text some NonQuoteText {"} SP copy Value LinkRef MarkEnd: (
				any [
					error? try [Value2: first load/next Value]
					if any [
						url? :Value2
						file? :Value2
						email? :Value2
						][
						MarkEnd: change/part Mark join {} [
							build-tag [a href (Value2)]
							Text
							</a>
							] MarkEnd
						]
					]
				) :MarkEnd
			]
		|[	; Fragment link.
			[
				[
					Mark: "#" Text: some Alphanumeric TextEnd: MarkEnd:
					]
				|[
					Mark: {#"} Text: to {"} TextEnd: skip MarkEnd:
					]
				](
				MarkEnd: change/part Mark join {} [
					build-tag [a href (join "#" replace/all copy/part Text TextEnd " " "_")]
					replace/all copy/part Text TextEnd " " "&nbsp;"
					</a>
					] MarkEnd
				) :MarkEnd
			]
		|[	; File link.

   Mark: {"} copy Text to {" } {" } copy Value FileRef (Value2: none) opt [SP copy Value2 
   FileRef] MarkEnd: (
				Value2: Value: none
				error? try [
					Value: load Value
					MarkEnd: change/part Mark either found? any [
						find Value %.png
						find Value %.gif
						find Value %.jpg
						][
						join {} [
							either any [
								none? Value2
								error? try [Value2: load Value2]
								][
								""
								][
								build-tag [a href (HTML!/Encode Value2)]
								]
							build-tag [
								img border (0) src (HTML!/Encode Value) alt (Text)
								; width (WxH/x) height (WxH/y)
								]
							either none? Value2 [
								""
								][
								</a>
								]
							]
						][
						join {} [
							build-tag [a href (HTML!/Encode Value)]
							Text
							</a>
							]
						] MarkEnd
					]
				) :MarkEnd
			]
		|[	; Wiki-ish File link.
			[
				[
					Mark: "?" copy Text some [Alphanumeric | {'}] MarkEnd:
					]
				|[
					Mark: {?"} copy Text to {"} skip MarkEnd:
					]
				](
				MarkEnd: change/part Mark join {} [
					build-tag [a href (join replace/all copy Text " " " " ".html")]
					replace/all copy Text " " "&nbsp;"
					</a>
					] MarkEnd
				) :MarkEnd
			]
		|[
			Mark: Email MarkEnd: (
				MarkEnd: change/part Mark join {} [
					build-tag [a href (join {mailto:} copy/part Mark MarkEnd)]
					replace/all copy/part Mark MarkEnd " " "&nbsp;"
					</a>
					] MarkEnd
				) :MarkEnd
			]
		|[
			Mark: URL MarkEnd: (
				MarkEnd: change/part Mark join {} [
					build-tag [a href (copy/part Mark MarkEnd)]
					replace/all copy/part Mark MarkEnd " " "&nbsp;"
					</a>
					] MarkEnd
				) :MarkEnd
			]
		|[
			Mark: "---" MarkEnd: (
				MarkEnd: change/part Mark {&mdash;} MarkEnd
				) :MarkEnd
			]
		|[
			Mark: "--" MarkEnd: (
				MarkEnd: change/part Mark {&ndash;} MarkEnd
				) :MarkEnd
			]
		|[
			Mark: "^^" Text: [some Alpha | Number] TextEnd: MarkEnd: (
				MarkEnd: change/part Mark rejoin [
					"" <sup> copy/part Text TextEnd </sup>
					] MarkEnd
				) :MarkEnd
			]
		|[
			; Ignore markup that's meant to be in text.
			NonPairMarkup PairMarkup NonPairMarkup
			]
		|[
			Mark: {~} Text: Graphic to {~} TextEnd: skip MarkEnd: (
				change/part Mark rejoin [
					"" <em> copy/part Text TextEnd </em>
					] MarkEnd
				) :Mark
			]
		|[
			Mark: {`} Text: Graphic to {`} TextEnd: skip MarkEnd: (
				change/part Mark rejoin [
					"" <code> copy/part Text TextEnd </code>
					] MarkEnd
				) :Mark
			]
		|[
			Mark: {*} Text: Graphic to {*} TextEnd: skip MarkEnd: (
				change/part Mark rejoin [
					"" <strong> copy/part Text TextEnd </strong>
					] MarkEnd
				) :Mark
			]
		|[
			Mark: {_} Text: Graphic to {_} TextEnd: skip MarkEnd: (
				change/part Mark rejoin [
					"" <u> copy/part Text TextEnd </u>
					] MarkEnd
				) :Mark
			]
		|[
			[{-} | {+}] some Digit	; Ignore Signed numbers.
			]
		|[
			Mark: {+} Text: Graphic to {+} TextEnd: skip MarkEnd: (
				change/part Mark rejoin [
					{} <u> <ins> copy/part Text TextEnd </ins> </u>
					] MarkEnd
				) :Mark
			]
		|[
			Mark: {-} Text: some [
				NonDash
				| some " " some "-" some " "
				| " "
				] TextEnd: {-} MarkEnd: (
				change/part Mark rejoin [
					{} <strike> <del> copy/part Text TextEnd </del> </strike>
					] MarkEnd
				) :Mark
			]
		|[
			Mark: {`} Text: Graphic to {'} TextEnd: skip MarkEnd: (
				change/part Mark join {} [
					<i> copy/part Text TextEnd </i>
					] MarkEnd
				) :Mark	; Reprocess from start of replaced text for other markup.
			]
		| skip
		]

	Inline: func [Line [string!]][
		either "*" = Line [
			"&bull;"
			][
			parse/case/all CharacterSubstitute Line [some Rules end]
			foreach [Replacement Target][
				"*" "&star;"
				"_" "&under;"
				"~" "&tilde;"
				"`" "&backtick;"
				"^^" "&caret;"
				][
				replace/all Line Target Replacement
				]
			Line
			]
		]
	Cell: "|"
	Cells: function [
		eText [string!] /Header
		][
		Values Align Text Value
		][
		Values: make block! 0
		Text: exclude ASCII/CharacterSet charset Cell
		parse/case/all eText [
			some [
				Cell [
					" " (Align: 'Center) | "^-" (Align: 'Right) | none (Align: 'Left)
					]
				copy Value any Text (
					repend Values [
						make path! reduce [either Header ['th]['td] Align]
						either none? Value [Value: "<br />"][inline Value]
						]
					)
				]
			]
		Values
		]
	Rows: function [eText [string!]][
		Values Row Value
		][
		Values: make block! 0
		Row: [copy Value [Cell to newline] skip (append Values 'tr)]
		parse/case/all eText [
			Row (append/only Values Cells/Header Value)
			any [Row (append/only Values Cells Value)]
			]
		Values
		]

	Digit: ASCII/Digit
	Lower: ASCII/Lower
	Upper: ASCII/Upper
	LowerRoman: ASCII/LowerRoman
	UpperRoman: ASCII/UpperRoman
	ListType: make string! 10
	ListLineText: make string! 100
	ListLine: [
		copy ListType [
			some Digit "." some Digit |
			some Digit |
			some LowerRoman |
			some UpperRoman |
			Lower |
			Upper |
			["*" | "-" | "#"]
			] opt [")" | "." | "/"] Gap copy Text some Printable newline opt newline (
			ListLineText: Inline Text
			)
		]
	ListIndentStart: ListIndentEnd: none
	ListIndent: ListIndentMax: -1
	ListLines: make block! 0
	DefinitionText: exclude Printable charset ":"
	Definitions: make block! 0
	DefinitionTermText: string!
	DefinitionTerm: [
		copy DefinitionTermText some DefinitionText
		]
	DefinitionDefinition: [
		copy Text some Printable newline (
			repend Definitions [
				'dt 'a/name replace/all copy DefinitionTermText " " "_"
					append replace/all copy DefinitionTermText " " "&nbsp;" ":"
				'dd Inline Text
				]
			)
		]
	HeadingType: none
	Heading: [
		"*" (HeadingType: 'h1)
		| "=" (HeadingType: 'h2)
		| "-" (HeadingType: 'h3)
		| "~" (HeadingType: 'h4)
		| "_" (HeadingType: 'h5)
		]
	set 'eText function [
		{Processes eText into HTML.}
		eText [string!]	{The text to convert.}
		/Page
		/Title Text [string!]
		][
		HTML Values InitialParagraph
		][
		if newline <> last eText [append eText newline]
		Values: make block! 0
		HTML: make block! 10000
		insert HTML <div class="eText">
		InitialParagraph: [
			copy Value to newline skip (
				if not none? Value [
					repend HTML ['ip Inline Value]
					]
				)
			]
		parse/case/all Script eText [
			some [
				some [
					BlockQuoteLine newline (
						foreach [Target Replacement][
							"^-" "  "
							"<" "<"
							"&" "&amp;"
							">" ">"
							][
							replace/all Value Target Replacement
							]
						append Values join Value newline
						)
					](
					repend HTML ['blockquote 'pre rejoin Values]
					clear Values
					)
				|[
					some "<" (Value: "Left") | some ">" (Value: "Right")
					| some "^^" (Value: "Top") | some "v" (Value: "Bottom")
					| some "+" (Value: "eText")
					] newline opt newline (
					repend HTML [</div> build-tag [div class (Value)]]
					Value: none
					)
				|[

     Mark: {"} copy Text some NonQuoteText {"} SP copy Value LinkRef copy TextEnd any Printable 
     newline
					some Heading newline opt newline (
						if none? TextEnd [TextEnd: ""]
						error? try [Value2: first load/next Value]
						parse Value2 [
							[email! | url! | file!] (
								repend HTML [
									HeadingType 'a/name Text 'a Value2 join Text TextEnd
									]
								)
							]
						)
					]
				|[
					copy Value some Printable newline
					some Heading newline opt newline (
						repend HTML [
							HeadingType 'a/name Value Inline trim Value
							]
						)
					]
				| copy Value some [Cell thru newline] opt newline (
					repend HTML ['table Rows Value]
					)
				|[
					(clear ListLines)
					some [
						ListIndentStart: any Gap ListIndentEnd: ListLine (
							ListIndent: length? copy/part ListIndentStart ListIndentEnd
							ListIndentMax: max ListIndentMax ListIndent
							repend ListLines [
								ListIndent ListType trim ListLineText
								]
							)
						] opt newline (
						use [PrevIndent PrevTypes HtmlText][
							PrevIndent: -1 PrevTypes: make block! 0 HtmlText: make string! 10000
							foreach [Indent Type Text] ListLines [
								any [
									if all [
										Indent = (PrevIndent + 1)
										Type <> top PrevTypes
										][
										append HtmlText " list/type ["
										push PrevTypes Type
										]
									if PrevIndent > Indent [
										while [PrevIndent > Indent][
											append HtmlText join "] " mold pop PrevTypes
											Decrement PrevIndent
											]
										]
									]
								; Is the next item a list?
								if (Indent + 1) = select ListLines Text [
									append HtmlText " join"
									]
								append HtmlText join " " mold Text
								append HtmlText newline
								PrevIndent: Indent
								]
							while [not none? top PrevTypes][
								append HtmlText join "] " mold pop PrevTypes
								]
							append HTML load HtmlText
							]
						)
					]
				|[
					some [DefinitionTerm ":" Gap DefinitionDefinition] opt newline (
						repend HTML ['dl Definitions]
						clear Definitions
						)
					]
				| copy Value ["<" some Alpha thru ">"] (
					append HTML Value
					)
				| " " copy Value some Printable newline (
					repend HTML ['Center Inline Value]
					)
				|[
					opt Gap copy Value some Printable newline opt newline (
						repend HTML ['p Inline Value]
						)
					]
				| any [" " | "^-"] newline (repend HTML 'br)
				| InitialParagraph
				| skip
				]
			]
		append HTML </div>
		either Page [
			compose [
				Title (
					use [TitlePosition][
						any [
							if Title [
								Text
								]
							either found? TitlePosition: find HTML 'H1 [
								third TitlePosition
									][
								"eText Document"
								]
							]
						]
					)
				; JavaScript before StyleSheet to work correctly in Netscape Navigator.
				JavaScript %eText.js
				StyleSheet %eText.css
				body
				(HTML)
				]
			][
			HTML
			]
		]
	]

]

[1] · 2 · 3 · See whole thread