Scripts
AI
Animation
CGI
Compression
Console
Database
Debug
Dialects
Dialogs
Editor
Email
Encryption
Extension
External Library
File
File Handling
Files
Financial
FTP
Game
Games
Graphics
GUI
HTML
HTTP
Internet
LDC
Markup
Math
Module
Network
Networking
None
Other - Net
Parse
Patch
Printing
Protocol
Rebol
Scheme
Scientific
SDK
Security
Shell
Sound
SQL
TCP
Testing
Text
Text Processing
UI
User Interface
Util
Utility
VID
Visualization
Web
Win API
X-File
XML
Wiki
Rebol [
Title: "make-doc-pro"
Version: 1.0.8
Date: 13-Jan-2004
File: %make-doc-pro.r
Author: "Robert M. M"
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 ". 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
loop value/1 - counter [
; there could be a which must be removed too
if (back tail html) == [] [remove back tail html]
emit
]
; reuse counter to store value/1 as we are going to set value to something else below
counter: value/1
emit -
if flags/top == 'intable [emit ]
; now use the normal paragraph emitter without a paragraph-start and paragraph-end
; and emit the text
flags/push no-paragraph-end
flags/push no-paragraph-start
value: value/2
paragraph
if flags/top = 'intalbe [emit ]
emit
; close counter (a.k.a value/1) lists
loop counter [emit [
]]
; now there is one to much
remove back tail html
if flags/top == 'number-list-end [
flags/pop
emit
]
]
bullet-join: has [counter num-list] [
; do we have a numbered-list? This is the case if the last tag is a
either (back tail html) == [][num-list: true][num-list: false]
loop counter: value/1 [remove back tail html] ; delete value/1 times
(the first remove might be tag)
remove back tail html ; deletes
emit " "
; now use the normal paragraph emitter without a paragraph-start and paragraph-end
; and emit the text
flags/push no-paragraph-end
flags/push no-paragraph-start
value: value/2
paragraph
emit
; emit counter (a.k.a value/1) times
loop counter [emit ]
; replace closing tag with for numbered lists
if num-list [
remove back tail html
emit
]
]
define: does [
either site_mode
[
either flags/top == 'no-define-start
[flags/pop]
[emit ]
;now emit the definition word
emit [- any [escape-html value/1 " "]
]
;emit the definition text
emit -
; now use the normal paragraph emitter without a paragraph-start and paragraph-end
; and emit the text
flags/push no-paragraph-end
flags/push no-paragraph-start
; emit inline markup
value: value/2
paragraph
; and close definition
emit [
]
]
[
either flags/top == 'no-define-start
[flags/pop]
[emit [{}]]
;now emit the definition word
emit [ any [escape-html value/1 " "] ]
;emit the definition text
emit
; emit inline markup
value: value/2
paragraph
; and close definition
emit [
]
]
]
define-join: does [
"In normal mode, we use tables and need to reopen the table to add more defines"
if not site_mode [
remove back tail html ; deletes
remove back tail html ; deletes
]
]
epilog: does [
emit [ "[ " "back to top" " ]" ]
emit
emit html-copyright
emit [