String compose
[1/3] 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][
{ & } { & }
{ < } { < }
{ > } { > }
{A^^`} {À} {a^^`} {à}
{A^^'} {Á} {a^^'} {Á}
{A^^~} {Ã} {a^^~} {ã}
{A^^"} {Ä} {a^^"} {ä}
{A^^*} {Å} {a^^*} {å}
{A^^E} {Æ} {a^^e} {æ}
{,C} {Ç} {,c} {&ccdel;}
{E^^`} {È} {e^^`} {è}
{E^^'} {É} {e^^'} {é}
{E^^"} {Ë} {e^^"} {ë}
{I^^`} {Ì} {i^^`} {ì}
{I^^'} {Í} {i^^'} {í}
{I^^"} {Ï} {i^^"} {ï}
{D^^-} {Ð} {d^^-} {ð}
{N^^~} {Ñ} {n^^~} {ñ}
{O^^`} {Ò} {o^^`} {ò}
{O^^'} {Ó} {o^^'} {ó}
{O^^~} {Õ} {o^^~} {õ}
{O^^"} {Ö} {o^^"} {ö}
{O^^/} {Ø} {o^^/} {ø}
{O^^E} {Œ} {o^^e} {œ}
{U^^`} {Ù} {u^^`} {ù}
{U^^'} {Ú} {u^^'} {ú}
{U^^"} {Ü} {u^^"} {ü}
{Y^^'} {Ý} {y^^'} {ý}
{Y^^"} {Ÿ} {y^^"} {ÿ}
{S^^z} {ß}
{P|} {Þ} {p|} {þ}
{~!} {¡} {~?} {¿}
{c^^/} {¢} {L^^-} {£} {Y^^-} {&Yen;} {o^^$} {¤}
{||} {¦}
{(c)} {©} {(r)} {®} {-tm} {™} {(tm)} {™}
{(C)} {©} {(R)} {®} {-TM} {™} {(TM)} {™}
{<<} {«} {>>} {»}
{-,} {¬}
{^^-} {¯} {^^o} {°} {^^o-} {º}
{ 1/4 } { ¼ } { 1/2 } { ½ } { 3/4 } { ¾ }
{''} {´}
{^^/u} {µ}
{P^^!} {¶}
{sO} {§}
{^^.} {·}
{,,} {¸}
{...} {…}
{ +- } {±}
{ * } {×}
{-:} {÷}
; { / } { ÷ } ; Slash is often used as a divider or alternative marker.
{A^^} {Â} {a^^} {â}
{E^^} {Ê} {e^^} {ê}
{I^^} {Î} {i^^} {î}
{O^^} {Ô} {o^^} {ô}
{U^^} {Û} {u^^} {û}
{ pi } {π}
{sqrt} {√} ; {<font face="symbol">Ö</font>}
"^^*" "☆"
"^^_" "&under;"
"^^~" "˜"
"^^`" "&backtick;"
"^^^^" "⁁"
][
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 " " " "
</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 " " " "
</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 " " " "
</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 " " " "
</a>
] MarkEnd
) :MarkEnd
]
|[
Mark: "---" MarkEnd: (
MarkEnd: change/part Mark {—} MarkEnd
) :MarkEnd
]
|[
Mark: "--" MarkEnd: (
MarkEnd: change/part Mark {–} 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 [
"•"
][
parse/case/all CharacterSubstitute Line [some Rules end]
foreach [Replacement Target][
"*" "☆"
"_" "&under;"
"~" "˜"
"`" "&backtick;"
"^^" "⁁"
][
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 " " " " ":"
'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][
"^-" " "
"<" "<"
"&" "&"
">" ">"
][
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
]
]
]
]
[2/3] from: d4marcus:dtek:chalmers:se at: 17-Mar-2001 14:18
On Fri, 16 Mar 2001, Andrew Martin wrote:
> Better would be:
> text: {
> Dear :Recipients,
> maybe you should :[mail Marcus "mail me"]
I'm not sure this is better. Mimicing Rebol get-word style isn't
necessarily an advantage either in this case. But I will try it out, and
will probably use some other eText constructs as well (but will take them
out of ther current context). I'm already using HTML.r (modified as well).
Marcus
------------------------------------
If you find that life spits on you
calm down and pretend it's raining
[3/3] from: d4marcus:dtek:chalmers:se at: 15-Mar-2001 22:54
As I was playing around with some webpage building scripts I'm currently
doing, I came up with something that I though could be useful to others as
well. Maybe something like this already exists - in any case feel free to
come up with improvements. As I'm going to use this myself I would be
grateful for any improvement.
REBOL [
Title: "String compose"
Date: 15-Mar-2001
Author: "Marcus Petersson"
File: %stringcompose.r
Version: 0.1
]
stringcompose!: make object! [
buffer: make block! 0
exec_start: "("
exec_end: ")"
rule: [any [rule_exec | rule_text]
copy string to end (append buffer string)]
rule_text: [copy string to exec_start
(append buffer string)]
rule_exec: [exec_start copy string to exec_end exec_end
(append buffer exec string)]
exec: func [series [series!]] [
if error? try [return do series] [
join exec_start [series exec_end]]]
set 'stringcompose func [
{Evaluates a string of expressions, only evaluating
executable parens, and returns a block.}
Text [String!]] [
clear buffer
parse/all Text rule
buffer]
]
; borrowed from Andrew Martin's HTML.r
ReString: func [Block [block!]] [
join "" reduce Block]
MailTo: func [eMail [email!] Link [string!] /Subject String [string!]] [
ReString [
join <a> [{ href=^"mailto:} eMail either Subject [
join "?subject=" String] [""] {^"}] Link </a>]]
; example
Marcus: [adress [d4marcus--dtek--chalmers--se]]
mail: func ['person string [any-type!]] [
mailto select get person 'adress either value? 'string [
string] [to-string person]]
recipients: "Rebol users"
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.}
print Restring stringcompose text
Marcus
------------------------------------
If you find that life spits on you
calm down and pretend it's raining