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 [{ emit-inline initialize data emit [ emit-inline data emit
][
tag: to-tag rejoin ["ol" to-attr reversed to-attr start]
]
]
][
context [tag: end:
start: 1]
]
]
;-- Paragraph States
initial: [
options: place: topics: ()
; para: (emit newline
])
enum: enum2: enum3: (feed emit [ newline
])
code: (feed emit [
])
output: (feed emit data) ; to output html directly
define-term: (feed emit sanitize data
) continue in-deflist (feed emit
)
image: (feed emit )
youtube: vimeo: (feed emit )
break: (feed emit
)
figure-in: (feed emit )
figure-out: (raise "Unbalanced Figure")
sidebar-in: (feed emit )
sidebar-out: (raise "Unbalanced Sidebar")
table-in:
(feed emit {
}) table-header (feed emit {^/ |
---|
] emit-inline data emit [
]) in-note (emit}) in-column (feed emit { |
][]) 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 emitemit-inline data emit
) sect2: (feed emitemit-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 [ newlinenewline
newline]) bullet3: (feed emit [- ] emit-inline data) in-bul2 (emit [
newlinenewline
newline]) enum2: (feed emit [- ]) continue in-bul2 (emit [
newlinenewline
newline]) enum3: (feed emit [- ] emit-inline data) in-enum2 (emit [
newlinenewline
newline]) default: continue return ] in-bul2: [ bullet2: (feed emit [- ]) continue in-enum2 (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 emitemit-inline data emit ) default: continue return ] in-enum: [ enum: (emit [ newline] emit-inline data) bullet2: (feed emit [ newlinenewline
newline]) bullet3: (feed emit [- ] emit-inline data) in-bul2 (emit [
newlinenewline
newline]) enum2: (feed emit [- ]) continue in-bul2 (emit [
newlinenewline
newline]) enum3: (feed emit [- ] emit-inline data) in-enum2 (emit [
newlinenewline
newline]) default: continue return ] in-enum2: [ enum2: (emit [- ]) continue in-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 emitemit-inline data emit ) default: continue return ] in-deflist: [ define-term: (feed emitemit-inline data emit ) define-desc: (feed emitemit-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 emitemit-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 )
(emitreturn > 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]) 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 [