Rebol [
Title: "make-doc-pro"
Version: 1.0.8
Date: 13-Jan-2004
File: %make-doc-pro.r
Author: "Robert M. Münch"
Email: robert.muench@robertmuench.de
Home: http://www.robertmuench.de/projects/mdp/
Copyright: {This parser can be freely used for non-commercial purposes.
For commercial use, you have to contact the author.
}
Purpose: {Parses the make-doc-pro markup language into a
datastructure that can be into other
document formats (such as HTML) with good titles, table
of contents, section headers, indented fixed-spaced
examples, bullets and definitons.
}
Category: [file markup text util 4]
Library: [
level: 'advanced
platform: 'all
type: [dialect tool]
domain: [dialects files html markup parse text text-processing web xml]
tested-under: [view 1.2.8 [W2K XP]]
support: "See Rebol header"
license: "See Rebol header"
]
Note: {Based on make-doc.r from Carl Sassenrath, Rebol Technologies Inc.}
]
; do %../rm_library.r
;{
;-- Library paste BEGIN
split: func ["Splits value" v [series!] rest [series!] /last] [
rest: either last [find/last v: copy v rest][find v: copy v rest]
if rest [clear rest] v
]
; Stack Datastructure Object
stack!: make object! [
stack: make block! []
push: func['value][
either (type? value) == block!
[insert/only stack value]
[insert stack value]
]
pop: does [
either (length? stack) > 0
[
value: first stack
remove stack
return value
]
[return none]
]
top: does [
if not empty? [return first stack]
]
empty?: does [
either (length? stack) == 0 [return true][return false]
]
ontop?: func ['value][
either value == top [return true][return false]
]
instack?: func ['value][
either result: find stack value [return index? result][return none]
]
reset: does [
clear stack
]
size: does [
return length? stack
]
debug: does [
foreach entry stack [probe entry]
]
; insert: func ['value][
; either (type? value) == block!
; [insert/only tail stack value]
; [insert tail stack value]
; ]
]
;--- Additional Functions
assert: func[ test [block!] text [string!]][
if not reduce test [
print reduce ["Asssert:" text "failed!"]
]
exit
]
pif: func [[throw] {polymorphic if, minimum checking, no default, compatible
with:
computed blocks,
Return
Exit
Break
non-logic conditions
}
args [block!]] [
if not unset? first args: do/next args [
either first args
[either block? first args: do/next second args
[do first args]
[first args]
]
[pif second do/next second args]
]
]
;-- Library paste END
;}
;-- global data
; debug_mode: true
debug_mode: false
; light_mode: true
; light_mode: false
;--- make-doc-pro parser
mdp-parser: context [
mdp-stack: make stack! [] ; storage to hold the mdp datastructure that will be the result of the parsing
inline-stack: make stack! [] ; storage to hold mdp inline markup block
active-stack: mdp-stack ; reference to active stack
skip-counter: 0 ; counter how many chars of the input stream have been skipped (should be 0)
rule-names: make stack! [] ; used to store rule-names for debugging
lastemitted: none ; stores the last emitted name
lastcode: none ; last parsed code
;--Flags
debugparse: true ; if true the mdp-parser will print debug messages
debugparse: false ; if true the mdp-parser will print debug messages
flags: make stack! [] ; stack of flags that are used to control the parser
;--MDP-Stack handling
emit: func ['name value /local tmp] [
; trim all obsolete spaces
if string? value [
if (back tail value) == " " [
trim/tail value
if value = "" [exit]
append value " "
]
]
; pack name value into a block
tmp: reduce to-block [name value]
; and push this as block onto the stack
active-stack/push :tmp
lastemitted: name
]
emit-section: func [num /local tmp] [tmp: to-word join "sect" num emit :tmp text]
;--Helper functions
init: does [
mdp-stack/reset
inline-stack/reset
active-stack/reset
rule-names/reset
flags/reset
lastcode: lastemitted: none
skip-counter: 0
; reset parse rule as this rule is altered after parsing the header
; titlerule: either light_mode [copy ["~~~"]][copy [opt "~~~"]]
titlerule: copy [opt "~~~"]
]
inputstream: func [width [integer!]][print ["###" mold copy/part mark width]]
; debug just pushes the rule-name onto the stack
; this function might be called many times more than debugo that pops a value from the stack
; therefore we first make a pop and then a push, the first pop will be on an empty stack but that's ok per definition: nothing will happen
debug: func ['rule-name][]
; debug: func ['rule-name][rule-names/pop rule-names/push rule-name]
; debug-out prints the rule-name; this indicates that the rule was called
debugo: func [value][]
; debugo: func [value][print reduce ["-->" rule-names/pop "--" mold value]]
insert-file: func [str file /local text] [
if file/1 = "%" [remove file]
; try to read the include file
pif [
exists? file [text: read file]
exists? join mdp-path file [text: read join mdp-path file]
true [alert reform ["Missing include file:" file] exit]
]
; insert the text from the include file up the end specifier or to the end
insert/part str text any [find text "^/###" tail text]
]
inline-parsing: func [text][
if none? text [exit]
lastemitted_tmp: lastemitted
active-stack: inline-stack
either debugparse
[
print ["Inline-Parsing:" text]
print ["Inline-Parsing correct:" parse/all text inlinemarkup]
]
[parse/all text inlinemarkup]
active-stack: mdp-stack
lastemitted: lastemitted_tmp
either debugparse
[reverse inline-stack/stack print ["Inline-Stack:" mold inline-stack/stack]]
[reverse inline-stack/stack]
]
;
;--make-doc-pro parsing rules
;
pdebug: [here: (prin "pdebug:" probe copy/part here 35)]
;Parsing storage variables
text: none ; stores parsed text sequences
para: none ; stores paragraph parts
;Charactersets
space: charset " ^-"
spaces: [any space]
nochar: charset " ^-^/"
chars: complement nochar
;Helper rules
line: [copy text to newline] ; copy the text from the actual stream position up to | or 'newline' (not including these chars) into 'text. The | is need because of table handling
paragraph:[copy para some [chars [to newline | to end]]]
word: [some space copy text some chars] ; skip spaces and copy all characters until the next whitespace
example: [copy code some [indented | some newline indented] (lastcode: copy code)]
indented: [some space chars to newline ]
; this rule is used to parse the first line of a document which is the title. The title can either
; be marked with ~~~ or nothing. A title starting with no markup is only allowed once in a document.
; This rule is changed to ["~~~"] after the title has been parsed by removing 'opt
titlerule: [opt "~~~"]
;--- Main rules
mdp: [
some [
;--Debug point
mark:
;--Title and End of document
titlerule (debug title) line (debugo text emit title text if (first titlerule) == 'opt [remove titlerule])
| "###" to end
;--Section Headers
| ["===" | "-1-"] line (emit-section 1)
| ["---" | "-2-"] line (emit-section 2)
| ["+++" | "-3-"] line (emit-section 3)
| ["..." | "-4-"] line (emit-section 4)
;--Special common notations:
| (debug define) define (
debugo text
inline-parsing text
; really a define or only the : character es first char in a line
either none? defword
[emit paragraph copy inline-stack/stack]
[ ; if there are several defines in a row, join them all in one table
if lastemitted == 'define [emit define-join none]
emit define reduce [defword copy inline-stack/stack]
]
inline-stack/reset
)
| "#" (debug numberitem) numberitem (debugo text
; parse inline markup chars
inline-parsing text
; and emit the parsed stack
emit number copy inline-stack/stack
; clear inline stack
inline-stack/reset
)
| (debug bulletitem) bulletitem (
debugo text
; remember numbered-bullets
if lastemitted == 'number [flags/push number-bullets]
; parse inline markup chars, this will handle tables as well, solution see below
inline-parsing text
; it could be that we entered this rule because the first character was a * but didn't introduced
; a bullet sequence but a bold sequence, this is the case if the length of bulles is 0
either (length? bullets) == 0
[emit paragraph copy inline-stack/stack]
[
; inline-stack could now contain a newcell or newrow command, which would be emitted as a bullet item
; resulting in a wrong output because the closing bullet markup would be emitted after the newcell/newrow
; markup. The following code handles this situation be spliting out the tablehandling code
; split stack newcell or newrow as this ends our bulletitem
newcell_split: split inline-stack/stack [[newcell #[none]]]
newrow_split: split inline-stack/stack [[newrow #[none]]]
; the shorter of both will be emitted as bullet
either (length? newcell_split) < (length? newrow_split)
[bullet_emit: newcell_split]
[bullet_emit: newrow_split]
either flags/top == 'number-bullets
[emit bullet reduce [(length? bullets) - 1 bullet_emit]]
[emit bullet reduce [length? bullets bullet_emit]]
; the rest will be emitted as paragraph
rest: exclude inline-stack/stack bullet_emit
if not empty? rest [emit paragraph rest]
]
; clear inline stack
inline-stack/reset
)
| ";" to newline ; comment
;--Translator options
| "=include" word here: (insert-file here to-file text)
| "=meta" word (emit meta text)
| (debug file) "=file" word (debugo text emit file text)
| "=toc" (debug TOC) to newline (debugo "" emit toc none)
| "=outline" (debug TOC) to newline (debugo "outline" emit toc 'outline)
| "=language" word
| "=options" some space some [
"faq"
| "debug" (debug_mode: true) ; (debug: debug_d debugo: debugo_d)
] to newline
;--Special output
| "=" copy bars some "-" (emit bar length? bars)
| "=image" image to newline
| "=url" some space [{"} copy url to {"} 1 skip | copy url some chars] copy text to newline (either text == none [emit url reduce [url form url]][emit url reduce [url trim text]])
| "=view" (
; we use first as the stack isn't reversed yet. So the newest emitted stuff comes first.
replace first mdp-stack/stack 'example 'view
)
;--Special sections:
| "\in" to newline (emit indent-in none)
| "/in" to newline (emit indent-out none)
| "\note" line (emit note-in text)
| "/note" to newline (emit note-out none)
| "\table" [some space "header" (emit table-in 'tableheader) | (emit table-in none)] to newline (
flags/push intable ; keep track of tablemode on stack
table: tablehandling) ; change table rule to handle table characters
| "/table" (
emit table-out none
if flags/pop <> 'intable [print "Flags-Stack not correct!"]
table: notablehandling) ; change table rule to emit normal table characters
;--Example Text
| (debug example) example (debugo code
; remove starting newlines
while [(first code) == newline] [remove code]
pif [
; header flag is pushed in newline rule below
flags/instack? header [emit example code]
true [emit header code]
]
)
;--Text
| (debug paragraph) paragraph (debugo para
; parse inline markup chars
inline-parsing para
pif [
lastemitted == 'bullet [emit bullet-join reduce [length? bullets copy inline-stack/stack] lastemitted: 'bullet]
lastemitted == 'number [emit number-join para lastemitted: 'number]
lastemitted == 'paragraph [emit paragraph-join none emit paragraph copy inline-stack/stack]
true [emit paragraph copy inline-stack/stack]
]
; clear inline stack
inline-stack/reset
)
;--Newline and join handling
| newline [some newline
; This is the section handling 'newline 'newline
; If nothing special is needed, we reset lastemitted to none, so the rest of the parser behaves
; in default mode (for example bullet emitting in rule 'TEXT will be reset to normal text output.
(
; remember that we did / should have emited a header already because the header text
; has to follow the newline character of the titleline
flags/push header
; if we reach this point do some clean-up work as 'newline 'newline is the termination sequence
; for bullet lists, numbered lists etc.
lastemitted: lastemitted_tmp: none
if flags/top == 'number-bullets [flags/pop]
)
|
; This is the section handling 'newline
(
pif [lastemitted == 'header [emit header-join none]]
)
]
; This rule will skip everything from the input stream that we couldn't handle yet with any other rule
| skiped: skip (print ["SKIP:" mold copy/part skiped 1] skip-counter: skip-counter + 1)
]
( ; cleanup stack
if find to-string mdp-stack/top "join" [
mdp-stack/pop
]
)
]
; Tricky rules: These rules have to handle all kind of special cases for the defineword because a defineword can contain
; the seperator character '-' as well. The trick is to use a break-rule to exit the any rule part in defineword and reset the
; input stream after the any rule. Than the defineseparator will be parsed again splitting the text into the two pieces
; defword and line that we need. (Thanks to Gabriele Santilli for this trick).
define: [definestart: ":" copy defword defineword defineseparator copy text definition]
definechars: complement charset " ^/"
defineseparator: [spaces "-" spaces | #"^/" (defword: none) :definestart]
defineword: [any
[ ; consume as much chars as possible
some definechars (break-rule: none)
[ ; if we have a defineseperator break-out -> defineseperator will be consumed in rule 'define
tmp: defineseparator (break-rule: [end skip])
| #" "
]
; execute break-rule that will exit this rule
break-rule
]
; reposition input stream to 'defineseperator position so this will be parsed
:tmp
]
definitionchars: complement charset "^/"
definitionseparator: ["^/:" | "^/^/"]
definition: [any [
; read as much chars as possible
some definitionchars (break-rule: none)
[
; if there is a definitionseperator found exit rule
tmp: definitionseparator (break-rule: [end skip])
| "^/"
]
break-rule
]
; reposition to 'definitionseperator for furthe parsing
:tmp
]
numberitem: [line]
bulletitem: [
boldstart: copy bullets some "*" opt [some boldchars] opt [ "*" ["^/" | "^-" | "|" | " " | "," | ";" | "." | "!" | "?"] (remove bullets)]
(boldstart: skip boldstart length? bullets)
:boldstart
line
]
;-- Inline markup character handling
parachars: complement charset "|~_-*=" ; ^/" ; |="
markupdelimiters: [[" " | "." | "," | ";" | "|" | "||" | newline | none]]
boldchars: complement charset "*|^/"
underlinechars: complement charset "_^/"
italicchars: complement charset "~^/"
strikechars: complement charset "-^/"
parapart: [copy inline_para some parachars]
tablehandling: [
(debug newrow) "||" (debugo none emit newrow none lastemitted_tmp: none) ; emit paragraph [[newrow ""]])
; This will handle empty cells at the begin of a line
| (debug newcell) "|" (debugo none emit newcell none lastemitted_tmp: none) ; emit paragraph [[newcell ""]])
]
notablehandling: ["|" (emit parapart "|")]
table: notablehandling
; mark: (mark: skip mark -1) :mark -> Move input cursor one char to front to check special chars
inlineprolog: [mark: (mark: skip mark -1) :mark markupdelimiters]
inlineepilog: [mark: (mark: skip mark -1) :mark chars]
inlineend: [mark: (if (length? mark) == 0 [insert markupdelimiters 'opt]) markupdelimiters (if (length? mark) == 0 [remove markupdelimiters]) :mark]
inlinemarkup: [
some [
(debug parapart) parapart (debugo inline_para emit parapart inline_para)
; Tricky rules:
; 1. we parse 'markupdelimiter AND inline markup character
; 2. Next we check for a char, a whitespace is not allowed as this would indicate that the markup char should be emitted
; 3. and reposition the input stream to get this char in the following copy sequence as well
; 4. we catch all characters that are not the inline markup character
; 5. we check for a char AND the closing inline markup character
; 6. we check if this closing inline markup character is followed by delimiter so that we can be sure it's not the inline character we should emit
| (debug bold) inlineprolog "*" mark: chars :mark copy boldtext some boldchars
[
; the if part is needed as the string could directly end with an inlinemerkup character
inlineepilog "*" inlineend (debugo none emit bold boldtext)
| newline (debugo none emit parapart rejoin ["*" boldtext])
]
| (debug italic) inlineprolog "~" mark: chars :mark copy italictext some italicchars
[
inlineepilog "~" inlineend (debugo none emit italic italictext)
| newline (debugo none emit parapart rejoin ["~" italictext])
]
| (debug strike) inlineprolog "-" mark: chars :mark copy striketext some strikechars
[
; if the inlinemarkup char is the last in the line we have to make the check for the markupdelimiters optional
; and reposition the input-sequence pointer
inlineepilog "-" inlineend (debugo none emit strike striketext)
| newline (debugo none emit parapart rejoin ["-" striketext])
]
| (debug underline) inlineprolog "_" mark: chars :mark copy underlinetext some underlinechars
[
inlineepilog "_" inlineend (debugo none emit underline underlinetext)
| newline (debugo none emit parapart rejoin ["_" underlinetext])
]
| (debug star) "*" (debugo none emit parapart "*")
| (debug snail) "~" (debugo none emit parapart "~")
| (debug minus) "-" (debugo none emit parapart "-")
| (debug under) "_" (debugo none emit parapart "_")
; --Special handling
| (debug image) "=image" image
| (debug url) "=url" some space [{"} copy url to {"} 1 skip | copy url some chars] copy text to "=" (either text == none [emit url reduce [url form url]][emit url reduce [url trim text]])
;--Table handling
| table
; This rule will skip everything from the input stream that we couldn't handle yet with any other rule
| skiped: skip (print ["Inline SKIP:" mold copy/part skiped 1] skip-counter: skip-counter + 1)
]
]
; check alignment
alignement: [
some space [
"left" (emit align 'left)
| "right" (emit align 'right)
| "center" (emit align 'center)
| "float" (emit paragraph-join none emit align 'float)
]
]
; handles images
image: [opt alignement some space copy text some chars (emit image to-file text)]
]
;--- HTML Emitter
; Character-Level Formatting
; -------------------------------------------------------------------##
html-format: context [
pos: marked: href: ""
ascii-charset: make bitset! #{
000000003B9EFFAFFEFFFFF7FFFFFF7F00000000000000000000000000000000
}
html-charset: make bitset! #{
FFFFFFFFC46100500100000800000080FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
}
special-charset: make bitset! #{
0004000000610000000000080000000000000000000000000000000000000000
}
space: make bitset! #{
0002000001000000000000000000000000000000010000000000000000000000
}
html-map: [
34 #quot 38 #amp 60 #lt 62 #gt
64 ##064 128 #euro ##8364 130 ##8218 131 ##402 132 ##8222 133 ##8230 134 ##8224 135 ##8225 136 ##710
137 ##8240 138 ##352 139 ##8249 140 ##338 145 ##8216 146 ##8217 147 ##8220
148 ##8221 149 ##8226 150 ##8211 151 ##8212 152 ##732 153 ##8482 154 ##353
155 ##8250 156 ##339 159 ##376 160 #nbsp 161 #iexcl 162 #cent 163 #pound
164 #curren 165 #yen 166 #brvbar 167 #sect 168 #uml 169 #copy 170 #ordf
171 #laquo 172 #not 173 #shy 174 #reg 175 #macr 176 #deg 177 #plusmn 178 #sup2
179 #sup3 180 #acute 181 #micro 182 #para 183 #middot 184 #cedil 185 #sup1
186 #ordm 187 #raquo 188 #frac14 189 #frac12 190 #frac34 191 #iquest
192 #Agrave 193 #Aacute 194 #Acirc 195 #Atilde 196 #Auml 197 #Aring
198 #AElig 199 #Ccedil 200 #Egrave 201 #Eacute 202 #Ecirc 203 #Euml
204 #Igrave 205 #Iacute 206 #Icirc 207 #Iuml 208 #ETH 209 #Ntilde
210 #Ograve 211 #Oacute 212 #Ocirc 213 #Otilde 214 #Ouml 215 #times
216 #Oslash 217 #Ugrave 218 #Uacute 219 #Ucirc 220 #Uuml 221 #Yacute
222 #THORN 223 #szlig 224 #agrave 225 #aacute 226 #acirc 227 #atilde
228 #auml 229 #aring 230 #aelig 231 #ccedil 232 #egrave 233 #eacute
234 #ecirc 235 #euml 236 #igrave 237 #iacute 238 #icirc 239 #iuml 240 #eth
241 #ntilde 242 #ograve 243 #oacute 244 #ocirc 245 #otilde 246 #ouml
247 #divide 248 #oslash 249 #ugrave 250 #uacute 251 #ucirc 252 #uuml
253 #yacute 254 #thorn 255 #yuml
]
to-entity: func [ent [string! issue!]][return rejoin ["&" ent ";"]]
to-encode: func [doc /local old new ent][
old: doc/1
new: switch/default to-integer old [
34 [to-entity either any [head? doc doc/-1 = #" " doc/-1 = #"^(A0)" doc/-1 = #"^/"][##8220][##8221]]
39 [to-entity either any [head? doc doc/-1 = #" " doc/-1 = #"^(A0)" doc/-1 = #"^/"][##8216][##8217]]
][
either ent: select html-map to-integer old [to-entity ent]["?"]
]
change/part doc new length? to-string old
]
to-pre: func [doc /local old new ent][
old: doc/1
new: either ent: select html-map to-integer old [to-entity ent]["?"]
change/part doc new 1
]
regular-rule: [
any [
some ascii-charset |
#"&" ["amp" | "copy" | "nbsp" | "quot" | "gt" | "lt"] #";" |
#"<" opt "/" pos: [
"em" | "strong" | "code" | "br /" |
"br/" (change/part pos "br /" 3) :pos "br /" |
"br" (change/part pos "br /" 2) :pos "br /" |
"b" (change/part pos "strong" 1) :pos "strong" |
"i" (change/part pos "em" 1) :pos "em"
] #">" |
#"." pos: [
2 space (change/part pos " " 2) skip |
#"." #"." (change/part back pos "… " 3)
] |
#"(" pos: [
"c)" (change/part back pos "©" 3) |
"r)" (change/part back pos "®" 3) |
"o)" (change/part back pos "°" 3) |
"tm)" (change/part back pos "™" 4) |
"br)" (change/part back pos
4) :pos 5 skip |
"e)" (change/part back pos "€" 3)
] |
#"-" pos: #"-" (change/part back pos "—" 2) |
#"[" pos: [
"TM]" (change/part back pos "™" 4) |
"break]" (change/part back pos "
" 7) :pos 5 skip
] |
special-charset | #"^/" |
html-charset pos: (to-encode back pos) :pos
]
]
pre-rule: [
any [
some ascii-charset |
#"^/" pos: (change/part back pos
1) 5 skip |
#"'" | special-charset |
html-charset pos: (to-pre back pos) :pos
]
]
url-rule: [
"[url " copy href to #"]" #"]" copy marked to "[/url]"
(
replace pos rejoin ["[url " href "]" marked "[/url]"] rejoin [
{} marked
]
)
]
bold-rule: [
"[b]" copy marked to "[/b]"
(replace pos rejoin ["[b]" marked "[/b]"] rejoin ["" marked ])
]
italic-rule: [
"[i]" copy marked to "[/i]"
(replace pos rejoin ["[i]" marked "[/i]"] rejoin ["" marked ])
]
markup-rule: [
some [pos: to #"[" [url-rule | bold-rule | italic-rule | #"[" pos:]]
to end
]
set 'escape-html func [text /tags][
; pos: doc
; parse/all pos either tags [pre-rule][regular-rule]
if any [word? text none? text empty? text] [return text]
if not tags [parse/all text markup-rule] ; trim/lines text]
text
]
]
html-emitter: context [
html: []
flags: make stack! []
alignment: none ; used to temporarly store an alignment hint
name: none ; these two hold the current item (name/value) of the parsed mdp-stack
value: none
path: none ; used for site_mode
sects: [0 0 0 0] ; this is the counter for our 4 level sections
toc-title: "Contents" ; text to use for TOC
img-num: 0 ; counter for generated images
;--Helper functions
init: does [
clear html
flags/reset
alignment: name: value: none
img-num: 0
clear-sects ; sects: [0 0 0 0]
]
nsp: "^/ " ; nsp = newline-space
html-codes: [
"&" "&"
"<" "<"
">" ">"
{"} """
"Á" "Á"
"á" "á"
"À" "À"
"à" "à"
"Â" "Â"
"â" "â"
"Ä" "Ä"
"ä" "ä"
"Ã" "Ã"
"ã" "ã"
"Å" "Å"
"å" "å"
"Æ" "Æ"
"æ" "æ"
"Ç" "Ç"
"ç" "ç"
"Ð" "Ð"
"ð" "ð"
"É" "É"
"é" "é"
"È" "È"
"è" "è"
"Ê" "Ê"
"ê" "ê"
"Ë" "Ë"
"ë" "ë"
"Í" "Í"
"í" "í"
"Ì" "Ì"
"ì" "ì"
"Î" "Î"
"î" "î"
"Ï" "Ï"
"ï" "ï"
"Ñ" "Ñ"
"ñ" "ñ"
"Ó" "Ó"
"ó" "ó"
"Ò" "Ò"
"ò" "ò"
"Ô" "Ô"
"ô" "ô"
"Ö" "Ö"
"ö" "ö"
"Õ" "Õ"
"õ" "õ"
"Ø" "Ø"
"ø" "ø"
"ß" "ß"
"Þ" "Þ"
"þ" "þ"
"Ú" "Ú"
"ú" "ú"
"Ù" "Ù"
"ù" "ù"
"Û" "Û"
"û" "û"
"Ü" "Ü"
"ü" "ü"
"Ý" "Ý"
"ý" "ý"
"ÿ" "ÿ"
]
comment {
escape-html: func [text][
if any [word? text none? text empty? text] [return text]
foreach [from to] html-codes [replace/all/case text from to]
return text
]
}
emit: func [data] [append html reduce data]
; Reset all section counter to 0
clear-sects: does [change/dup sects 0 4]
; Increase section counters, create section counter string and return this string
sect-num?: func [num /local n sn] [
; increase section counter at num place by 1
change at sects num n: sects/:num + 1
; reset all section counters behind 'num to 0
change/dup at sects num + 1 0 4 - num
; initialize local variable
sn: copy ""
; append num times the section counter to form a w.x.y.z number
repeat n num [append sn join sects/:n "."]
; remove trailing point
remove back tail sn
; return the created number
copy sn
]
;--- Predefined HTML emitter objects
html-copyright: [
; -- add your footer information stuff below --
; ---add your footer information stuff above --
"Document formatter copyright " "Robert M. Münch" ". All Rights Reserved."
"XHTML 1.0 Transitional formatted with Make-Doc-Pro Version:" system/script/header/version " on " now/date " at " now/time
]
stylesheets: [
"@media screen {"
"h1,h2,h3,h4,h5,p,a,br,li,td, .underline {font-family:Arial, Helvetica, sans-serif;text-align:justify}"
"hr {text-align:center}"
"p,table {margin-left: 10px;margin-right:10px}"
".defword {white-space:nowrap}"
".deftable {border-style:none;vertical-align:top}"
".deftablefaq {border-style:solid;border-width:thin}"
".end {font-size:8pt}"
".example {margin-left:50px;margin-right:50px;border:2px solid;padding: 10px;background-color:#EEEEEE}"
".header {margin-left:50px;margin-right:50px;border:2px solid;padding: 10px;background-color:yellow}"
".indented {margin-left: 50px}"
".litable {text-align:left}"
".new {border-right: 10px solid; padding-right: 10px; font-family:Arial}"
".note {margin-left:50px;margin-right:50px;border:2px solid;padding: 10px;background-color:#F0F0D0}"
".tocindent {margin-left: 20px}"
".top {font-size:8pt;text-align:right}"
".underline {text-decoration:underline}"
"}"
"@media print {"
"h1,h2,h3,h4,h5,p,a,br,li, #underline {font-family:Arial;text-align:justify;orphans:5;widows:5}"
"p,li,td {font-size:10pt}"
"ul,ol {page-break-after:avoid;orphans:5;widows:5}"
"}"
]
;--HTML code generation functions (sorted alphaticaly)
align: does [alignment: value]
bar: does [emit [{
}]]
bullet: has [counter][
counter: 0
; is this a numbered list?
if (back tail html) == [] [remove back tail html flags/push number-list-end]
; how far do we need to go back in the hierarchy?
until [
counter: counter - 1
(pick tail html counter) <>
]
; add one and make positiv
counter: (counter + 1) * -1
; first remove as few as possible
loop min counter value/1 [remove back tail html] ; deletes counter times
; if necessary add a new | any [escape-html value/1 " "] | ] ;emit the definition text emit; emit inline markup value: value/2 paragraph ; and close definition emit [ |