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 ] press: :rejoin ;-- Helpers feed: does [emit newline] wrap: func [text [string! block!] tag [tag! none!]][ either tag [ insert text tag parse/all form tag ["<" tag: (insert tag "/") [to " " | to ">"] tag: (clear tag)] append text tag ][text] ] to-attr: func ['attr [word!]][ either get :attr [ press [" " form attr {="} sanitize form get :attr {"}] ][""] ] 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 ["" sanitize anchor ] ] ] ] wiki [ if tag: match tag [ href: string! anchor: opt string! ][ with tag [ anchor: any [anchor href] href: url-encode/wiki href emit ["" sanitize anchor ] ] ] ] 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 ["}] ] ][ foreach [key reasons] errs [ foreach reason reasons [ emit ["[" sanitize reason "]"] ] ] ] ] ][ emit {!Unable to parse tag!} ] ] 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 [""] if href [ insert append out reduce [""] ] ] emit [{
^/} press out {^/
}] ][ 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 [{
^/^/
}] ][ raise ["Invalid Video Spec #" sanitize mold spec] ] ] get-list-options: func [options [block!]][ either options: match options [ tag: opt 'bullets reversed: opt 'reversed start: opt integer! is more-than 0 ][ make options [ end: either tag = 'bullets [ tag:
][ tag: to-tag rejoin ["ol" to-attr reversed to-attr start] ] ] ][ context [tag:
    end:
start: 1] ] ] ;-- Paragraph States initial: [ options: place: topics: () ; para: (emit

emit-inline initialize data emit [

newline]) normal default: (emit "^/") continue normal (emit "^/^/") ] normal: [ para: (feed emit

emit-inline data emit

) sect1: (feed emit-sect 1 data unless no-indent [emit
]) in-sect (unless no-indent [emit
]) sect2: (feed emit-sect 2 data unless no-indent [emit
]) in-sect (unless no-indent [emit
]) sect3: (feed emit-sect 3 data) sect4: (feed emit-sect 4 data) bullet: bullet2: bullet3: (feed emit [
    newline
  • ] emit-inline data) in-bul (emit [
  • newline
]) enum: enum2: enum3: (feed emit [
    newline
  1. ] emit-inline data) in-enum (emit [
  2. newline
]) code: (feed emit [
 sanitize data 
]) output: (feed emit data) ; to output html directly define-term: (feed emit
) continue in-deflist (feed emit
) image: (feed emit
) continue media (feed emit
) youtube: vimeo: (feed emit
) continue media (feed emit
) break: (feed emit
) figure-in: (feed emit
) in-figure (feed emit
) figure-out: (raise "Unbalanced Figure") sidebar-in: (feed emit ) sidebar-out: (raise "Unbalanced Sidebar") table-in: (feed emit {^/
}) table-header (feed emit {^/
}) table-out: (raise "Unbalanced table-out") list-in: ( options: get-list-options data feed emit [options/tag
  • ] hold options ) in-list ( options: release feed emit [
  • options/end] ) center-in: (feed emit
    ) in-center (feed emit
    ) center-out: (raise "Unbalanced center-out") note-in: (feed emit [

    ] emit-inline data emit [

    ]) in-note (emit
    ) note-out: (raise "Unbalanced note-out") define-in: (feed emit [
    ] emit-inline data emit
    feed emit
    ) in-define (feed emit [
    ]) define-out: (raise "Unbalanced define-out") indent-in: (feed emit
    ) in-indent (feed emit
    ) indent-out: (raise "Unbalanced indent-out") column-in: (feed emit {
    }) in-column (feed emit {
    }) column-out: (raise "Unbalanced column-out") quote-in: (feed emit either find any [data []] 'pullquote [
    ][
    ]) in-quote (feed emit
    ) pullquote-in: (feed emit
    ) in-pullquote (feed emit
    ) column: (raise "column command not inside column group") group-in: in-group ; useless in normal mode, here just to enforce balanced commands group-out: (raise "Unbalanced Group-Out") ; default: (emit [

    uppercase/part form word 1 " Unknown

    "]) ] in-block: inherit normal [ sect1: (feed emit

    emit-inline data emit

    ) sect2: (feed emit

    emit-inline data emit

    ) ] in-list: inherit in-block [ list-item: (feed emit {
  • }) list-out: return ] in-bul: [ bullet: (emit [
  • newline
  • ] emit-inline data) bullet2: (feed emit [
      newline
    • ] emit-inline data) in-bul2 (emit [
    • newline
    newline]) bullet3: (feed emit [
      newline
    • ]) continue in-bul2 (emit [
    • newline
    newline]) enum2: (feed emit [
      newline
    1. ] emit-inline data) in-enum2 (emit [
    2. newline
    newline]) enum3: (feed emit [
      newline
    1. ]) continue in-enum2 (emit [
    2. newline
    newline]) default: continue return ] in-bul2: [ bullet2: (feed emit [
  • newline
  • ] emit-inline data) bullet3: (feed emit
      ) continue in-bul3 (feed emit
    ) enum3: (feed emit
      ) continue in-enum3 (feed emit
    ) default: continue return ] in-bul3: [ bullet3: (feed emit
  • emit-inline data emit
  • ) default: continue return ] in-enum: [ enum: (emit [ newline
  • ] emit-inline data) bullet2: (feed emit [
      newline
    • ] emit-inline data) in-bul2 (emit [
    • newline
    newline]) bullet3: (feed emit [
      newline
    • ]) continue in-bul2 (emit [
    • newline
    newline]) enum2: (feed emit [
      newline
    1. ] emit-inline data) in-enum2 (emit [
    2. newline
    newline]) enum3: (feed emit [
      newline
    1. ]) continue in-enum2 (emit [
    2. newline
    newline]) default: continue return ] in-enum2: [ enum2: (emit [
  • newline
  • ] emit-inline data) bullet3: (feed emit
      ) continue in-bul3 (feed emit [
    newline]) enum3: (feed emit
      ) continue in-enum3 (feed emit [
    newline]) default: continue return ] in-enum3: [ enum3: (feed emit
  • emit-inline data emit
  • ) default: continue return ] in-deflist: [ define-term: (feed emit
    emit-inline data emit
    ) define-desc: (feed emit
    emit-inline data emit
    ) default: continue return ] table-header: inherit in-block [ table-out: return table-row: (emit "^/") table-rows column: (emit "^/") ] table-rows: inherit in-block [ table-out: continue return ; back to table-header which goes back to caller table-row: (emit "^/") table-rows column: (emit "^/") ] in-table-define: [ define-desc: (emit
    emit-inline data emit "
    ^/") return ] in-group: inherit normal [ sect1: sect2: (raise "No Headings In Here!") group-out: return ] in-center: inherit in-block [ center-out: return ] media: [ youtube: (feed emit-video/youtube data) return vimeo: (feed emit-video/vimeo data) return image: (feed emit-image data) return ] in-figure: [ image: youtube: vimeo: continue media para: (feed emit
    emit-inline data emit
    ) group-in: (feed emit
    ) in-group (feed emit
    ) default: (raise "Content Misplaced in Figure") figure-out: return ] in-sidebar: inherit in-block [ sidebar-out: return ] in-note: inherit in-block [ sect1: sect2: (raise "No Headings In Here!") note-out: return ] in-quote: inherit in-block [ quote-out: (if data [emit [

    data

    ]]) return ] in-pullquote: inherit in-block [ pullquote-out: return ] in-define: inherit in-block [ define-out: return ] in-indent: inherit in-block [ indent-out: return ] in-column: inherit in-block [ column-out: return column: (emit {^/^/}) ] in-sect: inherit normal [ sect1: sect2: continue return ; pop out of the ] ;-- Inline States inline: [

    () default: continue paragraph ] paragraph: [ :string! (emit value) (emit ) in-bold (emit ) (emit ) in-italic (emit ) (emit ) in-qte (emit ) (emit ) in-dfn (emit ) (emit ) in-del (emit ) (emit ) in-ins (emit ) (emit ) in-cite (emit ) (emit ) in-code (emit ) (emit ) in-initial (emit )

    (emit
    ) :integer! :char! (emit ["&#" to-integer value ";"]) () :block! (emit-smarttag value) default: "[???]" ] in-bold: inherit paragraph [
    return continue return] in-italic: inherit paragraph [ return continue return] in-qte: inherit paragraph [ return continue return] in-dfn: inherit paragraph [ return continue return] in-del: inherit paragraph [ return continue return] in-ins: inherit paragraph [ return continue return] in-cite: inherit paragraph [ return continue return] in-code: inherit paragraph [ return continue return] in-initial: inherit paragraph [ return continue return]