) | ['header1 | 'header1*] opts (emit-header 1 options options*) any inline-level (emit ) | ['header2 | 'header2*] opts (emit-header 2 options options*) any inline-level (emit ) | ['header3 | 'header3*] opts (emit-header 3 options options*) any inline-level (emit ) | 'header4 opts (emit-header 4 options options*) any inline-level (emit ) | 'header5 opts (emit-header 5 options options*) any inline-level (emit ) | 'header6 opts (emit-header 6 options options*) any inline-level (emit ) | 'bullets (emit
- ) any bullets (emit
- ) any enum-items (emit
- ) any checks (emit
)
opt [into ['title opts (emit [""]) any inline-level (emit )]]
(emit
})
]
] any block-level
|
'table opts (emit ["- )
any toc-headers
(emit {
}]) any block-level (emit
)
|
'left opts (emit [{}]) any block-level (emit
)
|
'right opts (emit [{}]) any block-level (emit
)
|
'justify opts (emit [{}]) any block-level (emit
)
|
'escape (emit {^/}) string! set val string! (emit [escape-html val]) to end | 'command copy val [string! skip] (emit [
"=" escape-html val/1] if val/2 [emit ["[" escape-html mold/only val/2 "]"]] emit
) ] | error ---The |emit| function and other local words -parse-rules-: emit: func [value] [ repend out value ] val: none emit-header: func [level style opts] [ emit ["| " " | " " | " " | " " | " " |
| " " | " " | |||
| " " | { | } ] parse box/contents box-rule emit [ | " " | |
| " " | " " | |||
| " " | " " | " " | " " | " " |
; needed for width: 100%; in table to work correctly
{}
]
]
; emit a box with a drop shadow
emit-shadow-box: func [box] [
emit [
{| { | } ] parse box/contents box-rule emit [ | |
| { | } ] parse box/contents box-rule emit [ | |
| { | } ] parse box/contents box-rule emit [ | |
}]
parse box/contents box-rule
emit
]
; end a box - emits it
emit-box: func [args style' contents' /local box] [
args: make context [
shadow: outline-style: width: position: float: none
] args
box: context [
contents: contents'
style: style'
shadow?: found? args/shadow
innerstyle: make-style/only extract-only args [
background image image-halign image-tiling color outline-color typeface fontsize
bold italic text-halign text-valign
]
; background here is a bad idea, really. we need to figure out a way to make proper rounded or shadowed boxes
; (it's very hard, I know...)
outerstyle: make-style/only extract-only args [width height float background position]
outerstyle100: make-style/only extract-only make args [width: $100] [width height float background position]
]
; emit correct type of box
if all [args/outline-style = 'rounded any [args/width args/position args/float]] [
emit-rounded-box box
exit
]
if args/outline-style = 'rounded [
emit-fw-rounded-box box
exit
]
if all [args/shadow any [args/width args/position args/float]] [
emit-shadow-box box
exit
]
if args/shadow [
emit-fw-shadow-box box
exit
]
emit-generic-box box
]
extract-only: func [object words /local res] [
object: third object
res: make block! length? object
foreach [word value] object [
if all [find words to word! word not none? :value] [
insert/only insert tail res word :value
]
]
res
]
---Inline level
-parse-rules-:
inline-level: [
-inline-level-rules-
]
---Other rules
-parse-rules-:
error: [here: skip (print ["error" copy/part trim/lines mold here 80])]
liclass: ""
bullets: [
into [
'item opts (
if in options* 'type [
options: join options [{ type="} pick ["disc" "circle" "square"] options*/type {"}]
]
emit [{}] ) any inline-level (emit
) ] [into ['bullets (emit- ) any bullets (emit
- ) any enum-items (emit
}]) any inline-level (emit
)] [into ['bullets (emit- ) any bullets (emit
- ) any enum-items (emit
} ]) any inline-level (emit {
}) ] | error ] definitions: [ ; one or more terms followed by one or more descriptions into ['term opts (emit [{- ) any toc-headers2 (emit {
- }) any toc-headers2 (emit {
- ) any toc-headers3 (emit {
- }) any toc-headers3 (emit {
}]
if in opts 'number [emit escape-html copy opts/number]
]
---Inline level rules
-inline-level-rules-:
;here: (print ["inline-level:" copy/part trim/lines mold here 80])
set val string! (emit escape-html val)
|
into [
'bold (emit ) any inline-level (emit )
|
'italic (emit ) any inline-level (emit )
|
'strike (emit ) any inline-level (emit )
|
'link opts (
if in options* 'target [
emit [{}
]
) any inline-level (emit )
|
'alink opts (
if in options* 'target [
; i'd prefer "anchor" to "internal" here...
emit [{}]
]
) any inline-level (emit )
|
'font opts (emit [{}]])
|
'anchor opts (if in options* 'name [emit [{}]]) any inline-level (emit )
|
'command copy val [string! skip] (emit ["=" escape-html val/1] if val/2 [emit ["[" escape-html mold/only val/2 "]"]])
]
|
error
---Table rule
-parse-rules-:
table-rule: [
(space: all [in options* 'force-space options*/force-space])
opt [into ['columns any [into ['column opts (emit ["