]> gitweb.factorcode.org Git - factor.git/commitdiff
html.streams: make more spans
authorJohn Benediktsson <mrjbq7@gmail.com>
Tue, 31 Jan 2023 05:54:49 +0000 (21:54 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Tue, 31 Jan 2023 06:10:14 +0000 (22:10 -0800)
basis/html/streams/streams-tests.factor
basis/html/streams/streams.factor

index a0cd6c47a6b20fe4ec53cb9a7e869cb1779caca0..26955b5e0bf0e3501491b6bcfd855eebed6f4e45 100644 (file)
@@ -9,15 +9,15 @@ IN: html.streams.tests
 
 [ [ ] 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
 
-{ "&lt;" } [
+{ "<span>&lt;</span>" } [
     [ "<" write ] make-html-string
 ] unit-test
 
@@ -49,7 +49,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
     ] 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 } } }
@@ -57,7 +57,7 @@ M: funky url-of "http://www.funky-town.com/" swap town>> append ;
     ] make-html-string
 ] unit-test
 
-{ "<div style=\"display: inline-block; \"></div><br/>" } [
+{ "<br/>" } [
     [ H{ } [ ] with-nesting nl ] make-html-string
 ] unit-test
 
index 0d20e69add0a4f15a24cb5f134cd01dd88f3bb40..f62a5abc1ddcee581c5c5a2c51eb1332ef5bb6d0 100644 (file)
@@ -1,8 +1,9 @@
 ! 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 )
@@ -24,8 +25,11 @@ TUPLE: html-sub-stream < html-writer style parent ;
         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* ;
@@ -70,7 +74,9 @@ MACRO: make-css ( pairs -- str )
     [ 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* ;
@@ -115,7 +121,7 @@ M: html-span-stream dispose
             { inset padding-css, }
             { wrap-margin width-css, }
         } make-css
-    ] bi "display: inline-block; " 3append ;
+    ] bi append ;
 
 : div-tag ( xml style -- xml' )
     div-css-style
@@ -170,7 +176,7 @@ M: html-writer stream-write-table
             [ 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 ;
@@ -179,4 +185,4 @@ 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