[ [ ] make-html-string ] must-infer
-{ "" } [
+{ "<span></span>" } [
[ "" write ] make-html-string
] unit-test
-{ "a" } [
+{ "<span>a</span>" } [
[ CHAR: a write1 ] make-html-string
] unit-test
-{ "<" } [
+{ "<span><</span>" } [
[ "<" write ] make-html-string
] unit-test
] make-html-string
] unit-test
-{ "<div style=\"background-color: #ff00ff; display: inline-block; \">cdr</div>" }
+{ "<div style=\"background-color: #ff00ff; \"><span>cdr</span></div>" }
[
[
H{ { page-color T{ rgba f 1 0 1 1 } } }
] make-html-string
] unit-test
-{ "<div style=\"display: inline-block; \"></div><br/>" } [
+{ "<br/>" } [
[ H{ } [ ] with-nesting nl ] make-html-string
] unit-test
! Copyright (C) 2004, 2009 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors assocs colors combinators destructors html io
-io.styles kernel make math math.functions math.parser sequences
-strings xml.syntax ;
+USING: accessors assocs colors combinators
+combinators.short-circuit destructors html io io.styles kernel
+make math math.functions math.parser sequences strings
+xml.syntax ;
IN: html.streams
GENERIC: url-of ( object -- url )
swap >>parent
swap >>style ; inline
+: string-spans ( data -- data' )
+ [ dup string? [ [XML <span><-></span> XML] ] when ] map ;
+
: end-sub-stream ( substream -- string style stream )
- [ data>> ] [ style>> ] [ parent>> ] tri ;
+ [ data>> string-spans ] [ style>> ] [ parent>> ] tri ;
: object-link-tag ( xml style -- xml )
presented of [ url-of [ simple-link ] when* ] when* ;
[ swap [XML <span style=<->><-></span> XML] ] unless-empty ; inline
: emit-html ( stream quot -- )
- dip data>> push ; inline
+ dip data>> { [ over string? ] [ dup ?last string? ] } 0&& [
+ [ last prepend ] [ set-last ] bi
+ ] [ push ] if ; inline
: img-tag ( xml style -- xml )
image-style of [ nip simple-image ] when* ;
{ inset padding-css, }
{ wrap-margin width-css, }
} make-css
- ] bi "display: inline-block; " 3append ;
+ ] bi append ;
: div-tag ( xml style -- xml' )
div-css-style
[ data>> [XML <td valign="top" style=<->><-></td> XML] ] with map
[XML <tr><-></tr> XML]
] with map
- [XML <table style="display: inline-table; border-collapse: collapse;"><-></table> XML]
+ [XML <table style="border-collapse: collapse;"><-></table> XML]
] emit-html ;
M: html-writer dispose drop ;
html-writer new-html-writer ;
: with-html-writer ( quot -- xml )
- <html-writer> [ swap with-output-stream* ] keep data>> ; inline
+ <html-writer> [ swap with-output-stream* ] keep data>> string-spans ; inline