Contents:

Warning

This documentation is incomplete. It will be finished as soon as possible.

1. Introduction

2. Overview

Overview

xhtml-emitter: context [
 out: none
 
 The parse rules that generate the document
 
 generate: func [qml-doc [block!]] [
  out: make string! 1024
  parse qml-doc qml-rule
  out
 ]
]

3. The parse rules that generate the document

The parse rules that generate the document

qml-rule: ['qml some block-level]
block-level: [
 Block level rules
]

3.1 Block level rules

Block level rules

;here: (print ["block-level:" copy/part trim/lines mold here 80])
into [
 'para opts (emit ["<p" options ">"]) [some inline-level | (emit "&nbsp;")] (emit </p>)
 |
 'hrule to end (emit <hr />)
 |
 ['header1 | 'header1*] opts (emit-header 1 options options*) any inline-level (emit </h1>)
 |
 ['header2 | 'header2*] opts (emit-header 2 options options*) any inline-level (emit </h2>)
 |
 ['header3 | 'header3*] opts (emit-header 3 options options*) any inline-level (emit </h3>)
 |
 'header4 opts (emit-header 4 options options*) any inline-level (emit </h4>)
 |
 'header5 opts (emit-header 5 options options*) any inline-level (emit </h5>)
 |
 'header6 opts (emit-header 6 options options*) any inline-level (emit </h6>)
 |
 'bullets (emit <ul>) any bullets (emit </ul>)
 |
 'enum (emit <ol>) any enum-items (emit </ol>)
 |
 'checks (emit <ul class="checks">) any checks (emit </ul>)
 |
 'definitions (emit {<table class="dlist"><tbody>}) any definitions (emit "</tbody></table>")
 |
 'box opts val: to end (emit-box options* options val)
 |
 'section opt [
  into [
   'toc
   (emit <div class="toc">)
   opt [into ['title opts (emit ["<h1" options ">"]) any inline-level (emit </h1>)]]
   (emit <ul>)
   any toc-headers
   (emit "</ul></div>")
  ]
 ] any block-level
 |
 'table opts (emit ["<table" options ">"]) table-rule (emit </table>)
 |
 'center opts (emit [{<div style="text-align: center;"} options ">"]) any block-level (emit </div>)
 |
 'left opts (emit [{<div style="text-align: left;"} options ">"]) any block-level (emit </div>)
 |
 'right opts (emit [{<div style="text-align: right;"} options ">"]) any block-level (emit </div>)
 |
 'justify opts (emit [{<div style="text-align: justify;"} options ">"]) any block-level (emit </div>)
 |
 'escape (emit "<pre>^/") string! set val string! (emit [escape-html val </pre>]) to end
 |
 'command copy val [string! skip] (emit [<p> "=" escape-html val/1] if val/2 [emit ["[" escape-html mold/only val/2 "]"]] emit </p>)
]
|
error

3.2 The emit function and other local words

The parse rules that generate the document +≡

emit: func [value] [
 repend out value
]
val: none
emit-header: func [level style opts] [
 emit ["<h" level style]
 if in opts 'id [emit [{ id="header-} opts/id {"}]]
 emit ">"
 if in opts 'number [emit escape-html copy opts/number]
]

3.3 Options processing

The parse rules that generate the document +≡

opts: [
 'opts set val block! (options: make-style val) | (options: "" options*: context [ ])
]
options: none
options*: none
make-style: func [opts /only /local res] [
 if empty? opts [options*: context [ ] return ""]
 either only [
  opts: construct opts
 ] [
  opts: options*: make construct/with opts context [
   outline-color: outline-style: image-halign: image-valign: float: position: none
  ] [
   outline-color: any [outline-color if outline-style [/black]]
   outline-style: any [outline-style if outline-color ['solid]]
   ; if rounded style, no outline color is allowed
   if outline-style = 'rounded [outline-color: none]
   image-halign: any [image-halign if image-valign ['left]]
   image-valign: any [image-valign if image-halign ['top]]
   if float [
    float: either position = 'left ['left] ['right]
    position: none
   ]
  ]
 ]
 res: append make string! 128 { style="}
 bind opts-to-css in opts 'self
 foreach [word css] opts-to-css [
  if all [word: in opts word word: get word] [
   append res switch type?/word :css [
    block! [rejoin css]
    paren! [do css]
    string! [css]
   ]
  ]
 ]
 append res {"}
 either res = { style=""} [""] [res]
]
opts-to-css: [
 Option to CSS conversion rules
]

3.3.1 Option to CSS conversion rules

Option to CSS conversion rules

background ["background-color: " to-css-color background ";"]
bold "font-weight: bold;"
color ["color: " to-css-color color ";"]
float ["float: " float ";"]
fontsize ["font-size: " fontsize "pt;"]
height ["height: " either money? height [to integer! second height] [height] either money? height ["%"] ["px"] ";"]
image ["background-image: url('" escape-html replace/all image "'" "" "');"]
image-halign ["background-position: " image-valign " " image-halign ";"]
image-tiling [
 "background-repeat: " select [
  both "repeat" vertical "repeat-y" horizontal "repeat-x" neither "no-repeat"
 ] image-tiling ";"
]
indent ["margin-left: " 48 * indent "pt;"]
italic "font-style: italic;"
outline-color (
 either outline-style = 'borderless [
  "border: none;"
 ] [
  rejoin ["border: " outline-style " thin " to-css-color outline-color ";"]
 ]
)
position (select [
 center {margin-left: auto;margin-right: auto;display: table;}
 left "margin-right: auto;display: table;"
 right "margin-left: auto;display: table;"
] position)
space ["padding: 0 " either logic? space ["1ex;"] [rejoin [space "px;"]]]
text-halign ["text-align: " text-halign ";"]
text-valign ["vertical-align: " text-valign ";"]
typeface ["font-family: " to-fontface typeface ";"]
width ["width: " either money? width [to integer! second width] [width] either money? width ["%"] ["px"] ";"]

3.3.2 Helper functions

The parse rules that generate the document +≡

; color names not available in CSS (http://www.w3.org/TR/CSS21/syndata.html#color-units)
non-css-colors: [
 /AliceBlue "#F0F8FF" /AntiqueWhite "#FAEBD7" /Aquamarine "#7FFFD4"
 /Azure "#F0FFFF" /Beige "#F5F5DC" /Bisque "#FFE4C4"
 /BlanchedAlmond "#FFEBCD" /BlueViolet "#8A2BE2" /Brown "#A52A2A"
 /BurlyWood "#DEB887" /CadetBlue "#5F9EA0" /Chartreuse "#7FFF00"
 /Chocolate "#D2691E" /Coral "#FF7F50" /CornflowerBlue "#6495ED"
 /Cornsilk "#FFF8DC" /Crimson "#DC143C" /Cyan "#00FFFF"
 /DarkBlue "#00008B" /DarkCyan "#008B8B" /DarkGoldenRod "#B8860B"
 /DarkGray "#A9A9A9" /DarkGreen "#006400" /DarkKhaki "#BDB76B"
 /DarkMagenta "#8B008B" /DarkOliveGreen "#556B2F" /Darkorange "#FF8C00"
 /DarkOrchid "#9932CC" /DarkRed "#8B0000" /DarkSalmon "#E9967A"
 /DarkSeaGreen "#8FBC8F" /DarkSlateBlue "#483D8B" /DarkSlateGray "#2F4F4F"
 /DarkTurquoise "#00CED1" /DarkViolet "#9400D3" /DeepPink "#FF1493"
 /DeepSkyBlue "#00BFFF" /DimGray "#696969" /DodgerBlue "#1E90FF"
 /Feldspar "#D19275" /FireBrick "#B22222" /FloralWhite "#FFFAF0"
 /ForestGreen "#228B22" /Gainsboro "#DCDCDC" /GhostWhite "#F8F8FF"
 /Gold "#FFD700" /GoldenRod "#DAA520" /GreenYellow "#ADFF2F"
 /HoneyDew "#F0FFF0" /HotPink "#FF69B4" /IndianRed "#CD5C5C"
 /Indigo "#4B0082" /Ivory "#FFFFF0" /Khaki "#F0E68C"
 /Lavender "#E6E6FA" /LavenderBlush "#FFF0F5" /LawnGreen "#7CFC00"
 /LemonChiffon "#FFFACD" /LightBlue "#ADD8E6" /LightCoral "#F08080"
 /LightCyan "#E0FFFF" /LightGoldenRodYellow "#FAFAD2" /LightGrey "#D3D3D3"
 /LightGreen "#90EE90" /LightPink "#FFB6C1" /LightSalmon "#FFA07A"
 /LightSeaGreen "#20B2AA" /LightSkyBlue "#87CEFA" /LightSlateBlue "#8470FF"
 /LightSlateGray "#778899" /LightSteelBlue "#B0C4DE" /LightYellow "#FFFFE0"
 /LimeGreen "#32CD32" /Linen "#FAF0E6" /Magenta "#FF00FF"
 /MediumAquaMarine "#66CDAA" /MediumBlue "#0000CD" /MediumOrchid "#BA55D3"
 /MediumPurple "#9370D8" /MediumSeaGreen "#3CB371" /MediumSlateBlue "#7B68EE"
 /MediumSpringGreen "#00FA9A" /MediumTurquoise "#48D1CC" /MediumVioletRed "#C71585"
 /MidnightBlue "#191970" /MintCream "#F5FFFA" /MistyRose "#FFE4E1"
 /Moccasin "#FFE4B5" /NavajoWhite "#FFDEAD" /OldLace "#FDF5E6"
 /OliveDrab "#6B8E23" /OrangeRed "#FF4500" /Orchid "#DA70D6"
 /PaleGoldenRod "#EEE8AA" /PaleGreen "#98FB98" /PaleTurquoise "#AFEEEE"
 /PaleVioletRed "#D87093" /PapayaWhip "#FFEFD5" /PeachPuff "#FFDAB9"
 /Peru "#CD853F" /Pink "#FFC0CB" /Plum "#DDA0DD"
 /PowderBlue "#B0E0E6" /RosyBrown "#BC8F8F" /RoyalBlue "#4169E1"
 /SaddleBrown "#8B4513" /Salmon "#FA8072" /SandyBrown "#F4A460"
 /SeaGreen "#2E8B57" /SeaShell "#FFF5EE" /Sienna "#A0522D"
 /SkyBlue "#87CEEB" /SlateBlue "#6A5ACD" /SlateGray "#708090"
 /Snow "#FFFAFA" /SpringGreen "#00FF7F" /SteelBlue "#4682B4"
 /Tan "#D2B48C" /Thistle "#D8BFD8" /Tomato "#FF6347"
 /Turquoise "#40E0D0" /Violet "#EE82EE" /VioletRed "#D02090"
 /Wheat "#F5DEB3" /WhiteSmoke "#F5F5F5" /YellowGreen "#9ACD32"
]
; color! (issue!, refinement! or tuple!) to CSS color
to-css-color: func [val] [
 switch type?/word val [
  issue! [mold val]
  refinement! [any [select non-css-colors val form val]]
  tuple! [rejoin ["#" enbase/base to binary! val 16]]
 ]
]
; convert a font face specification to CSS
to-fontface: func [val] [
 switch/default val [
  times ["Times New Roman, serif"]
  helvetica ["Arial, Helvetica, sans-serif"]
  courier ["Courier New, Courier, fixed"]
 ] [
  escape-html replace/all val ";" ""
 ]
]

3.4 Generating boxes

The parse rules that generate the document +≡

box-rule: [
 opt [into ['title opts (emit ["<h2" options ">"]) any inline-level (emit </h2>)]]
 any block-level
]
; emit a box with rounded corners
emit-rounded-box: func [box] [
 emit [
  {<table class="} either box/shadow? ["roundshadow"] ["rounded"] {"} box/outerstyle ">"
   <tr>
    <td class="topleft">"&nbsp;"</td>
    <td class="topleftplus">"&nbsp;"</td>
    <td class="top">"&nbsp;"</td>
    <td class="toprightminus">"&nbsp;"</td>
    <td class="topright">"&nbsp;"</td>
   </tr><tr>
    <td class="topleftminus">"&nbsp;"</td>
    <td></td><td></td><td></td>
    <td class="toprightplus">"&nbsp;"</td>
   </tr><tr>
    <td class="left">"&nbsp;"</td>
    <td></td>
    {<td class="box"} box/innerstyle ">"
 ]
 parse box/contents box-rule
 emit [
     </td>
    <td></td>
    <td class="right">"&nbsp;"</td>
   </tr><tr>
    <td class="bottomleftplus">"&nbsp;"</td>
    <td></td><td></td><td></td>
    <td class="bottomrightminus">"&nbsp;"</td>
   </tr><tr>
    <td class="bottomleft">"&nbsp;"</td>
    <td class="bottomleftminus">"&nbsp;"</td>
    <td class="bottom">"&nbsp;"</td>
    <td class="bottomrightplus">"&nbsp;"</td>
    <td class="bottomright">"&nbsp;"</td>
   </tr>
  </table>
 ]
]
; emit a full-width box with rounded corners
emit-fw-rounded-box: func [box] [
 ; outer style does not need to be specified, since we already know that
 ; it is not positioned, nor floated, nor has a given width or height
 ; update: Ammon's hack actually requires the background to be set for the
 ; outer box too; I still think this needs a proper solution
 emit [
  <div class="boxouter"> ; needed for width: 100%; in table to work correctly
  {<table class="} either box/shadow? ["roundshadow"] ["rounded"] {"} box/outerstyle100 ">"
  <tr><td class="topleft"></td><td class="top"></td><td class="topright"></td></tr>
  <tr><td class="left"></td> {<td class="box"} box/innerstyle ">"
 ]
 parse box/contents box-rule
 emit [
  </td><td class="right"></td></tr>
  <tr><td class="bottomleft"></td><td class="bottom"></td><td class="bottomright"></td></tr>
  </table></div>
 ]
]
; emit a box with a drop shadow
emit-shadow-box: func [box] [
 emit [
  {<table class="shadow"} box/outerstyle ">"
  <tr><td class="topleft"></td><td class="top"></td><td class="topright"></td></tr>
  <tr><td class="left"></td> {<td class="box"} box/innerstyle ">"
 ]
 parse box/contents box-rule
 emit [
   </td><td class="right"></td></tr>
  <tr><td class="bottomleft"></td><td class="bottom"></td>
   <td class="bottomright"></td></tr>
  </table>
 ]
]
; emit full-width box with drop shadow
emit-fw-shadow-box: func [box] [
 emit [
  {<div class="boxouter"><table class="shadow"} box/outerstyle100 ">"
  <tr><td class="topleft"></td><td class="top"></td><td class="topright"></td></tr>
  <tr><td class="left"></td> {<td class="box"} box/innerstyle ">"
 ]
 parse box/contents box-rule
 emit [
  </td><td class="right"></td></tr>
  <tr><td class="bottomleft"></td><td class="bottom"></td>
   <td class="bottomright"></td></tr>
  </table></div>
 ]
]
; emit a generic box
emit-generic-box: func [box] [
 emit [{<div class="box"} box/style ">"]
 parse box/contents box-rule
 emit </div>
]
; 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.00] [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
]

3.5 Inline level

The parse rules that generate the document +≡

inline-level: [
 Inline level rules
]

3.6 Other rules

The parse rules that generate the document +≡

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 ["<li" liclass options "><p>"]
  ) any inline-level (emit </p>)
 ]
 [into ['bullets (emit <ul>) any bullets (emit </ul>)] | into ['enum (emit <ol>) any enum-items (emit </ol>)] | none]
 (emit </li>)
 |
 into ['bullets (liclass: { class="indented"}) any bullets (liclass: "")]
 |
 into ['enum (liclass: { class="indented"}) any enum-items (liclass: "")]
 |
 error
]
enum-items: [
 into ['item opts (emit [{<li value="} options*/number {"} liclass options "><p>"]) any inline-level (emit </p>)]
 [into ['bullets (emit <ul>) any bullets (emit </ul>)] | into ['enum (emit <ol>) any enum-items (emit </ol>)] | none]
 (emit </li>)
 |
 into ['bullets (liclass: { class="indented"}) any bullets (liclass: "")]
 |
 into ['enum (liclass: { class="indented"}) any enum-items (liclass: "")]
 |
 error
]
checks: [
 into [
  'check opts
  (emit [
   "<li" options {><p><input type="checkbox" disabled="yes"}
   either options*/checked [{ checked="yes"}] [""]
   " /> "
  ]) any inline-level (emit "</p></li>")
 ]
 |
 error
]
definitions: [
 ; one or more terms followed by one or more descriptions
 into ['term opts (emit ["<tr><th" options ">"]) any inline-level (emit </th>)]
 any [into ['term opts (emit ["</tr><tr><th" options ">"]) any inline-level (emit </th>)]]
 into ['desc opts (emit ["<td" options ">"]) any inline-level (emit "</td></tr>")]
 any [into ['desc opts (emit ["<tr><td></td><td" options ">"]) any inline-level (emit "</td></tr>")]]
 |
 error
]
toc-headers: [
 into ['header1 opts (emit-toclink options options*) any inline-level (emit "</a></p>")] [
  val: into ['header2 to end | 'header3 to end] :val (emit <ul>) any toc-headers2 (emit "</ul></li>")
  |
  (emit </li>)
 ]
 |
 val: into ['header2 to end | 'header3 to end] :val (emit "<li><ul>") any toc-headers2 (emit "</ul></li>")
]
toc-headers2: [
 into ['header2 opts (emit-toclink options options*) any inline-level (emit "</a></p>")] [
  val: into ['header3 to end] :val (emit <ul>) any toc-headers3 (emit "</ul></li>")
  |
  (emit </li>)
 ]
 |
 val: into ['header3 to end] :val (emit "<li><ul>") any toc-headers3 (emit "</ul></li>")
]
toc-headers3: [
 into ['header3 opts (emit-toclink options options*) any inline-level (emit "</a></p></li>")]
]
emit-toclink: func [style opts] [
 emit ["<li" style {><p><a href="#header-} opts/id {">}]
 if in opts 'number [emit escape-html copy opts/number]
]

3.7 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 <strong>) any inline-level (emit </strong>)
 |
 'italic (emit <em>) any inline-level (emit </em>)
 |
 'strike (emit <s>) any inline-level (emit </s>)
 |
 'link opts (
  if in options* 'target [
   emit [{<a href="} escape-html options*/target {"} options]
   if in options* 'class [
    emit [{ class="} options*/class {"}]
    ; don't like this much...
    if options*/class = "external" [
     emit { target="_blank"}
    ]
   ]
   emit ">"
  ]
 ) any inline-level (emit </a>)
 |
 'alink opts (
  if in options* 'target [
   ; i'd prefer "anchor" to "internal" here...
   emit [{<a href="#} escape-html options*/target {"} options { class="internal">}]
  ]
 ) any inline-level (emit </a>)
 |
 'font opts (emit ["<span" options ">"]) any inline-level (emit </span>)
 |
 'image opts (if in options* 'src [emit [{<img src="} escape-html options*/src {"} options ">"]])
 |
 'anchor opts (if in options* 'name [emit [{<a name="} escape-html options*/name {"} options ">"]]) any inline-level (emit </a>)
 |
 'command copy val [string! skip] (emit ["=" escape-html val/1] if val/2 [emit ["[" escape-html mold/only val/2 "]"]])
]
|
error

3.8 Table rule

The parse rules that generate the document +≡

table-rule: [
 (space: all [in options* 'force-space options*/force-space])
 opt [into ['columns any [into ['column opts (emit ["<col" options ">"])]]]]
 (emit <tbody>)
 any [
  into [
   'row opts opt 'header (emit ["<tr" options ">"])
   any [
    into [
     'cell (td: "td")
     opts
     ['span set val pair! (span: rejoin [{ rowspan="} val/y {" colspan="} val/x {"}]) | (span: "")]
     opt ['header (td: "th")]
     (emit ["<" td options span ">"]) [some block-level | end (if space [emit "&nbsp;"])] (emit </td>)
    ]
    |
    error
   ]
   (emit </tr>)
  ]
  |
  error
 ]
 (emit </tbody>)
]
td: "td" span: "" space: none

3.9 The escape-html function

The parse rules that generate the document +≡

; simple version - should probably be improved
escape-html: func [text [string! url!]] [
 ; Convert to avoid special HTML chars:
 foreach [from to] html-codes [replace/all text from to]
 text
]
html-codes: ["&" "&amp;" "<" "&lt;" ">" "&gt;" {"} "&quot;"]