REBOL [
    Library: [
        level: 'advanced
        platform: 'all
        type: [function module]
        domain: [html markup text text-processing]
        tested-under: none
        support: none
        license: 'mit
        see-also: none
        ]
    Title: {Qtask Markup Language - parser and other common code}
    File: %qml-base.r
    Purpose: {
        This program implements the base for QML (Qtask Markup Language) converters (for example
        it's the base for a QML to XHTML converter used in Qtask), by implementing the parsing
        of a QML text string into a QML document tree.
    }
    Author: "Gabriele Santilli"
    EMail: giesse@rebol.it
    License: {
        Copyright (c) 2006-2007 Prolific Publishing, Inc.

        Permission is hereby granted, free of charge, to any person obtaining a
        copy of this software and associated documentation files (the
        "Software"), to deal in the Software without restriction, including
        without limitation the rights to use, copy, modify, merge, publish,
        distribute, sublicense, and/or sell copies of the Software, and to
        permit persons to whom the Software is furnished to do so, subject to
        the following conditions:

        The above copyright notice and this permission notice shall be included
        in all copies or substantial portions of the Software.

        THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
        OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
        MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
        IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
        CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
        TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
        SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    }
    Date: 6-Apr-2007
    Version: 2.46.1
    History: [
        16-Feb-2006 1.1.0 "History start" 
        16-Feb-2006 1.2.0 "Fixed a bug with escape command parsing" 
        20-Feb-2006 1.3.0 "Moved options parsing from emitters to here" 
        13-Mar-2006 1.4.0 {Options parsing now collects values without a name; =, now treated as end command} 
        13-Mar-2006 1.5.0 "Added second pass to balance commands" 
        17-Mar-2006 1.6.0 "PARSE rules no more eat newlines after commands" 
        17-Mar-2006 1.7.0 "Removed header option for boxes" 
        17-Mar-2006 1.8.0 "=- now eats one newline" 
        18-Mar-2006 1.9.0 "Added args for =row and =column" 
        18-Mar-2006 1.10.0 "Changed box options" 
        18-Mar-2006 1.11.0 "=>>> etc.; fixed space only lines" 
        21-Mar-2006 1.12.0 "Spaces at beginning of lines are now ignored" 
        23-Mar-2006 1.13.0 {Changed handling of =cell, =row and =column in second pass} 
        24-Mar-2006 1.14.0 "Spaces no more required after ]" 
        27-Mar-2006 1.15.0 "New command options handling" 
        27-Mar-2006 1.16.0 "Added comment handling to second pass" 
        29-Mar-2006 1.17.0 {Minor changes to options handling; supports dashed: color etc. too} 
        29-Mar-2006 1.18.0 "Split =c and =center into two separate commands" 
        29-Mar-2006 1.19.0 "=word and =def as aliases for =: and =::" 
        29-Mar-2006 1.20.0 "Added new comma-pair! option type" 
        29-Mar-2006 1.21.0 {Second pass now eats newlines that should be ignored, and handles inline cmds in block mode differently} 
        30-Mar-2006 1.22.1 "Fixed table balancing" 
        30-Mar-2006 1.23.1 "Added boxcenter etc to =table" 
        30-Mar-2006 1.24.1 "Added #FFF etc. as color" 
        30-Mar-2006 1.25.1 "Changed escape commands (=example[end])" 
        30-Mar-2006 1.26.1 "Added =left, =right, =l, =r" 
        30-Mar-2006 1.27.1 "Added =span" 
        1-Apr-2006 1.28.1 "Added =justify, =j" 
        5-Apr-2006 1.29.1 "Added =table[space]" 
        5-Apr-2006 1.30.1 "Added shadow and rounded to =table" 
        6-Apr-2006 1.31.1 "Added all flag for table, row and column" 
        6-Apr-2006 1.32.1 "= and =, now close =left etc. too" 
        18-Apr-2006 1.33.1 "Fixed balancing for =toc" 
        18-Apr-2006 1.34.1 "Added =o and =x" 
        21-Apr-2006 1.35.1 "Added =s and =u" 
        21-Apr-2006 1.36.1 "Now collects font style for =toc" 
        21-Apr-2006 1.37.1 "Now collects font style for headers numbers" 
        22-Apr-2006 1.38.1 {Moved merge-style here (from xhtml emitter) and added /copy (fixes bug)} 
        22-Apr-2006 1.39.1 "Added =font[space]" 
        22-Apr-2006 1.40.1 {Added new color keywords, improved compatibility with older REBOLs} 
        24-Apr-2006 1.41.1 "Added =row. and =column." 
        24-Apr-2006 1.42.1 "New =image (now inline)" 
        24-Apr-2006 1.43.1 "Added =4, =5 and =6" 
        26-Apr-2006 1.44.1 "Added a few missing colors" 
        27-Apr-2006 1.45.1 "The / char is now an alias for . (ending commands)" 
        27-Apr-2006 1.46.1 "Added initial support for =anchor, changed =link" 
        28-Apr-2006 1.47.1 "Finished =anchor support" 
        12-May-2006 2.1.0 "Started rewriting as RLP with new architecture" 
        15-May-2006 2.2.0 "Added table support" 
        15-May-2006 2.3.0 "Added =csv" 
        17-May-2006 2.4.0 "Added =data" 
        17-May-2006 2.5.0 "Added rewriting engine" 
        17-May-2006 2.6.0 "Added parsing for =repeat" 
        17-May-2006 2.7.0 "Added balancing for =repeat" 
        17-May-2006 2.8.0 "Basic =repeat support" 
        18-May-2006 2.9.0 "New table handling, supporting =repeat in =table" 
        18-May-2006 2.10.0 "Initial toc support" 
        19-May-2006 2.11.0 "Added numbering (finished toc), anchors" 
        19-May-2006 2.12.0 "Fixed links and qlinks" 
        19-May-2006 2.13.0 "Fixed =#" 
        19-May-2006 2.14.0 "=data[name] when name is a =table" 
        20-May-2006 2.15.0 "Added search" 
        23-May-2006 2.16.0 "Improved =repeat and =data, testing" 
        24-May-2006 2.17.0 {Rewritten numbering/counting to be =repeat friendly} 
        24-May-2006 2.18.0 "Added optimizations" 
        25-May-2006 2.19.0 "Changed =table[space]" 
        25-May-2006 2.20.1 "Added support for default options" 
        26-May-2006 2.21.1 "Made words optional in the repeat dialect" 
        26-May-2006 2.22.1 "Auto naming for tables and csv" 
        26-May-2006 2.23.1 "Added =table[headerless]" 
        26-May-2006 2.24.1 "=repeat on table now skips header row" 
        29-May-2006 2.25.1 "Fixed box with only a title" 
        2-Jun-2006 2.26.1 "Added defaults for =repeat and =data" 
        7-Jun-2006 2.27.1 {Fixed problem with =data, =image and =anchor as =box title} 
        14-Jun-2006 2.28.1 "Now removes anchors from TOC" 
        14-Jun-2006 2.29.1 "Search now lists anchor exact matches too" 
        14-Jun-2006 2.30.1 "Added =table[horizontal vertical]" 
        16-Jun-2006 2.31.1 {Added =image[space] and changed =image[image: ...] to =image[src: ...]} 
        16-Jun-2006 2.32.1 "Added /keep refinement to scan-doc" 
        16-Jun-2006 2.33.1 {Added process-link function (to be overridden by users)} 
        29-Jun-2006 2.34.1 "Fixed =span" 
        21-Jul-2006 2.35.1 {=l meant both one-line =left and abbreviation for =link; fixed (now =link can be abbreviated as =li)} 
        21-Jul-2006 2.36.1 "Fixed problem with =table[borderless]" 
        21-Aug-2006 2.37.1 "Release 2.0i: first public release" 
        23-Nov-2006 2.38.1 {Fixed a bug with color names (parse rule must be in correct order)} 
        23-Nov-2006 2.39.1 {Fixed a bug with combination of some one-line commands on the same line} 
        23-Nov-2006 2.40.1 {Changed header numbering: added 0, added normalization} 
        23-Nov-2006 2.41.1 "Added default TOC title setting" 
        23-Nov-2006 2.42.1 "Merged changes from Qtask" 
        6-Dec-2006 2.43.1 "Finished documentation of the second stage" 
        22-Dec-2006 2.44.1 {Fixed a bug with =image without options; changed =:: outside dlist to be indent: 3} 
        13-Mar-2007 2.45.1 {Fixed a bug with =row[all] and =column[all] not applying to previously defined cells} 
        6-Apr-2007 2.46.1 "Adding process-image-url hook function"
    ]
]

match: func [
    "Match a pattern over data" 
    data [block! string!] "Data to match the pattern to" 
    rule [block!] "PARSE rule to use as pattern" 
    /local 
    result recurse
] [
    result: false 
    recurse: either block? data [[
            some [
                rule (result: true) 
                | 
                into recurse 
                | 
                skip
            ]
        ]] [[
            some [
                rule (result: true) 
                | 
                skip
            ]
        ]] 
    parse data recurse 
    result
] 
rewrite: func [
    "Apply a list of rewrite rules to data" 
    data [block! string!] "Data to change" 
    rules [block!] "List of rewrite rules" 
    /trace "Trace rewriting process (for debugging)" 
    /local 
    rules* prod mk1 mk2
] [
    if empty? rules [return data] 
    rules*: make block! 16 
    foreach [pattern production] rules [
        insert insert/only insert/only tail rules* pattern make paren! compose/only [
            prod: compose/deep (production)
        ] '|
    ] 
    remove back tail rules* 
    until [
        if trace [probe data ask "? "] 
        not match data [mk1: rules* mk2: (change/part mk1 prod mk2) :mk1]
    ] 
    data
] 
qml-scanner: context [
    qml-rule: [
        some [commands | text]
    ] 
    commands: [
        any spc newline (stage2 "^/" none) 
        | 
        magic-char [
            magic-char (stage2 [text:] magic-char) 
            | [" " | mk: newline :mk] (stage2 " " none) 
            | 
            "alias" some spc copy cmd some cmd-chars any spc (set-magic cmd) 
            | 
            "csv" [
                "[" copy options to "]" skip any spc opt newline (options: refinements/parse-arg-string "csv" any [options ""]) 
                | 
                "{" copy options to "}" skip any spc opt newline (options: refinements/parse-arg-string "csv" any [options ""]) 
                | 
                any spc opt newline (options: context [name: show: none])
            ] (csv: make block! 256) some [[magic-char "csv" ["." | "/"] any spc opt newline | end] (stage2 "csv" make options [contents: csv]) break 
                | [copy txt to newline newline | copy txt to end] (append/only csv parse/all txt ",")
            ] 
            | 
            copy cmd escape-cmd [
                "[" copy options to "]" skip any spc opt newline 
                | 
                "{" copy options to "}" skip any spc opt newline 
                | 
                any spc opt newline (options: rejoin [magic-char cmd "."])
            ] [copy txt to options options any spc opt newline | copy txt to end] (stage2 cmd txt) 
            | 
            some "-" [some spc opt newline | newline | mk: magic-char :mk | end] (stage2 "-" none) 
            | 
            copy cmd some ">" [some spc | mk: [newline | magic-char] :mk | end] (stage2 ">" length? cmd) 
            | 
            "[" copy options to "]" skip (stage2 "" options) 
            | 
            "{" copy options to "}" skip (stage2 "" options) 
            | 
            "," (stage2 "," none) 
            | 
            "repeat" (options: make block! 16) [(opt-open-char: "[" opt-close-char: "]") rebol-options (stage2 "repeat" options) 
                | (opt-open-char: "{" opt-close-char: "}") rebol-options (stage2 "repeat" options) 
                | ["." | "/"] (stage2 "repeat." none)
            ] 
            | 
            end 
            | 
            copy cmd any cmd-chars [
                "[" copy options to "]" skip opt spc (stage2 cmd options) 
                | 
                "{" copy options to "}" skip opt spc (stage2 cmd options) 
                | ["." | "/"] (stage2 join any [cmd ""] "." none) 
                | [some spc | mk: [newline | magic-char] :mk | end] (stage2 cmd none)
            ] 
            | (stage2 [text:] magic-char)
        ]
    ] 
    txt: none 
    txt-chars: none 
    spc: charset " ^-" 
    text: [
        copy txt [any spc some txt-chars any [some spc some txt-chars]] (stage2 [text:] txt) 
        | 
        copy txt some spc (stage2 [whitespace:] txt)
    ] 
    mk: cmd: options: csv: none 
    spc+: charset " ^-^/" 
    cmd-chars: none 
    magic-char: none 
    escape-cmd: ["HTML" | "REBOL" | "MakeDoc" | "Example"] 
    opt-open-char: "[" opt-close-char: "]" 
    rebol-options: [
        opt-open-char 
        txt: (txt: load-next options txt) :txt 
        some [any spc+ opt-close-char break | end break | txt: (txt: load-next options txt) :txt] 
        opt spc
    ] 
    load-next: func [out text /local val] [
        if error? try [
            set [val text] load/next text 
            insert/only tail out val
        ] [
            insert tail out copy/part text text: any [find text opt-close-char tail text]
        ] 
        text
    ] 
    set-magic: func [magic [string!]] [
        if empty? magic [magic: "="] 
        magic-char: magic 
        cmd-chars: complement charset join " ^-^/[]{}./" first magic-char 
        txt-chars: complement charset join " ^-^/" first magic-char
    ] 
    parse-qml: func [text [string!] magic [string! none!]] [
        set-magic any [magic "="] 
        parse/all text qml-rule
    ] 
    parse-command-options: func [cmd options] [
        either all [
            string? options 
            find [
                "table" "row" "column" "cell" "box" 
                "image" "font" "f" "span" "data"
            ] cmd
        ] [
            refinements/parse-arg-string cmd options
        ] [
            options
        ]
    ] 
    refinements: context [
        types: context [
            flag!: [flag-word [some spc | end]] 
            set-word!: [set-word any spc] 
            color!: [[
                    color-keyword 
                    | 
                    tuple 
                    | [opt "#" copy value 6 hex-digits | "#" copy value 3 hex-digits] (value: to issue! value)
                ] [some spc | end]] 
            string!: [[{"} copy value some dquotechars {"} | "'" copy value some quotechars "'" | copy value some chars] [some spc | end]] 
            integer!: [copy value some digits (value: to system/words/integer! value) [some spc | end]] 
            url!: [
                copy value [some urlchars ":" 0 2 "/" some urlchars any ["/" some urlchars]] (value: to system/words/url! value) [some spc | end]
            ] 
            percent!: [copy value 1 3 digits "%" (value: to money! value) [some spc | end]] 
            pair!: [copy value [some digits "x" some digits] (value: to system/words/pair! value) [some spc | end]] 
            comma-pair!: [(value: make block! 4) 
                copy val some digits ["%" (append value to money! val) | none (append value to integer! val)] 
                "," 
                copy val some digits ["%" (append value to money! val) | none (append value to integer! val)] [some spc | end]
            ]
        ] 
        value: val: none 
        chars: complement spc: charset " ^-^/" 
        urlchars: complement charset {"':/ ^-
} 
        dquotechars: complement charset {"} 
        quotechars: complement charset "'" 
        digits: charset "1234567890" 
        hex-digits: union digits charset "ABCDEFabcdef" 
        flag-word: none 
        set-word: none 
        color-keyword: [
            "clear" (value: /transparent) | copy value [
                "lightgoldenrodyellow" | "mediumspringgreen" | "mediumaquamarine" | 
                "mediumslateblue" | "mediumturquoise" | "mediumvioletred" | "blanchedalmond" | 
                "cornflowerblue" | "darkolivegreen" | "lightslateblue" | "lightslategray" | 
                "lightsteelblue" | "mediumseagreen" | "darkgoldenrod" | "darkslateblue" | 
                "darkslategray" | "darkturquoise" | "lavenderblush" | "lightseagreen" | 
                "palegoldenrod" | "paleturquoise" | "palevioletred" | "antiquewhite" | 
                "darkseagreen" | "lemonchiffon" | "lightskyblue" | "mediumorchid" | 
                "mediumpurple" | "midnightblue" | "darkmagenta" | "deepskyblue" | 
                "floralwhite" | "forestgreen" | "greenyellow" | "lightsalmon" | 
                "lightyellow" | "navajowhite" | "saddlebrown" | "springgreen" | 
                "yellowgreen" | "transparent" | "aquamarine" | "blueviolet" | "chartreuse" | 
                "darkorange" | "darkorchid" | "darksalmon" | "darkviolet" | "dodgerblue" | 
                "ghostwhite" | "lightcoral" | "lightgreen" | "mediumblue" | "papayawhip" | 
                "powderblue" | "sandybrown" | "whitesmoke" | "aliceblue" | "burlywood" | 
                "cadetblue" | "chocolate" | "darkgreen" | "darkkhaki" | "firebrick" | 
                "gainsboro" | "goldenrod" | "indianred" | "lawngreen" | "lightblue" | 
                "lightcyan" | "lightgrey" | "lightpink" | "limegreen" | "mintcream" | 
                "mistyrose" | "olivedrab" | "orangered" | "palegreen" | "peachpuff" | 
                "rosybrown" | "royalblue" | "slateblue" | "slategray" | "steelblue" | 
                "turquoise" | "violetred" | "cornsilk" | "darkblue" | "darkcyan" | 
                "darkgray" | "deeppink" | "feldspar" | "honeydew" | "lavender" | "moccasin" | 
                "seagreen" | "seashell" | "crimson" | "darkred" | "dimgray" | "fuchsia" | 
                "hotpink" | "magenta" | "oldlace" | "skyblue" | "thistle" | "bisque" | 
                "indigo" | "maroon" | "orange" | "orchid" | "purple" | "salmon" | "sienna" | 
                "silver" | "tomato" | "violet" | "yellow" | "azure" | "beige" | "black" | 
                "brown" | "coral" | "green" | "ivory" | "khaki" | "linen" | "olive" | 
                "wheat" | "white" | "aqua" | "blue" | "cyan" | "gold" | "gray" | "lime" | 
                "navy" | "peru" | "pink" | "plum" | "snow" | "teal" | "red" | "tan"
            ] (value: to refinement! value)
        ] 
        tuple: [
            copy value [1 3 digits "." 1 3 digits "." 1 3 digits] (value: attempt [to tuple! value])
        ] 
        flag-words: [
            "table" [
                outline | dashed | dotted | solid | borderless | vertical | horizontal | all | hide | headerless | 
                center | left | right | justify | middle | top | bottom | imagecenter | imageleft | 
                imageright | imagemiddle | imagetop | imagebottom | float | space2 | tilev | shadow | rounded | 
                tileh | tileless | tile | boxcenter | boxleft | boxright | times | helv | courier | bold | italic
            ] 
            "cell" "row" "column" [
                outline | dashed | dotted | solid | borderless | all | 
                center | left | right | justify | middle | top | bottom | imagecenter | imageleft | 
                imageright | imagemiddle | imagetop | imagebottom | tilev | 
                tileh | tileless | tile | times | helv | courier | bold | italic
            ] 
            "box" [
                outline | dashed | dotted | solid | borderless | 
                center | left | right | justify | middle | top | bottom | imagecenter | imageleft | 
                imageright | imagemiddle | imagetop | imagebottom | float | tilev | 
                tileh | tileless | tile | boxcenter | boxleft | boxright | times | helv | courier | shadow | rounded | 
                bold | italic
            ] 
            "image" [
                outline | dashed | dotted | solid | borderless | float | 
                boxleft | space
            ] 
            "font" "f" [
                times | helv | courier | bold | italic | space
            ] 
            "span" none 
            "csv" [show] 
            "data" none
        ] 
        bold: ["b" opt "old" (value: 'bold)] 
        italic: ["i" opt ["talic" opt "s"] (value: 'italic)] 
        vertical: [["vertical" | "tablev"] (value: 'vertical)] 
        float: [["float" | "flow"] (value: 'float)] 
        tilev: ["tilev" opt "ertical" (value: 'tilev)] 
        tileh: ["tileh" opt "orizontal" (value: 'tileh)] 
        space2: ["space" (value: 'force-space)] 
        rule: word: none 
        parse flag-words [
            some [
                some string! set rule block! (
                    while [not tail? rule] [
                        either all [rule/1 <> '| not block? get/any word: rule/1] [
                            rule: insert/only change rule 
                            form word to paren! compose [value: (to lit-word! word)]
                        ] [rule: next rule]
                    ]
                ) 
                | 
                some string! rule: 'none (rule/1: [end skip])
            ]
        ] 
        flag-actions: context [
            dashed: [outline-style: 'dashed] 
            dotted: [outline-style: 'dotted] 
            solid: [outline-style: 'solid] 
            outline: [outline-style: 'solid] 
            borderless: [outline-style: 'borderless] 
            rounded: [outline-style: 'rounded] 
            center: [text-halign: 'center] 
            left: [text-halign: 'left] 
            right: [text-halign: 'right] 
            justify: [text-halign: 'justify] 
            middle: [text-valign: 'middle] 
            top: [text-valign: 'top] 
            bottom: [text-valign: 'bottom] 
            imagecenter: [image-halign: 'center] 
            imageleft: [image-halign: 'left] 
            imageright: [image-halign: 'right] 
            imagemiddle: [image-valign: 'center] 
            imagetop: [image-valign: 'top] 
            imagebottom: [image-valign: 'bottom] 
            tile: [image-tiling: 'both] 
            tilev: [image-tiling: 'vertical] 
            tileh: [image-tiling: 'horizontal] 
            tileless: [image-tiling: 'neither] 
            times: [typeface: 'times] 
            helv: [typeface: 'helvetica] 
            courier: [typeface: 'courier] 
            boxcenter: [position: 'center] 
            boxright: [position: 'right] 
            boxleft: [position: 'left]
        ] 
        set-words: [
            "table" [
                color | typeface | fontsize | background | outline | dashed | dotted | solid | image | width | height | 
                name
            ] 
            "cell" "row" "column" [
                color | typeface | fontsize | background | outline | dashed | dotted | solid | image | width | height | 
                column | row
            ] 
            "box" [
                color | typeface | fontsize | background | outline | dashed | dotted | solid | image | width | height
            ] 
            "image" [
                background | outline | dashed | dotted | solid | src | width | height | space
            ] 
            "font" "f" [
                color | typeface | fontsize | background | space
            ] 
            "span" none 
            "csv" [name] 
            "data" [name | index]
        ] 
        color: [["colo" opt "u" "r:" | "foreground:" | "fg:"] (value: first [color:])] 
        typeface: [opt "type" "face:" (value: first [typeface:])] 
        fontsize: ["size" opt "face" ":" (value: first [fontsize:])] 
        background: [["background:" | "bg:"] (value: first [background:])] 
        width: ["w" opt "idth" ":" (value: first [width:])] 
        height: ["h" opt "eight" ":" (value: first [height:])] 
        column: ["c" opt "olumn" ":" (value: first [column:])] 
        row: ["r" opt "ow" ":" (value: first [row:])] 
        parse set-words [
            some [
                some string! set rule block! (
                    while [not tail? rule] [
                        either all [rule/1 <> '| not block? get/any word: rule/1] [
                            rule: insert/only change rule 
                            append form word ":" to paren! compose/deep [value: first [(to set-word! word)]]
                        ] [rule: next rule]
                    ]
                ) 
                | 
                some string! rule: 'none (rule/1: [end skip])
            ]
        ] 
        set-actions: context [
            outline: solid: [outline-color: value outline-style: 'solid] 
            dashed: [outline-color: value outline-style: 'dashed] 
            dotted: [outline-color: value outline-style: 'dotted] 
            column: [position: as-pair value 1] 
            row: [position: as-pair 1 value]
        ] 
        var-types: context [
            color: types/color! 
            typeface: types/string! 
            fontsize: types/integer! 
            space: types/integer! 
            background: types/color! 
            outline: dashed: dotted: solid: types/color! 
            width: height: bind [percent! | integer!] in types 'self 
            column: row: types/integer! 
            image: bind [url! | string!] in types 'self 
            name: types/string! 
            index: bind [pair! | integer!] in types 'self
        ] 
        value-rule: bind [color! | percent! | pair! | comma-pair! | integer! | url! | string!] in types 'self 
        type-map: [
            "table" [
                color! [background color outline-color] 
                string! [image typeface] 
                integer! [width height fontsize] 
                url! [image] 
                percent! [width height] 
                pair! [table-size] 
                comma-pair! [(width: value/1 height: value/2)]
            ] 
            "row" "column" [
                color! [background color outline-color] 
                string! [image typeface] 
                integer! [position width height fontsize] 
                url! [image] 
                percent! [width height] 
                pair! [none] 
                comma-pair! [(width: value/1 height: value/2)]
            ] 
            "cell" [
                color! [background color outline-color] 
                string! [image typeface] 
                integer! [width height fontsize] 
                url! [image] 
                percent! [width height] 
                pair! [position] 
                comma-pair! [(width: value/1 height: value/2)]
            ] 
            "box" [
                color! [background color outline-color] 
                string! [image typeface] 
                integer! [width height fontsize] 
                url! [image] 
                percent! [width height] 
                pair! [none] 
                comma-pair! [(width: value/1 height: value/2)]
            ] 
            "image" [
                color! [outline-color background] 
                string! [src] 
                integer! [width height] 
                url! [src] 
                percent! [width height] 
                pair! [none] 
                comma-pair! [(width: value/1 height: value/2)]
            ] 
            "font" "f" [
                color! [color background] 
                string! [typeface] 
                integer! [fontsize space] 
                url! [none] 
                percent! [none] 
                pair! [none] 
                comma-pair! [none]
            ] 
            "span" [
                color! [none] 
                string! [none] 
                integer! [none] 
                url! [none] 
                percent! [none] 
                pair! [start end] 
                comma-pair! [none]
            ] 
            "csv" [
                color! [none] 
                string! [name] 
                integer! [none] 
                url! [none] 
                percent! [none] 
                pair! [none] 
                comma-pair! [none]
            ] 
            "data" [
                color! [none] 
                string! [name] 
                integer! [index] 
                url! [none] 
                percent! [none] 
                pair! [index] 
                comma-pair! [none]
            ]
        ] 
        parse type-map [
            some [
                some string! set rule block! (
                    foreach [from to] [
                        color! [issue! refinement! tuple!] 
                        percent! money! 
                        comma-pair! block!
                    ] [
                        replace rule from to
                    ]
                )
            ]
        ] 
        object-map: [
            "table" [
                background: color: outline-color: image: typeface: width: height: fontsize: 
                table-size: bold: italic: outline-style: vertical: text-halign: text-valign: 
                image-halign: image-valign: float: image-tiling: position: force-space: shadow: 
                all: hide: name: headerless: horizontal: none
            ] 
            "row" "column" "cell" [
                background: color: outline-color: image: typeface: width: height: fontsize: 
                bold: italic: outline-style: text-halign: text-valign: 
                image-halign: image-valign: image-tiling: position: all: none
            ] 
            "box" [
                background: color: outline-color: image: typeface: width: height: fontsize: 
                bold: italic: outline-style: text-halign: text-valign: 
                image-halign: image-valign: float: image-tiling: position: shadow: none
            ] 
            "image" [
                background: outline-color: src: width: height: outline-style: 
                float: position: space: none
            ] 
            "font" "f" [
                bold: italic: typeface: color: background: fontsize: space: none
            ] 
            "span" [
                start: end: none
            ] 
            "csv" [
                show: name: none
            ] 
            "data" [
                name: index: none
            ]
        ] 
        select*: func [block value] [
            parse block [to value to block! set block block! | (block: none)] 
            block
        ] 
        get-obj: func [cmd] [make object! select* object-map cmd] 
        set-value-from-type: func [tmap obj] [
            foreach word select* tmap type?/word :value [
                if paren? :word [
                    do bind to block! word in obj 'self 
                    break
                ] 
                if all [word <> 'none none? get word: in obj word] [
                    set word value 
                    break
                ]
            ]
        ] 
        parse-arg-string: func [cmd args /local 
            obj tmap var-type last-str vars tset-word! tflag!
        ] [
            flag-word: select* flag-words cmd 
            set-word: select* set-words cmd 
            tmap: select* type-map cmd 
            obj: get-obj cmd 
            tflag!: types/flag! 
            tset-word!: types/set-word! 
            parse/all args [
                any spc some [
                    tflag! (
                        last-str: none 
                        either in flag-actions value [
                            do bind get in flag-actions value in obj 'self
                        ] [
                            set in obj value true
                        ]
                    ) 
                    | (vars: clear []) 
                    some [tset-word! (append vars value: to word! :value)] (var-type: get in var-types value) 
                    var-type (
                        last-str: either string? :value [value] [none] 
                        foreach var vars [
                            either in set-actions var [
                                do bind get in set-actions var in obj 'self
                            ] [
                                set in obj var value
                            ]
                        ]
                    ) 
                    | 
                    value-rule (
                        either string? :value [
                            either last-str [
                                insert insert tail last-str " " value
                            ] [
                                last-str: value 
                                set-value-from-type tmap obj
                            ]
                        ] [
                            last-str: none 
                            set-value-from-type tmap obj
                        ]
                    )
                ]
            ] 
            obj
        ]
    ] 
    default-number-style: 
    default-table: 
    default-row: 
    default-column: 
    default-cell: 
    default-box: 
    default-image: 
    default-toc-title: none 
    default-data: context [name: "csv" index: none] 
    default-repeat: [csv in csv] 
    set-defaults: func [defaults /local w] [
        default-number-style: default-table: default-row: default-column: 
        default-cell: default-box: default-image: default-toc-title: none 
        if block? defaults [
            foreach [cmd opts] defaults [
                if w: select [
                    "toc" default-number-style 
                    "table" default-table 
                    "row" default-row 
                    "column" default-column 
                    "cell" default-cell 
                    "box" default-box 
                    "image" default-image 
                    "toc-title" default-toc-title
                ] cmd [
                    set w parse-command-options cmd opts
                ]
            ]
        ]
    ] 
    stage2-fsm: make fsm! [] 
    stage2: func [cmd opts] [
        if block? cmd [cmd: first cmd] 
        stage2-ctx/opts: parse-command-options stage2-ctx/cmd: cmd :opts 
        stage2-fsm/event cmd 
        if stage2-ctx/close-inline? [
            stage2-fsm/event first [close-inline:] 
            stage2-ctx/close-inline?: no
        ]
    ] 
    stage2-ctx: context [
        cmd: opts: none 
        open-block: func [cmd opts] [
            stage3 cmd opts 
            insert/only insert tail block-stack cmd opts
        ] 
        block-stack: [] 
        close-block: func [cmd /upto noclosecmd /local] [
            remove back tail cmd: copy cmd 
            if local: find/skip/last block-stack cmd 2 [
                if upto [
                    noclosecmd: find/skip/last block-stack noclosecmd 2 
                    if all [noclosecmd (index? local) < index? noclosecmd] [
                        exit
                    ]
                ] 
                block-stack: tail block-stack 
                until [
                    block-stack: skip block-stack -2 
                    stage3 join block-stack/1 "." none 
                    block-stack/1 = cmd
                ] 
                block-stack: head clear block-stack
            ]
        ] 
        remove-all-inline: has [cmd] [
            clear inline-stack 
            block-stack: tail block-stack 
            while [find ["left" "right" "center" "justify"] cmd: pick block-stack -2] [
                stage3 join cmd "." none 
                block-stack: skip block-stack -2
            ] 
            block-stack: head clear block-stack
        ] 
        inline-stack: [] 
        close-all-block: does [
            block-stack: skip tail block-stack -2 
            while [not empty? block-stack] [
                stage3 join block-stack/1 "." none 
                block-stack: skip clear block-stack -2
            ]
        ] 
        remove-last-inline: has [cmd] [
            either empty? inline-stack [
                if find ["left" "right" "center" "justify"] cmd: pick tail block-stack -2 [
                    stage3 join cmd "." none 
                    clear skip tail block-stack -2
                ]
            ] [
                clear skip tail inline-stack -2
            ]
        ] 
        reopen-inline: does [
            foreach [cmd opts] inline-stack [
                stage3 cmd opts
            ]
        ] 
        add-inline: func [cmd opts] [
            insert/only insert tail inline-stack cmd opts
        ] 
        remove-inline: func [cmd] [
            if cmd: find/skip inline-stack cmd 2 [
                remove/part cmd 2
            ]
        ] 
        close-all-inline: does [
            inline-stack: skip tail inline-stack -2 
            while [not empty? inline-stack] [
                stage3 join inline-stack/1 "." none 
                inline-stack: skip clear inline-stack -2
            ] 
            if special [close-special special] 
            block-stack: tail block-stack 
            while [find ["left" "right" "center" "justify"] cmd: pick block-stack -2] [
                if not close-inline? [
                    stage3 "^/" none 
                    close-inline?: yes
                ] 
                stage3 join cmd "." none 
                block-stack: skip block-stack -2
            ] 
            block-stack: head clear block-stack
        ] 
        close-inline?: no 
        close-last-inline: has [cmd] [
            if empty? inline-stack [
                if special [
                    close-special special 
                    exit
                ] 
                if find ["left" "right" "center" "justify"] cmd: pick tail block-stack -2 [
                    stage3 "^/" none 
                    close-inline?: yes 
                    stage3 join cmd "." none 
                    clear skip tail block-stack -2
                ] 
                exit
            ] 
            cmd: pick tail inline-stack -2 
            stage3 join cmd "." none 
            clear skip tail inline-stack -2
        ] 
        open-special: func [cmd opts] [
            if special [close-special special] 
            special: join cmd "." 
            temp-close-inline 
            stage3 cmd opts 
            reopen-inline
        ] 
        special: none 
        close-special: func [cmd] [
            if special = cmd [
                temp-close-inline 
                stage3 cmd none 
                reopen-inline 
                special: none
            ]
        ] 
        temp-close-inline: does [
            if empty? inline-stack [exit] 
            inline-stack: tail inline-stack 
            until [
                inline-stack: skip inline-stack -2 
                stage3 join inline-stack/1 "." none 
                head? inline-stack
            ]
        ] 
        open-inline: func [cmd opts] [
            stage3 cmd opts 
            insert/only insert tail inline-stack cmd opts
        ] 
        close-inline: func [cmd] [
            remove back tail cmd: copy cmd 
            if find/skip inline-stack cmd 2 [
                inline-stack: tail inline-stack 
                until [
                    inline-stack: skip inline-stack -2 
                    stage3 join inline-stack/1 "." none 
                    inline-stack/1 = cmd
                ] 
                remove/part inline-stack 2 
                foreach [cmd opts] inline-stack [
                    stage3 cmd opts
                ] 
                inline-stack: head inline-stack
            ]
        ] 
        close-repeat: func [/only] [
            either find/skip inline-stack "repeat" 2 [
                inline-stack: tail inline-stack 
                until [
                    inline-stack: skip inline-stack -2 
                    stage3 join inline-stack/1 "." none 
                    inline-stack/1 = "repeat"
                ] 
                inline-stack: head clear inline-stack
            ] [
                if all [not only find/skip block-stack "repeat" 2] [
                    if special [close-special special] 
                    temp-close-inline 
                    stage3 "^/" none 
                    close-inline?: yes 
                    close-block "repeat."
                ]
            ]
        ] 
        end-inline: does [
            if special [close-special special] 
            close-repeat/only 
            temp-close-inline 
            stage3 "^/" none
        ] 
        in-block: [
            {"} "'" "`" "‘" "’" in-line-comment 
            ";" "comment" "rem" in-comment 
            default: (stage3 cmd opts) 
            "word" (stage3 ":" opts) in-inline 
            "def" (stage3 "::" opts) in-inline 
            "example" "html" "rebol" "makedoc" "csv" (stage3 cmd opts) eat-one-newline 
            "table" "center" "left" "justify" "right" "repeat" (open-block cmd opts) eat-one-newline 
            "box" (open-block cmd opts) 
            "box." "table." "cell." "center." "left." 
            "justify." "right." "toc." "repeat." (close-block cmd) eat-one-newline 
            "toc" (close-block "toc." open-block "toc" opts) 
            "." (remove-all-inline close-all-block) eat-one-newline 
            " " (remove-last-inline) eat-one-newline 
            "," (remove-all-inline) eat-one-newline 
            "" "link" "anchor" "a" "li" "image" "data" text: (reopen-inline) continue in-inline 
            "c" "1" "1'" "2" "2'" "3" "3'" "*" "**" "#" "##" ">" ":" "::" 
            "r" "l" "j" "o" "x" "2’" "1’" "3’" "4" "5" "6" (stage3 cmd opts reopen-inline) in-inline 
            "b" "bold" (add-inline "b" opts) eat-one-newline 
            "u" "underline" (add-inline "u" opts) eat-one-newline 
            "i" "italics" "italic" (add-inline "i" opts) eat-one-newline 
            "font" "f" (add-inline "f" opts) eat-one-newline 
            "s" "strike" "strikethrough" (add-inline "s" opts) eat-one-newline 
            "b." "bold." (remove-inline "b") eat-one-newline 
            "u." "underline." (remove-inline "u") eat-one-newline 
            "i." "italics." "italic." (remove-inline "i") eat-one-newline 
            "font." "f." (remove-inline "f") eat-one-newline 
            "s." "strike." "strikethrough." (remove-inline "s") eat-one-newline 
            "row" "column" "row." "column." "span" (close-block/upto "cell." "table" stage3 cmd opts) eat-one-newline 
            "cell" (close-block/upto "cell." "table" open-block cmd opts) eat-one-newline
        ] 
        in-inline: [
            {"} "'" "`" "‘" "’" in-line-comment 
            ";" "comment" "rem" in-comment 
            default: (stage3 cmd opts) 
            "." (close-all-inline stage3 "^/" none) continue return 
            " " (close-last-inline) 
            "," (close-all-inline) 
            "link" "li" (open-special "link" opts) 
            "anchor" "a" (open-special "anchor" opts) 
            "link." "li." (close-special "link.") 
            "anchor." "a." (close-special "anchor.") 
            "b" "bold" (open-inline "b" opts) 
            "u" "underline" (open-inline "u" opts) 
            "i" "italics" "italic" (open-inline "i" opts) 
            "s" "strike" "strikethrough" (open-inline "s" opts) 
            "font" "f" (open-inline "f" opts) 
            "b." "bold." (close-inline "b.") 
            "u." "underline." (close-inline "u.") 
            "i." "italics." "italic." (close-inline "i.") 
            "s." "strike." "strikethrough." (close-inline "s.") 
            "font." "f." (close-inline "f.") 
            "repeat" (open-inline "repeat" opts) 
            "repeat." (close-repeat) 
            "^/" (end-inline) return 
            "box" "table" "c" "center" "center." "box." "table." "-" 
            "1" "1'" "2" "2'" "3" "3'" "*" "**" "#" "##" "csv" 
            ">" ":" "::" "word" "def" "example" "toc" "cell" "cell." 
            "row" "column" "left" "right" "left." "right." "r" "l" "span" 
            "html" "rebol" "makedoc" "justify" "j" "justify." "toc." 
            "o" "x" "2’" "1’" "3’" "row." "column." "4" "5" "6" (end-inline) continue return 
            close-inline: return
        ] 
        in-line-comment: [
            "^/" return
        ] 
        in-comment: [
            ";." "comment." "rem." return
        ] 
        eat-one-newline: [
            "^/" return 
            default: continue return
        ]
    ] 
    init-stage2: does [
        clear stage2-ctx/block-stack 
        clear stage2-ctx/inline-stack 
        stage2-ctx/special: none 
        stage2-fsm/init stage2-ctx/in-block
    ] 
    end-stage2: does [
        stage2-fsm/event "." 
        stage2-fsm/end
    ] 
    stage3: func [cmd opts] [
        if block? cmd [cmd: first cmd] 
        stage3-ctx/cmd: cmd 
        stage3-ctx/opts: opts 
        stage3-fsm/event cmd
    ] 
    stage3-fsm: make fsm! [] 
    stage3-ctx: context [
        cmd: opts: none 
        emit: func [val] [
            repend out val
        ] 
        inherit: func [parent-state new-directives] [
            append new-directives parent-state
        ] 
        blocks: [] 
        open-block: func [name opts /only] [
            insert/only tail blocks out 
            insert/only tail out out: make block! 16 
            emit name 
            if not none? opts [
                if all [object? opts not only] [opts: make-style opts] 
                emit ['opts opts]
            ]
        ] 
        close-block: does [
            if empty? blocks [exit] 
            out: last blocks 
            remove back tail blocks
        ] 
        make-style: func [obj /ignore block /local] [
            local: make block! length? obj: third obj 
            block: any [block []] 
            foreach [word val] obj [
                if all [:val not find block to word! word] [insert/only insert tail local word :val]
            ] 
            local
        ] 
        tabid: 1 
        vars: [] 
        open-table: func [opts] [
            if not object? opts [
                opts: refinements/get-obj "table"
            ] 
            if not opts/name [
                opts/name: join "table" tabid 
                if tabid = 1 [insert insert tail vars "table" context [type: 'alias dest: "table1"]] 
                tabid: tabid + 1
            ] 
            open-block/only 'table-proto opts 
            insert insert tail vars opts/name context [type: 'table-proto name: opts/name contents: out]
        ] 
        csvid: 1 
        handle-csv: func [data] [
            if not object? data [exit] 
            data: make data [type: 'csv] 
            either data/name [
                insert insert tail vars data/name data
            ] [
                insert insert tail vars join "csv" csvid data 
                if csvid = 1 [insert insert tail vars "csv" data] 
                csvid: csvid + 1
            ] 
            if data/show [
                open-block 'table none 
                foreach row data/contents [
                    open-block 'row none 
                    foreach column row [
                        emit [reduce ['cell reduce ['para column]]]
                    ] 
                    close-block
                ] 
                close-block
            ]
        ] 
        anchors: [] 
        header?: func [type col row] [
            switch type [
                horiz [row = 1] 
                vert [col = 1] 
                both [any [row = 1 col = 1]] 
                none [false]
            ]
        ] 
        generate-table: func [opts body /local table result content tmp i j header] [
            result: copy [table] 
            if opts [insert/only insert tail result 'opts make-style/ignore opts [name]] 
            table: make table-state! [
                style: opts 
                if all [object? style style/table-size] [size: style/table-size] 
                table: make block! 16 
                columns: make block! 16
            ] 
            body: rewrite copy body rewrite-rules 
            parse body [
                some [
                    'row set opts skip (add-row table opts) 
                    | 
                    'column set opts skip (add-col table opts) 
                    | 
                    'return (table-go-back table) 
                    | 
                    into ['cell ['opts set opts skip | (opts: none)] content: to end (add-cell table opts content)] 
                    | 
                    'span set opts skip (make-span table opts) opt [
                        into ['cell ['opts set opts skip | (opts: none)] content: to end (set-cell table opts content)]
                    ]
                ]
            ] 
            header: 'horiz 
            if object? table/style [
                if table/style/name [
                    poke find vars table/style/name 2 table
                ] 
                if table/style/hide [return [hidden-table]] 
                if table/style/vertical [header: either table/style/horizontal ['both] ['vert]] 
                if table/style/headerless [header: 'none]
            ] 
            insert/only tail result content: copy [columns] 
            foreach col table/columns [
                insert/only tail content either col [reduce ['column 'opts make-style col]] [[column]]
            ] 
            j: 1 
            foreach row table/table [
                either object? row [
                    i: 1 
                    insert/only tail result content: copy [row] 
                    if row/style [insert/only insert tail content 'opts make-style row/style] 
                    if all [find [horiz both] header j = 1] [insert tail content 'header] 
                    foreach cell row/contents [
                        either object? cell [
                            if cell/type = 'cell [
                                insert/only tail content compose [
                                    cell (either cell/style ['opts] [[]]) (either cell/style [reduce [make-style/ignore cell/style [position]]] [[]]) (either cell/spansize ['span] [[]]) (any [cell/spansize []]) (either header? header i j ['header] [[]]) (cell/out)
                                ]
                            ]
                        ] [
                            tmp: make-cell-style table none row pick table/columns i 
                            insert/only tail content compose [
                                cell (either tmp ['opts] [[]]) (either tmp [reduce [make-style/ignore tmp [position]]] [[]]) (either header? header i j ['header] [[]])
                            ]
                        ] 
                        i: i + 1
                    ] 
                    loop table/size/x - length? row/contents [
                        tmp: make-cell-style table none row pick table/columns i 
                        insert/only tail content compose [
                            cell (either tmp ['opts] [[]]) (either tmp [reduce [make-style/ignore tmp [position]]] [[]]) (either header? header i j ['header] [[]])
                        ] 
                        i: i + 1
                    ]
                ] [
                    insert/only tail result content: copy [row] 
                    if all [find [horiz both] header j = 1] [insert tail content 'header] 
                    if not any [table/style] 
                    repeat i table/size/x [
                        tmp: make-cell-style table none none pick table/columns i 
                        insert/only tail content compose [
                            cell (either tmp ['opts] [[]]) (either tmp [reduce [make-style/ignore tmp [position]]] [[]]) (either header? header i j ['header] [[]])
                        ]
                    ]
                ] 
                j: j + 1
            ] 
            loop table/size/y - length? table/table [
                insert/only tail result content: copy [row] 
                if all [find [horiz both] header j = 1] [insert tail content 'header] 
                repeat i table/size/x [
                    tmp: make-cell-style table none none pick table/columns i 
                    insert/only tail content compose [
                        cell (either tmp ['opts] [[]]) (either tmp [reduce [make-style/ignore tmp [position]]] [[]]) (either header? header i j ['header] [[]])
                    ]
                ] 
                j: j + 1
            ] 
            result
        ] 
        table-state!: context [
            type: 'table 
            table: 
            columns: 
            currow: 
            curcell: 
            curpos: none 
            dir: 0x1 
            size: 0x0 
            style: none 
            savepos: savedir: none
        ] 
        inherit-style: func [dest source words] [
            foreach word words [
                if none? get in dest word [
                    set in dest word get in source word
                ]
            ] 
            dest
        ] 
        make-cell-style: func [table-state style row col] [
            if not style [
                style: context [
                    background: color: outline-color: image: typeface: width: height: fontsize: 
                    bold: italic: outline-style: text-halign: text-valign: 
                    image-halign: image-valign: image-tiling: position: none
                ]
            ] 
            if all [table-state/style table-state/style/all] [
                inherit-style style table-state/style [outline-color outline-style]
            ] 
            either table-state/dir = 1x0 [
                if all [col col/all] [
                    inherit-style style col [
                        background color outline-color typeface height fontsize bold italic outline-style 
                        text-halign text-valign
                    ]
                ] 
                if all [row row/style row/style/all] [
                    inherit-style style row/style [
                        background outline-color width outline-style
                    ]
                ]
            ] [
                if all [row row/style row/style/all] [
                    inherit-style style row/style [
                        background outline-color width outline-style
                    ]
                ] 
                if all [col col/all] [
                    inherit-style style col [
                        background color outline-color typeface height fontsize bold italic outline-style 
                        text-halign text-valign
                    ]
                ]
            ] 
            if parse second style [object! some none! end] [style: none] 
            style
        ] 
        make-row: func [table-state pos style' /local row] [
            if pos/y > length? table-state/table [
                insert/dup tail table-state/table none pos/y - length? table-state/table
            ] 
            either row: pick table-state/table pos/y [
                row/style: merge-style row/style style'
            ] [
                poke table-state/table pos/y row: context [
                    contents: make block! 16 
                    style: style'
                ]
            ] 
            row
        ] 
        make-col: func [table-state pos style /local col] [
            if pos/x > length? table-state/columns [
                insert/dup tail table-state/columns none pos/x - length? table-state/columns
            ] 
            either col: pick table-state/columns pos/x [
                merge-style col style
            ] [
                poke table-state/columns pos/x style 
                style
            ]
        ] 
        add-row: func [table-state args /local pos row] [
            table-state/savedir: table-state/dir 
            if object? args [
                pos: args/position 
                if pair? pos [pos: pos/y]
            ] 
            either pos [
                table-state/savepos: table-state/curpos 
                table-state/curpos: 0x1 * pos
            ] [
                either table-state/curpos [
                    table-state/savepos: table-state/curpos + 0x1 
                    table-state/curpos: table-state/curpos * 0x1 + 0x1
                ] [
                    table-state/savepos: table-state/curpos: 0x1
                ]
            ] 
            args: merge-style/copy default-row args 
            row: make-row table-state table-state/curpos args 
            if all [row/style row/style/all] [
                foreach cell row/contents [
                    if cell [
                        cell/style: make-cell-style table-state cell/style row none
                    ]
                ]
            ] 
            table-state/dir: 1x0
        ] 
        add-col: func [table-state args /local pos col cell] [
            table-state/savedir: table-state/dir 
            if object? args [
                pos: args/position 
                if pair? pos [pos: pos/x]
            ] 
            either pos [
                table-state/savepos: table-state/curpos 
                table-state/curpos: 1x0 * pos
            ] [
                either table-state/curpos [
                    table-state/savepos: table-state/curpos + 1x0 
                    table-state/curpos: table-state/curpos * 1x0 + 1x0
                ] [
                    table-state/savepos: table-state/curpos: 1x0
                ]
            ] 
            args: merge-style/copy default-column args 
            col: make-col table-state table-state/curpos args 
            if all [col col/all] [
                foreach row table-state/table [
                    if row [
                        if cell: pick row/contents table-state/curpos/x [
                            cell/style: make-cell-style table-state cell/style none col
                        ]
                    ]
                ]
            ] 
            table-state/dir: 0x1
        ] 
        table-go-back: func [table-state] [
            if all [table-state/savepos table-state/savedir] [
                table-state/curpos: table-state/savepos 
                table-state/dir: table-state/savedir 
                table-state/currow: pick table-state/table table-state/curpos/y 
                table-state/curcell: pick table-state/currow/contents table-state/curpos/x 
                table-state/savepos: table-state/savedir: none
            ]
        ] 
        make-cell: func [table-state pos style' contents /span spanrc /local row cell] [
            row: make-row table-state pos none 
            if pos/x > length? row/contents [
                insert/dup tail row/contents none pos/x - length? row/contents
            ] 
            table-state/curpos: pos 
            table-state/currow: row 
            either cell: pick row/contents pos/x [
                if cell/type = 'span [
                    either span [
                        either cell/reference/position [
                            break-span table-state cell/reference pos pos + spanrc 
                            return make-cell/span table-state pos style' contents spanrc
                        ] [
                            poke row/contents pos/x none 
                            return make-cell/span table-state pos style' contents spanrc
                        ]
                    ] [
                        either cell/reference/position [
                            cell: cell/reference
                        ] [
                            poke row/contents pos/x none 
                            return make-cell table-state pos style' contents
                        ]
                    ]
                ] 
                cell/style: merge-style cell/style style' 
                if span [
                    if cell/spansize [
                        if any [cell/spansize/y > spanrc/y cell/spansize/x > spanrc/x] [
                            break-span table-state cell pos pos + spanrc 
                            return make-cell/span table-state pos style' contents spanrc
                        ]
                    ] 
                    cell/spansize: spanrc
                ] 
                cell/out: contents 
                table-state/curcell: cell
            ] [
                poke row/contents pos/x table-state/curcell: context [
                    type: 'cell 
                    position: pos 
                    out: contents 
                    style: make-cell-style table-state style' row pick table-state/columns pos/x 
                    spansize: if span [spanrc]
                ] 
                table-state/curcell
            ]
        ] 
        break-span: func [table-state spancell breakstart breakend /local cellstart cellend] [
            cellstart: spancell/position 
            cellend: spancell/position + spancell/spansize 
            spancell/spansize: none 
            spancell/position: none 
            poke get in pick table-state/table cellstart/y 'contents cellstart/x none 
            if spancell/style [spancell/style/position: none] 
            either table-state/dir = 1x0 [
                if breakstart/y > cellstart/y [
                    make-span table-state context [
                        start: cellstart 
                        end: cellend 
                        end/y: breakstart/y - 1
                    ] 
                    cellstart/y: breakstart/y 
                    set-cell table-state spancell/style []
                ] 
                if breakend/y < cellend/y [
                    make-span table-state context [
                        start: cellstart 
                        start/y: breakend/y + 1 
                        end: cellend
                    ] 
                    cellend/y: breakend/y 
                    set-cell table-state spancell/style []
                ] 
                if breakstart/x > cellstart/x [
                    make-span table-state context [
                        start: cellstart 
                        end: cellend 
                        end/x: breakstart/x - 1
                    ] 
                    cellstart/x: breakstart/x 
                    set-cell table-state spancell/style []
                ] 
                if breakend/x < cellend/x [
                    make-span table-state context [
                        start: cellstart 
                        start/x: breakend/x + 1 
                        end: cellend
                    ] 
                    cellend/x: breakend/x 
                    set-cell table-state spancell/style []
                ]
            ] [
                if breakstart/x > cellstart/x [
                    make-span table-state context [
                        start: cellstart 
                        end: cellend 
                        end/x: breakstart/x - 1
                    ] 
                    cellstart/x: breakstart/x 
                    set-cell table-state spancell/style []
                ] 
                if breakend/x < cellend/x [
                    make-span table-state context [
                        start: cellstart 
                        start/x: breakend/x + 1 
                        end: cellend
                    ] 
                    cellend/x: breakend/x 
                    set-cell table-state spancell/style []
                ] 
                if breakstart/y > cellstart/y [
                    make-span table-state context [
                        start: cellstart 
                        end: cellend 
                        end/y: breakstart/y - 1
                    ] 
                    cellstart/y: breakstart/y 
                    set-cell table-state spancell/style []
                ] 
                if breakend/y < cellend/y [
                    make-span table-state context [
                        start: cellstart 
                        start/y: breakend/y + 1 
                        end: cellend
                    ] 
                    cellend/y: breakend/y 
                    set-cell table-state spancell/style []
                ]
            ]
        ] 
        make-reference: func [table-state pos cell /local row old save] [
            row: make-row table-state pos none 
            if pos/x > length? row/contents [
                insert/dup tail row/contents none pos/x - length? row/contents
            ] 
            if all [old: pick row/contents pos/x old/type = 'span old/reference/position] [
                save: reduce bind [curcell curpos currow] in table-state 'self 
                break-span table-state old/reference cell/position cell/position + cell/spansize 
                set bind [curcell curpos currow] in table-state 'self save
            ] 
            poke row/contents pos/x local: context [
                type: 'span 
                reference: cell
            ] 
            local
        ] 
        add-cell: func [table-state args contents /local pos] [
            if object? args [pos: args/position] 
            if not pos [
                pos: any [table-state/curpos 1x0] 
                pos: pos + table-state/dir
            ] 
            args: merge-style/copy default-cell args 
            make-cell table-state pos args contents 
            table-state/size: max table-state/size pos
        ] 
        set-cell: func [table-state args contents] [
            either all [args args/position] [
                add-cell table-state args contents
            ] [
                table-state/curcell/style: merge-style table-state/curcell/style args 
                table-state/curcell/out: contents
            ]
        ] 
        make-span: func [table-state args /local cell pos] [
            if not all [
                object? args pair? args/start pair? args/end 
                set bind [start end] in args 'self reduce [min args/start args/end max args/start args/end]
            ] [exit] 
            if args/start = args/end [
                make-cell table-state args/start none [] 
                exit
            ] 
            if cell: make-cell/span table-state args/start none [] 1x1 + args/end - args/start [
                pos: args/start + 1x0 
                while [pos/y <= args/end/y] [
                    while [pos/x <= args/end/x] [
                        make-reference table-state pos cell 
                        pos: pos + 1x0
                    ] 
                    pos/x: args/start/x 
                    pos: pos + 0x1
                ] 
                table-state/size: max table-state/size args/end
            ]
        ] 
        common: [
            default: (emit [reduce ['command cmd opts]]) 
            "." rewind? initial
        ] 
        in-block: initial: inherit common [
            "" "link" "anchor" "image" "b" "i" "s" "f" "data" text: (open-block 'para none) continue in-para (close-block) 
            after-para: () 
            whitespace: () 
            "^/" (emit [[para]]) 
            "-" (emit [[hrule]]) 
            "1" (open-block 'header1 none) in-para (close-block) 
            "2" (open-block 'header2 none) in-para (close-block) 
            "3" (open-block 'header3 none) in-para (close-block) 
            "4" (open-block 'header4 none) in-para (close-block) 
            "5" (open-block 'header5 none) in-para (close-block) 
            "6" (open-block 'header6 none) in-para (close-block) 
            "1'" "1’" (open-block 'header1* none) in-para (close-block) 
            "2'" "2’" (open-block 'header2* none) in-para (close-block) 
            "3'" "3’" (open-block 'header3* none) in-para (close-block) 
            "*" "**" (open-block 'bullets none) continue in-ulist (close-block) 
            "#" "##" (open-block 'enum none) continue in-olist (close-block) 
            "o" "x" (open-block 'checks none) continue in-checklist (close-block) 
            ">" (open-block 'para compose [indent: (opts)]) in-para (close-block) 
            "::" (open-block 'para [indent: 3]) in-para (close-block) 
            ":" (open-block 'definitions none) continue in-dlist (close-block) 
            "box" (open-block 'box merge-style/copy default-box opts) in-box (close-block) 
            "toc" (open-block 'section opts open-block 'toc none) in-toc (close-block) 
            "table" (open-table opts) in-table (close-block) 
            "c" (open-block 'para [text-halign: center]) in-para (close-block) 
            "center" (open-block 'center none) in-center (close-block) 
            "l" (open-block 'para [text-halign: left]) in-para (close-block) 
            "left" (open-block 'left none) in-left (close-block) 
            "r" (open-block 'para [text-halign: right]) in-para (close-block) 
            "right" (open-block 'right none) in-right (close-block) 
            "j" (open-block 'para [text-halign: justify]) in-para (close-block) 
            "justify" (open-block 'justify none) in-just (close-block) 
            "example" "html" "rebol" "makedoc" (emit [reduce ['escape cmd opts]]) 
            "csv" (handle-csv opts) 
            "repeat" (open-block 'repeat any [opts default-repeat]) in-repeat (close-block) 
            "center." continue rewind? in-center 
            "left." continue rewind? in-left 
            "right." continue rewind? in-right 
            "justify." continue rewind? in-just 
            "box." continue rewind? in-box 
            "table." continue rewind? in-table
        ] 
        in-center: inherit in-block [
            "center." override after-para return
        ] 
        in-left: inherit in-block [
            "left." override after-para return
        ] 
        in-right: inherit in-block [
            "right." override after-para return
        ] 
        in-just: inherit in-block [
            "justify." override after-para return
        ] 
        in-repeat: inherit in-block [
            "repeat." override after-para return
        ] 
        in-para: inherit common [
            text: whitespace: (emit opts) 
            "^/" override after-para return 
            "b" (open-block 'bold none) in-bold (close-block) 
            "i" (open-block 'italic none) in-italic (close-block) 
            "s" (open-block 'strike none) in-strike (close-block) 
            "" (emit [reduce ['qlink opts]]) 
            "link" (open-block 'link-proto opts) in-link (close-block) 
            "f" (open-block 'font opts) in-font (close-block) 
            "image" (
                if opts [
                    opts: merge-style/copy default-image opts 
                    if opts/src [opts/src: process-image-url opts/src] 
                    emit [reduce ['image 'opts make-style opts]]
                ]
            ) 
            "anchor" (open-block 'anchor opts if opts [insert/only insert tail anchors opts out]) in-anchor (close-block) 
            "data" (emit [reduce ['data make-style merge-style/copy default-data opts]]) 
            "repeat" (open-block 'repeat any [opts default-repeat]) in-repeat-inline (close-block)
        ] 
        in-repeat-inline: inherit in-para [
            "repeat." return
        ] 
        in-link: inherit in-para [
            "link." return
        ] 
        in-anchor: inherit in-para [
            "anchor." return
        ] 
        in-font: inherit in-para [
            "f." return
        ] 
        in-bold: inherit in-para [
            "b" in-bold 
            "b." return
        ] 
        in-italic: inherit in-para [
            "i" in-italic 
            "i." return
        ] 
        in-strike: inherit in-para [
            "s" in-strike 
            "s." return
        ] 
        in-underline: inherit in-para [
            "u" in-underline 
            "u." return
        ] 
        in-dlist: [
            ":" (open-block 'term none) in-para (close-block) 
            "::" (open-block 'desc none) in-para (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-checklist: [
            "o" (open-block 'check compose [checked: (no)]) in-para (close-block) 
            "x" (open-block 'check compose [checked: (yes)]) in-para (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-ulist: [
            "*" (open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [type: (opts)]]) in-para (close-block) 
            "**" (open-block 'bullets none) continue in-ulist2 (close-block) 
            "##" (open-block 'enum none) continue in-olist2 (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-olist: [
            "#" (open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [force: (opts)]]) in-para (close-block) 
            "##" (open-block 'enum none) continue in-olist2 (close-block) 
            "**" (open-block 'bullets none) continue in-ulist2 (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-ulist2: [
            "**" (open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [type: (opts)]]) in-para (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-olist2: [
            "##" (open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [force: (opts)]]) in-para (close-block) 
            after-para: () 
            default: continue return
        ] 
        in-box: [
            "^/" after-para: box-contents 
            "" "link" "b" "i" "f" "s" "anchor" "data" "image" text: (open-block 'title none) continue in-para (close-block) 
            "box." override after-para return 
            default: continue box-contents
        ] 
        box-contents: inherit in-block [
            "box." continue return
        ] 
        in-toc: [
            "^/" (
                if default-toc-title [
                    open-block 'title none 
                    emit default-toc-title 
                    close-block
                ] 
                close-block
            ) in-toc2 
            after-para: (close-block) in-toc2 
            "" "link" "b" "i" "f" "s" "anchor" "data" "image" text: (open-block 'title none) continue in-para (close-block) 
            "toc." (close-block) override after-para return 
            default: (close-block) continue in-toc2
        ] 
        in-toc2: inherit in-block [
            "toc." override after-para 2 return
        ] 
        in-table: inherit common [
            "row" (emit ['row opts]) 
            "column" (emit ['column opts]) 
            "row." "column." (emit 'return) 
            "cell" (open-block/only 'cell opts) in-cell-block (close-block) 
            "table." return 
            "span" (emit ['span opts]) 
            default: (open-block 'cell none) continue in-cell (close-block) 
            "repeat" (open-block 'repeat any [opts default-repeat]) in-table-repeat (close-block)
        ] 
        in-cell-block: inherit in-block [
            "cell." return
        ] 
        in-cell: inherit in-block [
            "*" (
                open-block 'bullets none 
                open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [type: (opts)]]
            ) in-para (close-block close-block) 
            "**" (
                open-block 'bullets none 
                open-block 'bullets none 
                open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [type: (opts)]]
            ) in-para (close-block close-block close-block) 
            "#" (
                open-block 'enum none 
                open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [force: (opts)]]
            ) in-para (close-block close-block) 
            "##" (
                open-block 'enum none 
                open-block 'enum none 
                open-block 'item if all [opts opts: attempt [to integer! opts]] [compose [force: (opts)]]
            ) in-para (close-block close-block close-block) 
            "::" (open-block 'para [indent: 2]) in-para (close-block) 
            ":" (open-block 'definitions none) override define in-cell-dlist (close-block) 
            "o" (open-block 'checks none open-block 'check no) in-para (close-block close-block) 
            "x" (open-block 'checks none open-block 'check yes) in-para (close-block close-block) 
            after-para: "^/" return
        ] 
        in-table-repeat: inherit in-table [
            "repeat." return
        ] 
        in-cell-dlist: [
            define: (open-block 'term none) in-para (close-block) 
            "::" (open-block 'desc none) in-para (close-block) 
            after-para: () 
            default: continue 2 return
        ] 
        eval-qlink: func [target /local a] [
            either a: select anchors target [
                compose/deep [alink opts [target: (target)] (skip a 3)]
            ] [
                compose/deep [link opts [(a: process-link target)] (select a [text:])]
            ]
        ] 
        eval-link: func [target] [
            either find anchors target [
                compose/deep [alink opts [target: (target)]]
            ] [
                compose/deep [link opts [(process-link target)]]
            ]
        ] 
        eval-data: func [opts /local val p] [
            opts: construct/with opts context [name: none index: none] 
            val: eval-var opts/name 
            if not val [return []] 
            either object? val [
                p: in pickers val/type 
                if p [
                    do get in get p type?/word opts/index val opts/index
                ]
            ] [
                reduce [val]
            ]
        ] 
        pickers: context [
            csv: context [
                none!: func [val index] [
                    "Not yet."
                ] 
                integer!: func [val index] [
                    csv-row/none! context [content: pick val/contents index] none
                ] 
                pair!: func [val index] [
                    pick pick val/contents index/y index/x
                ]
            ] 
            table: context [
                none!: func [val index] [
                    "Not yet."
                ] 
                integer!: func [val index] [
                    "Not yet."
                ] 
                pair!: func [val index] [
                    val: pick get in pick val/table index/y 'contents index/x 
                    if val/type = 'span [val: val/reference] 
                    cell/none! val none
                ]
            ] 
            table-proto: context [
                none!: integer!: pair!: func [val index] [
                    rewrite val/contents rewrite-rules 
                    eval-data compose [name: (val/name) index: (index)]
                ]
            ] 
            alias: context [
                none!: integer!: pair!: func [val index] [
                    eval-data compose [name: (val/dest) index: (index)]
                ]
            ] 
            cell: context [
                none!: integer!: pair!: func [val index] [
                    compose/deep [[
                            cell-if (either val/style ['opts] [[]]) (either val/style [reduce [make-style/ignore val/style [position]]] [[]]) (either val/spansize ['span] [[]]) (any [val/spansize []]) (val/out)
                        ]]
                ]
            ] 
            csv-row: context [
                none!: func [val index] [
                    either empty? val/content [[]] [
                        index: make block! 3 * length? val/content 
                        insert index first val/content 
                        foreach cell next val/content [
                            insert insert tail index " " cell
                        ] 
                        index
                    ]
                ] 
                integer!: func [val index] [
                    pick val/content index
                ] 
                pair!: func [val index] [
                    pick val/content index/x
                ]
            ] 
            table-row: none
        ] 
        eval-var: func [var] [
            if var: any [select/skip last local-vars var 2 select/skip vars var 2] [first var]
        ] 
        local-vars: [[]] 
        eval-repeat: func [spec body /local result var1 var2 val val2 val3 iter] [
            result: make block! 16 
            parse spec [
                integer! end (loop spec/1 [insert tail result copy/deep body]) 
                | 
                set var1 [word! | string! | into [some [word! | string!]]] opt 'in set var2 [word! | string!] end (
                    if val: eval-var form var2 [
                        insert/only tail local-vars local: copy last local-vars 
                        local: tail local 
                        if object? val [
                            iter: in iterators val/type 
                            if iter [iter: get iter iter/iterate val local var1 result body]
                        ] 
                        remove back tail local-vars
                    ]
                ) 
                | 
                set var1 [word! | string!] 
                opt 'from set val skip 
                opt 'to set val2 skip [['by | 'skip | 'step | none] set val3 skip | (val3: none)] end (
                    attempt [
                        insert/only tail local-vars local: copy last local-vars 
                        local: tail local 
                        for i val val2 any [val3 either val > val2 [-1] [1]] [
                            clear local 
                            insert insert tail local form var1 form i 
                            insert tail result rewrite copy/deep body rewrite-rules
                        ] 
                        remove back tail local-vars
                    ]
                )
            ] 
            result
        ] 
        iterators: context [
            csv: context [
                iterate: func [val locals var result body /local bind-var] [
                    bind-var: get in binders either block? var ['multi] ['single] 
                    foreach row val/contents [
                        clear locals 
                        bind-var locals var row 
                        insert tail result rewrite copy/deep body rewrite-rules
                    ]
                ] 
                binders: context [
                    single: func [local var row] [
                        insert insert tail local form var context [type: 'csv-row content: row]
                    ] 
                    multi: func [local vars row] [
                        foreach var vars [
                            insert insert tail local form var row/1 
                            row: next row
                        ]
                    ]
                ]
            ] 
            table: context [
                iterate: func [table locals var result body /local bind-var rows] [
                    bind-var: get in binders either block? var ['multi] ['single] 
                    rows: table/table 
                    if not all [table/style any [table/style/headerless table/style/vertical]] [rows: next rows] 
                    foreach row rows [
                        clear locals 
                        bind-var locals var row 
                        insert tail result rewrite copy/deep body rewrite-rules
                    ]
                ] 
                binders: context [
                    single: func [local var row] [
                        insert insert tail local form var make row [type: 'table-row]
                    ] 
                    multi: func [locals vars row /local i cell] [
                        i: 1 
                        foreach var vars [
                            cell: pick row/contents i 
                            if cell/type = 'span [cell: cell/reference] 
                            insert insert tail locals form var cell 
                            i: i + 1
                        ]
                    ]
                ]
            ] 
            table-proto: context [
                iterate: func [tablep local var result body] [
                    rewrite tablep/contents rewrite-rules 
                    table/iterate eval-var tablep/name local var result body
                ]
            ] 
            alias: context [
                iterate: func [alias locals var result body /local iter] [
                    alias: eval-var alias/dest 
                    iter: in iterators alias/type 
                    if iter [
                        iter/iterate alias locals var result body
                    ]
                ]
            ]
        ]
    ] 
    out: [] 
    init-stage3: does [
        clear out 
        clear stage3-ctx/blocks 
        clear stage3-ctx/vars 
        clear stage3-ctx/anchors 
        stage3-ctx/local-vars: copy [[]] 
        stage3-ctx/csvid: stage3-ctx/tabid: 1 
        insert out 'qml 
        stage3-fsm/init stage3-ctx/initial
    ] 
    end-stage3: does [
        stage3-fsm/end 
        rewrite out rewrite-rules 
        make-toc out 
        set-enum-counts out 
        out
    ] 
    merge-style: func [old new /copy /local val] [
        if object? new [
            either object? old [
                if copy [old: make old []] 
                foreach word next first new [
                    if val: get in new word [
                        set in old word val
                    ]
                ]
            ] [
                old: new
            ]
        ] 
        old
    ] 
    rewrite-rules: use [x y z] [[['table-proto ['opts set x skip | (x: none)] y: to end] [(stage3-ctx/generate-table x y)] [into ['hidden-table]] [] [into ['repeat 'opts set x block! into ['enum y: to end]]] [[enum [repeat opts [(x)] (y)]]] [into ['repeat 'opts set x block! into ['bullets y: to end]]] [[bullets [repeat opts [(x)] (y)]]] [into ['repeat 'opts set x block! y: to end]] [(stage3-ctx/eval-repeat x y)] [into ['data none!]] [] [into ['data set x block!]] [(stage3-ctx/eval-data x)] [into ['qlink none!]] [] ['qlink set x string!] [(stage3-ctx/eval-qlink x)] ['link-proto 'opts set x url!] [link opts [target: (x)]] ['link-proto 'opts set x string!] [(stage3-ctx/eval-link x)] ['anchor 'opts set x string!] [anchor opts [name: (x)]] [y: into ['cell-if opt ['opts skip] opt ['span skip] opt ['header] x: to end]] [(either 'row = first head y [y/1/1: 'cell copy/part y 1] [x])] [into [x: 'para 'opts set z block! any [y: into [block-level to end] :y break | skip] into [block-level to end] to end]] [[(copy/part x y)] (copy/part y 1) [para opts [(z)] (next y)]] [into [x: 'para any [y: into [block-level to end] :y break | skip] into [block-level to end] to end]] [[(copy/part x y)] (copy/part y 1) [para (next y)]] [y: ['para | 'item] opt ['opts skip] any [z: into ['para to end] :z break | skip] into ['para to end] to end] [(
                    rewrite copy y [[into ['para 'opts set x block! y: to end]] [[font opts [(x)] (y)]] [into ['para opt ['opts skip] y: to end]] [(y)]]
                )] ['box ['opts set x block! | (x: [])] into ['title y: to end] end] [box opts [(x)] [para (y)]] [into ['bold]] [] [into ['italic]] [] [into ['strike]] [] [into ['font opt ['opts skip]]] [] [into ['font x: [block! | string!] to end]] [(x)] ['font 'opts set x block! into ['bold y: to end] end] [font opts [(x) bold: (true)] (y)] ['font 'opts set x block! into ['italic y: to end] end] [font opts [(x) italic: (true)] (y)] ['bold into ['font 'opts set x block! y: to end] end] [font opts [(x) bold: (true)] (y)] ['italic into ['font 'opts set x block! y: to end] end] [font opts [(x) italic: (true)] (y)] ['link 'opts set x block! into ['font 'opts set y block! z: to end] end] [link opts [(x) (y)] (z)] ['alink 'opts set x block! into ['font 'opts set y block! z: to end] end] [alink opts [(x) (y)] (z)] ['anchor 'opts set x block! into ['font 'opts set y block! z: to end] end] [anchor opts [(x) (y)] (z)] ['para ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [para opts [(x) (y)] (z)] ['header1 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header1 opts [(x) (y)] (z)] ['header1* ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header1* opts [(x) (y)] (z)] ['header2 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header2 opts [(x) (y)] (z)] ['header2* ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header2* opts [(x) (y)] (z)] ['header3 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header3 opts [(x) (y)] (z)] ['header3* ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header3* opts [(x) (y)] (z)] ['header4 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header4 opts [(x) (y)] (z)] ['header5 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header5 opts [(x) (y)] (z)] ['header6 ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [header6 opts [(x) (y)] (z)] ['item ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [item opts [(x) (y)] (z)] ['check ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [check opts [(x) (y)] (z)] ['term ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [term opts [(x) (y)] (z)] ['desc ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [desc opts [(x) (y)] (z)] ['title ['opts set x block! | (x: [])] into ['font 'opts set y block! z: to end] end] [title opts [(x) (y)] (z)]]] 
    block-level: [
        'hrule | 'header1 | 'header2 | 'header3 | 'header4 | 'header5 | 
        'header6 | 'bullets | 'enum | 'checks | 'definitions | 'box | 
        'table | 'center | 'left | 'right | 'justify | 'escape | 'header1* | 
        'header2* | 'header3*
    ] 
    numbering: context [
        toc-counters: [0 0 0 0 0 0] 
        toc-style: ["1. " "1[.1] "] 
        chars: complement charset "1AaIi[]0" 
        make-number: func [level /local style i res mk1 mk2 rpt term cont] [
            if not toc-style [return ""] 
            i: 1 
            style: any [pick toc-style level last toc-style] 
            res: make string! 16 
            poke toc-counters level 1 + pick toc-counters level 
            change/dup skip toc-counters level 0 subtract length? toc-counters level 
            term: [
                mk1: any chars mk2: (insert/part tail res mk1 mk2) [
                    "1" (insert tail res pick toc-counters i) 
                    | 
                    "A" (insert tail res pick "ABCDEFGHIJKLMNOPQRSTUVWXYZ" min 26 pick toc-counters i) 
                    | 
                    "a" (insert tail res pick "abcdefghijklmnopqrstuvwxyz" min 26 pick toc-counters i) 
                    | 
                    "I" (insert tail res uppercase to-roman pick toc-counters i) 
                    | 
                    "i" (insert tail res to-roman pick toc-counters i) 
                    | 
                    "0"
                ] 
                mk1: any chars mk2: (insert/part tail res mk1 mk2) (i: i + 1 cont: either i > level ['break] [[]]) cont
            ] 
            parse/all/case style [
                some [rpt: "[" some term "]" (cont: either i > level ['break] [[:rpt]]) cont | term] 
                rpt: (insert tail res rpt)
            ] 
            res
        ] 
        romans: [["" "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix"] ["" "x" "xx" "xxx" "xl" "l" "lx" "lxx" "lxxx" "xc"] ["" "c" "cc" "ccc" "cd" "d" "dc" "dcc" "dccc" "cm"]] 
        to-roman: func [int /local res] [
            int: form int 
            res: make string! 16 
            forall int [
                insert tail res pick pick romans length? int int/1 - #"/"
            ] 
            res
        ] 
        set-style: func [style] [
            style: any [style default-number-style] 
            if none? style [toc-style: none exit] 
            if not toc-style: select/case [
                "1" ["1. " "1[.1] "] 
                "A" ["A. " "A[.1] "] 
                "a" ["a) " "a1) " "a1[.1]) "] 
                "I" ["I. " "I[.1] "] 
                "i" ["i) " "i[.1]) "]
            ] style [
                toc-style: normalize parse/all style "|"
            ]
        ] 
        reset: does [change/dup toc-counters 0 6] 
        normalize: func [style /local count] [
            insert/dup tail style last style 6 - length? style 
            style: copy/deep style 
            repeat level 6 [
                if not empty? style/:level [
                    count: 0 
                    parse/all/case style/:level [
                        some [
                            any chars [["1" | "A" | "a" | "I" | "i" | "0"] (count: count + 1) 
                                | ["[" | "]"] (count: 6)
                            ] any chars
                        ]
                    ] 
                    insert/dup style/:level #"0" level - count
                ]
            ] 
            style
        ]
    ] 
    collect: func [output doc rule /local node] [
        match doc [set node into rule (append/only output copy/deep node)] 
        output
    ] 
    mkopts: func [level id] [compose [number: (numbering/make-number level) id: (id)]] 
    make-toc: func [doc /local style toc here l headid] [
        headid: 1 
        match doc [
            'section [here: 'opts set style string! (remove/part here 2) :here | (style: none)] (numbering/set-style style) 
            into ['toc toc: to end] here: to end (
                numbering/reset 
                collect toc here [['header1 (l: 1) | 'header2 (l: 2) | 'header3 (l: 3)] [
                        'opts set here block! (append here mkopts l headid headid: headid + 1) 
                        | 
                        here: (here: insert/only insert here 'opts mkopts l headid headid: headid + 1) :here
                    ] 
                    to end 
                    | ['header4 (l: 4) | 'header5 (l: 5) | 'header6 (l: 6)] [
                        'opts set here block! (insert insert tail here [number:] numbering/make-number l) 
                        | 
                        here: (here: insert/only insert here 'opts compose [number: (numbering/make-number l)]) :here
                    ] 
                    end skip
                ] 
                rewrite toc [[into ['anchor opt ['opts skip] here: to end]] [(here)]]
            )
        ]
    ] 
    count: func [counter options] [
        if block? options [
            options: construct options 
            if all [in options 'force integer? options: attempt [to integer! options/force]] [set counter options]
        ] 
        options: get counter 
        set counter 1 + options 
        options
    ] 
    set-enum-counts: func [doc /local count1 count2 opts] [
        count1: count2: 1 
        match doc [
            'enum some [
                into [
                    'item [
                        'opts set opts block! (insert insert tail opts [number:] count 'count1 opts) 
                        | 
                        opts: (opts: insert/only insert opts 'opts compose [number: (count 'count1 opts)]) :opts
                    ] (count2: 1) to end 
                    | 
                    'enum some [
                        into [
                            'item [
                                'opts set opts block! (insert insert tail opts [number:] count 'count2 opts) 
                                | 
                                opts: (opts: insert/only insert opts 'opts compose [number: (count 'count2 opts)]) :opts
                            ] to end
                        ] 
                        | 
                        skip
                    ]
                ] 
                | 
                skip
            ]
        ]
    ] 
    process-link: func [target] [
        either parse/all target [["http://" | "mailto:" | "ftp://" | "www."] to end] [
            compose [target: (target) class: "external" text: (target)]
        ] [
            compose [target: (join http://www.qtask.com/qwiki.cgi?goto= target) class: "internal" text: (target)]
        ]
    ] 
    process-image-url: func [url] [
        url
    ] 
    build-search-index: func [doc [block!] /local rule result val anchor] [
        result: copy/deep [toa [] doc-start ""] 
        rule: [
            into [[
                    'para | 'header4 | 'header5 | 'header6 | 'bullets | 'enum | 'checks | 
                    'definitions | 'box | 'section | 'center | 'left | 'right | 'justify | 
                    'item | 'check | 'term | 'desc | 'header1* | 'header2* | 'header3*
                ] opt ['opts skip] any rule (insert tail last result newline) 
                | 
                val: ['header1 | 'header2 | 'header3] opt ['opts skip] (insert insert/only tail result val make string! 256) 
                any rule (insert tail last result newline) 
                | 
                'escape string! set val string! (insert insert tail last result val newline) 
                | 
                'table opt ['opts skip] opt [into ['columns to end]] any [
                    into [
                        'row opt ['opts skip] opt 'header any [
                            into ['cell opt ['opts skip] opt ['span skip] opt 'header any rule (insert tail last result " ")]
                        ] (insert tail last result newline)
                    ]
                ] 
                | ['bold | 'italic | 'strike | 'link | 'alink | 'font] opt ['opts skip] any rule 
                | 
                anchor: 'anchor opt [
                    'opts set val block! (
                        if val: select val [name:] [
                            insert/only insert/only insert tail result/2 val anchor pick tail result -2
                        ]
                    )
                ] any rule
            ] 
            | 
            set val string! (insert tail last result val) 
            | 
            skip
        ] 
        parse doc ['qml any rule] 
        result
    ] 
    search: func [
        "Search a QML document tree for a substring" 
        doc [block!] "The QML document tree (as returned by SCAN-DOC)" 
        text [string!] "The substring to search for" 
        /local 
        res anchor
    ] [
        res: make block! 16 
        doc: build-search-index doc 
        if anchor: find doc/2 text [
            insert/only insert/only res anchor/3 anchor/2
        ] 
        foreach [header string] skip doc 2 [
            while [string: find/tail string text] [
                insert insert/only tail res header copy/part skip string -50 120
            ]
        ] 
        res
    ] 
    scan-doc: func [
        {Parse a QML text string and return a QML document tree} 
        text [string!] 
        /with defaults [block!] "Default options for commands" 
        /keep {Keep default options from previous session (ignores /with)}
    ] [
        init-stage2 
        init-stage3 
        if not keep [set-defaults defaults] 
        parse-qml text if defaults [select defaults "alias"] 
        end-stage2 
        end-stage3
    ]
]