Rebol [
    Title: "HTML Emitter"
    Type: 'emitter
    License: %license.r
]

with: func [
    "Binds and evaluates a block to a specified context."
    object [any-word! object! port!] "Target context."
    block [any-block!] "Block to be bound."
    /only "Returns the block unevaluated."
][
    block: bind block object
    either only [block] :block
]

else: :true
press: :rejoin
envelop: func [
    "Returns a block, encloses any value not already of any-block type."
    values [any-type!]
][
    case [
        any-block? values [values]
        none? values [make block! 0]
        else [reduce [values]]
    ]
]


;-- Helpers
last-feed: none
feed: does [last-feed: emit newline]

emit-boilerplate: func [boilerplate [string!] /local lines name value][
    lines: parse/all boilerplate "^/"
    foreach line lines [
        either parse/all line [copy name to ": " 2 skip copy value to end][
            emit-inline reduce [":" name ": " value]
        ][
            emit-inline line
        ] feed
    ]
]

open-table: func [position /local count][
    count: 0
    parse position [
        'table-in skip
        some [
              'column skip
            | 'table-row to end
            | skip skip (count: count + 1)
        ]
    ]
    rejoin [{[grid="rows",options="header",cols=} count "]"]
]

indentation: 1
indent: func [para /local tab][
    tab: head insert/dup next copy "^/" " " indentation * 4
    replace/all compose [(next tab) (para)] <br /> tab 
]

emit-smarttag: func [spec [block!] /local tag errs rel][
    errs: []
    unless switch take tag: copy spec [
        link [
            if tag: match tag [
                href: file! | url! | email!
                anchor: opt string!
                rel: opt get-word! is within [:flow :nofollow]
            ][
                with tag [
                    anchor: any [anchor form href]
                    if email? href [href: join #[url! "mailto:"] href]
                    emit ["<a" to-attr href to-attr rel ">" sanitize anchor </a>]
                ]
            ]
        ]
        wiki [
            if tag: match tag [
                href: string!
                anchor: opt string!
            ][
                with tag [
                    anchor: any [anchor href]
                    href: url-encode/wiki href
                    emit ["<a" to-attr href ">" sanitize anchor </a>]
                ]
            ]
        ]
        img image icon [
            either tag: match/report-to tag [
                src: file! | url! else "Image Tag Needs Valid Source"
                alt: string! else "Image tag requires ALT text"
                size: opt pair!
            ] errs [
                use [width height] with/only tag [
                    width: all [size/x > -1 size/x]
                    height: all [size/y > -1 size/y]
                    emit ["<img" to-attr src to-attr width to-attr height to-attr alt { class="icon" />}]
                ]
            ][
                foreach [key reasons] errs [
                    foreach reason reasons [
                        emit ["[" sanitize reason "]"]
                    ]
                ]
            ]
        ]
    ][
        emit {<span class="attention">!Unable to parse tag!</span>}
    ]
]

emit-image: func [spec [block!] /local out image][
    either image: match spec [
        src: file! | url!
        size: opt pair!
        alt: string!
        title: opt string!
        href: opt file! | url!
    ][
        out: copy []
        with image [
            src: to-attr src
            alt: to-attr alt
            title: to-attr title
            size: any [size -1x-1]
            width: either 0 > width: size/x [""][to-attr width]
            height: either 0 > height: size/y [""][to-attr height]
            repend out ["<img" width height src alt title " />"]
            if href [
                insert append out </a> reduce ["<a" to-attr href ">"]
            ]
        ]

        emit [{<div class="img">^/} press out {^/</div>}]
    ][
        raise ["Invalid Image Spec #" sanitize mold spec]
    ]
]

emit-video: func [spec [block!] /youtube /vimeo /local video][
    unless any [youtube vimeo][raise "Invalid Video Request" exit]

    either video: match spec [
        id: issue!
        ratio: opt pair! is within [16x9 4x3]
    ][
        video/id: join case [
            youtube [https://youtube.com/embed/]
            vimeo [http://player.vimeo.com/video/]
        ] sanitize video/id
        emit [{<div class="tube">^/<iframe type="text/html" src="} video/id {"></iframe>^/</div>}]
    ][
        raise ["Invalid Video Spec #" sanitize mold spec]
    ]
]

;-- Paragraph States
initial: [
    options: ()
    para: (
        emit-inline data
        emit head insert/dup next copy "^/^/" "=" length? out
    ) boilerplate (feed emit "////^/; done")
    default: continue boilerplate
]

boilerplate: [
    code: (emit-boilerplate data) normal
    default: continue normal
]

in-block: normal: [
    para: (feed emit-inline data feed)
    sect1: (feed emit "== " emit-inline data feed)
    sect2: (feed emit "=== " emit-inline data feed)
    sect3: (feed emit "==== " emit-inline data feed)
    sect4: (feed emit "===== " emit-inline data feed)
    bullet: (feed emit "* " emit-inline data feed)
    bullet2: (feed emit "** " emit-inline data feed)
    bullet3: (feed emit "*** " emit-inline data feed)
    enum: (feed emit ". " emit-inline data feed)
    enum2: (feed emit ".. " emit-inline data feed)
    enum3: (feed emit "... " emit-inline data feed)
    code: (feed emit "----" feed emit-inline envelop detab data feed emit "----" feed)
    define-term: (feed emit-inline data emit "::") in-definition
    table-in: (feed emit open-table position feed emit "|===") in-table (feed emit "|===" feed)
    note-in: (if data [feed emit "." emit-inline data] feed emit "[NOTE]" feed emit "========") in-note (emit "========" feed)
    default: (emit form word)
]

in-definition: [
    ; define-term: (feed emit <dt> emit-inline data emit </dt>)
    define-desc: (feed emit-inline indent data feed)
    default: continue return
]

in-table: [
    table-row: (feed) column: ()
    para: (feed emit "| " emit-inline data)
    default: (feed emit ["| `" uppercase form word "` WHAT SHOULD I DO HERE???"])
    table-out: return
]

media: [
    youtube: (feed emit-video/youtube data) return
    vimeo: (feed emit-video/vimeo data) return
    image: (feed emit-image data) return
]

in-note: inherit normal [
    note-out: return
]


;-- Inline States
inline: [
    <p> ()
    default: continue paragraph
]

paragraph: [
    :string! (emit value)
    <b> (emit "*") in-bold (emit "*")
    <i> (emit "_") in-italic (emit "_")
    <q> (emit "``") in-qte (emit "''")
    <code> <var> (emit "`") in-code (emit "`")
    <br/> <br /> (feed)
    :integer! :char! (emit ["&#" to-integer value ";"])
    </> ()
    ; :block! (emit-smarttag value)
    default: "[???]"
]

in-bold: inherit paragraph [</b> return </> continue return]

in-italic: inherit paragraph [</i> return </> continue return]

in-qte: inherit paragraph [</q> return </> continue return]

in-code: inherit paragraph [</var> </code> return </> continue return]