Rewrite html.streams to use xml.literals
Slava Pestov
parent
d95e275b63
commit
0408788518
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2008 Your name.
|
||||
! Copyright (C) 2008 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax io.streams.string kernel strings
|
||||
urls lcs inspector present io ;
|
||||
|
|
@ -100,6 +100,6 @@ $nl
|
|||
{ $subsection farkup }
|
||||
"Creating custom components:"
|
||||
{ $subsection render* }
|
||||
"Custom components can emit HTML using the " { $vocab-link "html.elements" } " vocabulary." ;
|
||||
"Custom components can emit HTML using the " { $vocab-link "xml.literals" } " vocabulary." ;
|
||||
|
||||
ABOUT: "html.components"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
IN: html.components.tests
|
||||
USING: tools.test kernel io.streams.string
|
||||
io.streams.null accessors inspector html.streams
|
||||
html.elements html.components html.forms namespaces ;
|
||||
html.components html.forms namespaces
|
||||
xml.writer ;
|
||||
|
||||
[ ] [ begin-form ] unit-test
|
||||
|
||||
|
|
@ -163,9 +164,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ;
|
|||
|
||||
[ t ] [
|
||||
[ "object" inspector render ] with-string-writer
|
||||
USING: splitting sequences ;
|
||||
"\"" split "'" join ! replace " with ' for now
|
||||
[ "object" value [ describe ] with-html-writer ] with-string-writer
|
||||
"object" value [ describe ] with-html-writer xml>string
|
||||
=
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -22,13 +22,6 @@ GENERIC: render* ( value name renderer -- xml )
|
|||
render* write-xml
|
||||
[ render-error ] when* ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: render-input ( value name type -- xml )
|
||||
[XML <input value=<-> name=<-> type=<->/> XML] ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SINGLETON: label
|
||||
|
||||
M: label render*
|
||||
|
|
@ -37,7 +30,7 @@ M: label render*
|
|||
SINGLETON: hidden
|
||||
|
||||
M: hidden render*
|
||||
drop "hidden" render-input ;
|
||||
drop [XML <input value=<-> name=<-> type="hidden"/> XML] ;
|
||||
|
||||
: render-field ( value name size type -- xml )
|
||||
[XML <input value=<-> name=<-> size=<-> type=<->/> XML] ;
|
||||
|
|
@ -163,9 +156,7 @@ M: farkup render*
|
|||
SINGLETON: inspector
|
||||
|
||||
M: inspector render*
|
||||
2drop [
|
||||
[ describe ] with-html-writer
|
||||
] with-string-writer <unescaped> ;
|
||||
2drop [ describe ] with-html-writer ;
|
||||
|
||||
! Diff component
|
||||
SINGLETON: comparison
|
||||
|
|
|
|||
|
|
@ -20,10 +20,6 @@ $nl
|
|||
$nl
|
||||
"Writing unescaped HTML to " { $vocab-link "html.streams" } ":"
|
||||
{ $subsection write-html }
|
||||
{ $subsection print-html }
|
||||
"Writing some common HTML patterns:"
|
||||
{ $subsection xhtml-preamble }
|
||||
{ $subsection simple-page }
|
||||
{ $subsection render-error } ;
|
||||
{ $subsection print-html } ;
|
||||
|
||||
ABOUT: "html.elements"
|
||||
|
|
|
|||
|
|
@ -6,6 +6,14 @@ xml.data xml.literals urls math math.parser combinators
|
|||
present fry io.streams.string xml.writer html ;
|
||||
IN: html.elements
|
||||
|
||||
SYMBOL: html
|
||||
|
||||
: write-html ( str -- )
|
||||
H{ { html t } } format ;
|
||||
|
||||
: print-html ( str -- )
|
||||
write-html "\n" write-html ;
|
||||
|
||||
<<
|
||||
|
||||
: elements-vocab ( -- vocab-name ) "html.elements" ;
|
||||
|
|
|
|||
|
|
@ -1,23 +1,10 @@
|
|||
! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
|
||||
! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg,
|
||||
! Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io kernel xml.data xml.writer io.streams.string
|
||||
xml.literals io.styles ;
|
||||
USING: kernel xml.data xml.writer xml.literals urls.encoding ;
|
||||
IN: html
|
||||
|
||||
SYMBOL: html
|
||||
|
||||
: write-html ( str -- )
|
||||
H{ { html t } } format ;
|
||||
|
||||
: print-html ( str -- )
|
||||
write-html "\n" write-html ;
|
||||
|
||||
: xhtml-preamble ( -- )
|
||||
"<?xml version=\"1.0\"?>" write-html
|
||||
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
|
||||
|
||||
: simple-page ( title head-quot body-quot -- )
|
||||
[ with-string-writer <unescaped> ] bi@
|
||||
: simple-page ( title head body -- xml )
|
||||
<XML
|
||||
<?xml version="1.0"?>
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
|
||||
|
|
@ -28,7 +15,10 @@ SYMBOL: html
|
|||
</head>
|
||||
<body><-></body>
|
||||
</html>
|
||||
XML> write-xml ; inline
|
||||
XML> ; inline
|
||||
|
||||
: render-error ( message -- )
|
||||
[XML <span class="error"><-></span> XML] write-xml ;
|
||||
: render-error ( message -- xml )
|
||||
[XML <span class="error"><-></span> XML] ;
|
||||
|
||||
: simple-link ( xml url -- xml' )
|
||||
url-encode swap [XML <a href=<->><-></a> XML] ;
|
||||
|
|
@ -1,33 +1,33 @@
|
|||
IN: html.streams
|
||||
USING: help.markup help.syntax kernel strings io io.styles
|
||||
quotations ;
|
||||
quotations xml.data ;
|
||||
|
||||
HELP: browser-link-href
|
||||
{ $values { "presented" object } { "href" string } }
|
||||
{ $contract "Outputs a link to a page displaying a presentation of the given object. This word is called when " { $link write-object } " is called on " { $link html-stream } " instances." } ;
|
||||
HELP: url-of
|
||||
{ $values { "object" object } { "url" string } }
|
||||
{ $contract "Outputs a link to a page displaying a presentation of the given object. This word is called when " { $link write-object } " is called on " { $link html-writer } " instances." } ;
|
||||
|
||||
HELP: html-stream
|
||||
{ $class-description "A formatted output stream which emits HTML markup." } ;
|
||||
HELP: html-writer
|
||||
{ $class-description "A formatted output stream which accumulates HTML markup as " { $vocab-link "xml.data" } " types. The " { $slot "data" } " slot contains a sequence with all markup so far." } ;
|
||||
|
||||
HELP: <html-stream>
|
||||
{ $values { "stream" "an output stream" } { "html-stream" html-stream } }
|
||||
{ $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ;
|
||||
HELP: <html-writer>
|
||||
{ $values { "html-writer" html-writer } }
|
||||
{ $description "Creates a new formatted output stream which accumulates HTML markup in its " { $snippet "data" } " slot." } ;
|
||||
|
||||
HELP: with-html-writer
|
||||
{ $values { "quot" quotation } }
|
||||
{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." }
|
||||
{ $values { "quot" quotation } { "xml" xml-chunk } }
|
||||
{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-writer } ". When the quotation returns, outputs the accumulated HTML markup." }
|
||||
{ $examples
|
||||
{ $example
|
||||
"USING: io io.styles html.streams ;"
|
||||
"[ \"Hello\" { { font-style bold } } format nl ] with-html-writer"
|
||||
"<span style='font-style: normal; font-weight: bold; '>Hello</span><br/>"
|
||||
"USING: io io.styles html.streams xml.writer ;"
|
||||
"[ \"Hello\" { { font-style bold } } format nl ] with-html-writer write-xml"
|
||||
"<span style=\"font-style: normal; font-weight: bold; \">Hello</span><br/>"
|
||||
}
|
||||
} ;
|
||||
|
||||
ARTICLE: "html.streams" "HTML streams"
|
||||
"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream."
|
||||
{ $subsection html-stream }
|
||||
{ $subsection <html-stream> }
|
||||
"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "io.styles" } " by constructing HTML markup in the form of " { $vocab-link "xml.data" } " types."
|
||||
{ $subsection html-writer }
|
||||
{ $subsection <html-writer> }
|
||||
{ $subsection with-html-writer } ;
|
||||
|
||||
ABOUT: "html.streams"
|
||||
|
|
|
|||
|
|
@ -1,17 +1,14 @@
|
|||
USING: html.streams html.streams.private accessors io
|
||||
io.streams.string io.styles kernel namespaces tools.test
|
||||
xml.writer sbufs sequences inspector colors ;
|
||||
xml.writer sbufs sequences inspector colors xml.writer
|
||||
classes.predicate prettyprint ;
|
||||
IN: html.streams.tests
|
||||
|
||||
: make-html-string
|
||||
[ with-html-writer ] with-string-writer ; inline
|
||||
: make-html-string ( quot -- string )
|
||||
[ with-html-writer write-xml ] with-string-writer ; inline
|
||||
|
||||
[ [ ] make-html-string ] must-infer
|
||||
|
||||
[ ] [
|
||||
512 <sbuf> <html-stream> drop
|
||||
] unit-test
|
||||
|
||||
[ "" ] [
|
||||
[ "" write ] make-html-string
|
||||
] unit-test
|
||||
|
|
@ -24,31 +21,26 @@ IN: html.streams.tests
|
|||
[ "<" write ] make-html-string
|
||||
] unit-test
|
||||
|
||||
[ "<" ] [
|
||||
[ "<" H{ } output-stream get format-html-span ] make-html-string
|
||||
] unit-test
|
||||
|
||||
TUPLE: funky town ;
|
||||
|
||||
M: funky browser-link-href
|
||||
"http://www.funky-town.com/" swap town>> append ;
|
||||
M: funky url-of "http://www.funky-town.com/" swap town>> append ;
|
||||
|
||||
[ "<a href='http://www.funky-town.com/austin'><</a>" ] [
|
||||
[ "<a href=\"http://www.funky-town.com/austin\"><</a>" ] [
|
||||
[
|
||||
"<" "austin" funky boa write-object
|
||||
] make-html-string
|
||||
] unit-test
|
||||
|
||||
[ "<span style='font-family: monospace; '>car</span>" ]
|
||||
[ "<span style=\"font-family: monospace; \">car</span>" ]
|
||||
[
|
||||
[
|
||||
"car"
|
||||
H{ { font "monospace" } }
|
||||
H{ { font-name "monospace" } }
|
||||
format
|
||||
] make-html-string
|
||||
] unit-test
|
||||
|
||||
[ "<span style='color: #ff00ff; '>car</span>" ]
|
||||
[ "<span style=\"color: #ff00ff; \">car</span>" ]
|
||||
[
|
||||
[
|
||||
"car"
|
||||
|
|
@ -57,7 +49,7 @@ M: funky browser-link-href
|
|||
] make-html-string
|
||||
] unit-test
|
||||
|
||||
[ "<div style='background-color: #ff00ff; white-space: pre; font-family: monospace; '>cdr</div>" ]
|
||||
[ "<div style=\"background-color: #ff00ff; white-space: pre; font-family: monospace;\">cdr</div>" ]
|
||||
[
|
||||
[
|
||||
H{ { page-color T{ rgba f 1 0 1 1 } } }
|
||||
|
|
@ -65,10 +57,10 @@ M: funky browser-link-href
|
|||
] make-html-string
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"<div style='white-space: pre; font-family: monospace; '></div>"
|
||||
] [
|
||||
[ "<div style=\"white-space: pre; font-family: monospace;\"></div>" ] [
|
||||
[ H{ } [ ] with-nesting nl ] make-html-string
|
||||
] unit-test
|
||||
|
||||
[ ] [ [ { 1 2 3 } describe ] with-html-writer ] unit-test
|
||||
[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
|
||||
|
||||
[ ] [ [ \ predicate-instance? def>> . ] with-html-writer drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: combinators generic assocs io io.styles
|
||||
io.files continuations io.streams.string kernel math math.order
|
||||
math.parser namespaces make quotations assocs sequences strings
|
||||
words html.elements xml.entities sbufs continuations destructors
|
||||
accessors arrays urls.encoding html ;
|
||||
USING: accessors kernel assocs io io.styles math math.order math.parser
|
||||
sequences strings make words combinators macros xml.literals html fry
|
||||
destructors ;
|
||||
IN: html.streams
|
||||
|
||||
GENERIC: browser-link-href ( presented -- href )
|
||||
GENERIC: url-of ( object -- url )
|
||||
|
||||
M: object browser-link-href drop f ;
|
||||
M: object url-of drop f ;
|
||||
|
||||
TUPLE: html-stream stream last-div ;
|
||||
TUPLE: html-writer data last-div ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! stream-nl after with-nesting or tabular-output is
|
||||
! ignored, so that HTML stream output looks like
|
||||
|
|
@ -25,37 +25,28 @@ TUPLE: html-stream stream last-div ;
|
|||
: a-div ( stream -- stream )
|
||||
t >>last-div ; inline
|
||||
|
||||
: <html-stream> ( stream -- html-stream )
|
||||
f html-stream boa ;
|
||||
: new-html-writer ( class -- html-writer )
|
||||
new V{ } clone >>data ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: html-sub-stream < html-stream style parent ;
|
||||
TUPLE: html-sub-stream < html-writer style parent ;
|
||||
|
||||
: new-html-sub-stream ( style stream class -- stream )
|
||||
new
|
||||
512 <sbuf> >>stream
|
||||
new-html-writer
|
||||
swap >>parent
|
||||
swap >>style ; inline
|
||||
|
||||
: end-sub-stream ( substream -- string style stream )
|
||||
[ stream>> >string ] [ style>> ] [ parent>> ] tri ;
|
||||
[ data>> ] [ style>> ] [ parent>> ] tri ;
|
||||
|
||||
: object-link-tag ( style quot -- )
|
||||
presented pick at [
|
||||
browser-link-href [
|
||||
<a url-encode =href a> call </a>
|
||||
] [ call ] if*
|
||||
] [ call ] if* ; inline
|
||||
: object-link-tag ( xml style -- xml )
|
||||
presented swap at [ url-of [ simple-link ] when* ] when* ;
|
||||
|
||||
: href-link-tag ( style quot -- )
|
||||
href pick at [
|
||||
<a url-encode =href a> call </a>
|
||||
] [ call ] if* ; inline
|
||||
: href-link-tag ( xml style -- xml )
|
||||
href swap at [ simple-link ] when* ;
|
||||
|
||||
: hex-color, ( color -- )
|
||||
[ red>> ] [ green>> ] [ blue>> ] tri
|
||||
[ 255 * >fixnum >hex 2 CHAR: 0 pad-head % ] tri@ ;
|
||||
[ 255 * >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
|
||||
|
||||
: fg-css, ( color -- )
|
||||
"color: #" % hex-color, "; " % ;
|
||||
|
|
@ -76,32 +67,29 @@ TUPLE: html-sub-stream < html-stream style parent ;
|
|||
: font-css, ( font -- )
|
||||
"font-family: " % % "; " % ;
|
||||
|
||||
: apply-style ( style key quot -- style gadget )
|
||||
[ over at ] dip when* ; inline
|
||||
|
||||
: make-css ( style quot -- str )
|
||||
"" make nip ; inline
|
||||
MACRO: make-css ( pairs -- str )
|
||||
[ '[ _ swap at [ _ execute ] when* ] ] { } assoc>map
|
||||
'[ [ _ cleave ] "" make ] ;
|
||||
|
||||
: span-css-style ( style -- str )
|
||||
[
|
||||
foreground [ fg-css, ] apply-style
|
||||
background [ bg-css, ] apply-style
|
||||
font [ font-css, ] apply-style
|
||||
font-style [ style-css, ] apply-style
|
||||
font-size [ size-css, ] apply-style
|
||||
] make-css ;
|
||||
{
|
||||
{ foreground fg-css, }
|
||||
{ background bg-css, }
|
||||
{ font-name font-css, }
|
||||
{ font-style style-css, }
|
||||
{ font-size size-css, }
|
||||
} make-css ;
|
||||
|
||||
: span-tag ( style quot -- )
|
||||
over span-css-style [
|
||||
call
|
||||
] [
|
||||
<span =style span> call </span>
|
||||
] if-empty ; inline
|
||||
: span-tag ( xml style -- xml )
|
||||
span-css-style
|
||||
[ swap [XML <span style=<->><-></span> XML] ] unless-empty ; inline
|
||||
|
||||
: emit-html ( quot stream -- )
|
||||
dip data>> push ; inline
|
||||
|
||||
: format-html-span ( string style stream -- )
|
||||
stream>> [
|
||||
[ [ [ drop write ] span-tag ] href-link-tag ] object-link-tag
|
||||
] with-output-stream* ;
|
||||
[ [ span-tag ] [ href-link-tag ] [ object-link-tag ] tri ]
|
||||
emit-html ;
|
||||
|
||||
TUPLE: html-span-stream < html-sub-stream ;
|
||||
|
||||
|
|
@ -113,28 +101,26 @@ M: html-span-stream dispose
|
|||
|
||||
: padding-css, ( padding -- ) "padding: " % # "px; " % ;
|
||||
|
||||
: pre-css, ( margin -- )
|
||||
[ "white-space: pre; font-family: monospace; " % ] unless ;
|
||||
CONSTANT: pre-css "white-space: pre; font-family: monospace;"
|
||||
|
||||
: div-css-style ( style -- str )
|
||||
[
|
||||
page-color [ bg-css, ] apply-style
|
||||
border-color [ border-css, ] apply-style
|
||||
border-width [ padding-css, ] apply-style
|
||||
wrap-margin over at pre-css,
|
||||
] make-css ;
|
||||
|
||||
: div-tag ( style quot -- )
|
||||
swap div-css-style [
|
||||
call
|
||||
{
|
||||
{ page-color bg-css, }
|
||||
{ border-color border-css, }
|
||||
{ border-width padding-css, }
|
||||
} make-css
|
||||
] [
|
||||
<div =style div> call </div>
|
||||
] if-empty ; inline
|
||||
wrap-margin swap at
|
||||
[ pre-css append ] unless
|
||||
] bi ;
|
||||
|
||||
: div-tag ( xml style -- xml' )
|
||||
div-css-style
|
||||
[ swap [XML <div style=<->><-></div> XML] ] unless-empty ;
|
||||
|
||||
: format-html-div ( string style stream -- )
|
||||
stream>> [
|
||||
[ [ write ] div-tag ] object-link-tag
|
||||
] with-output-stream* ;
|
||||
[ [ div-tag ] [ object-link-tag ] bi ] emit-html ;
|
||||
|
||||
TUPLE: html-block-stream < html-sub-stream ;
|
||||
|
||||
|
|
@ -145,57 +131,51 @@ M: html-block-stream dispose ( quot style stream -- )
|
|||
"padding: " % first2 max 2 /i # "px; " % ;
|
||||
|
||||
: table-style ( style -- str )
|
||||
[
|
||||
table-border [ border-css, ] apply-style
|
||||
table-gap [ border-spacing-css, ] apply-style
|
||||
] make-css ;
|
||||
|
||||
: table-attrs ( style -- )
|
||||
table-style " border-collapse: collapse;" append =style ;
|
||||
|
||||
: do-escaping ( string style -- string )
|
||||
html swap at [ escape-string ] unless ;
|
||||
{
|
||||
{ table-border border-css, }
|
||||
{ table-gap border-spacing-css, }
|
||||
} make-css
|
||||
" border-collapse: collapse;" append ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
! Stream protocol
|
||||
M: html-stream stream-flush
|
||||
stream>> stream-flush ;
|
||||
M: html-writer stream-flush drop ;
|
||||
|
||||
M: html-stream stream-write1
|
||||
[ 1string ] dip stream-write ;
|
||||
M: html-writer stream-write1
|
||||
not-a-div [ 1string ] emit-html ;
|
||||
|
||||
M: html-stream stream-write
|
||||
not-a-div [ escape-string ] dip stream>> stream-write ;
|
||||
M: html-writer stream-write
|
||||
not-a-div [ ] emit-html ;
|
||||
|
||||
M: html-stream stream-format
|
||||
[ html over at [ [ escape-string ] dip ] unless ] dip
|
||||
M: html-writer stream-format
|
||||
format-html-span ;
|
||||
|
||||
M: html-stream stream-nl
|
||||
dup last-div? [ drop ] [ [ <br/> ] with-output-stream* ] if ;
|
||||
M: html-writer stream-nl
|
||||
dup last-div? [ drop ] [ [ [XML <br/> XML] ] emit-html ] if ;
|
||||
|
||||
M: html-stream make-span-stream
|
||||
M: html-writer make-span-stream
|
||||
html-span-stream new-html-sub-stream ;
|
||||
|
||||
M: html-stream make-block-stream
|
||||
M: html-writer make-block-stream
|
||||
html-block-stream new-html-sub-stream ;
|
||||
|
||||
M: html-stream make-cell-stream
|
||||
M: html-writer make-cell-stream
|
||||
html-sub-stream new-html-sub-stream ;
|
||||
|
||||
M: html-stream stream-write-table
|
||||
a-div stream>> [
|
||||
<table dup table-attrs table> swap [
|
||||
<tr> [
|
||||
<td "top" =valign swap table-style =style td>
|
||||
stream>> >string write
|
||||
</td>
|
||||
] with each </tr>
|
||||
] with each </table>
|
||||
] with-output-stream* ;
|
||||
M: html-writer stream-write-table
|
||||
a-div [
|
||||
table-style swap [
|
||||
[ data>> [XML <td valign="top" style=<->><-></td> XML] ] with map
|
||||
[XML <tr><-></tr> XML]
|
||||
] with map
|
||||
[XML <table><-></table> XML]
|
||||
] emit-html ;
|
||||
|
||||
M: html-stream dispose stream>> dispose ;
|
||||
M: html-writer dispose drop ;
|
||||
|
||||
: with-html-writer ( quot -- )
|
||||
output-stream get <html-stream> swap with-output-stream* ; inline
|
||||
: <html-writer> ( -- html-writer )
|
||||
html-writer new-html-writer ;
|
||||
|
||||
: with-html-writer ( quot -- xml )
|
||||
<html-writer> [ swap with-output-stream* ] keep data>> ; inline
|
||||
|
|
|
|||
|
|
@ -1,12 +1,10 @@
|
|||
! Copyright (C) 2005 Alex Chapman
|
||||
! Copyright (C) 2006, 2008 Slava Pestov
|
||||
! Copyright (C) 2006, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations sequences kernel namespaces debugger
|
||||
combinators math quotations generic strings splitting
|
||||
accessors assocs fry vocabs.parser
|
||||
parser lexer io io.files io.streams.string io.encodings.utf8
|
||||
html
|
||||
html.templates ;
|
||||
combinators math quotations generic strings splitting accessors
|
||||
assocs fry vocabs.parser parser lexer io io.files
|
||||
io.streams.string io.encodings.utf8 html.templates ;
|
||||
IN: html.templates.fhtml
|
||||
|
||||
! We use a custom lexer so that %> ends a token even if not
|
||||
|
|
@ -34,13 +32,13 @@ DEFER: <% delimiter
|
|||
[
|
||||
over line-text>>
|
||||
[ column>> ] 2dip subseq parsed
|
||||
\ write-html parsed
|
||||
\ write parsed
|
||||
] 2keep 2 + >>column drop ;
|
||||
|
||||
: still-looking ( accum lexer -- accum )
|
||||
[
|
||||
[ line-text>> ] [ column>> ] bi tail
|
||||
parsed \ print-html parsed
|
||||
parsed \ print parsed
|
||||
] keep next-line ;
|
||||
|
||||
: parse-%> ( accum lexer -- accum )
|
||||
|
|
|
|||
|
|
@ -67,7 +67,7 @@ SYMBOL: nested-template?
|
|||
SYMBOL: next-template
|
||||
|
||||
: call-next-template ( -- )
|
||||
next-template get write-html ;
|
||||
next-template get write ;
|
||||
|
||||
M: f call-template* drop call-next-template ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue