factor: trim using lists

[factor.git] / basis / html / streams / streams.factor

diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor
index 0ddc09bf5476bd68cc6e2497fee5dfc690f0da27..1678d895bc4cb3d1a02d2ad371735227b1d1e939 100644 (file)
--- a/basis/html/streams/streams.factor
+++ b/basis/html/streams/streams.factor
@@ -1,31 +1,19 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators destructors fry html io
-io.backend io.pathnames io.styles kernel macros make math
-math.order math.parser namespaces sequences strings words xml
-xml.syntax ;
+USING: accessors assocs combinators destructors html io
+io.styles kernel make math math.functions math.parser sequences
+strings xml.syntax ;
 IN: html.streams
 
 GENERIC: url-of ( object -- url )
 
 M: object url-of drop f ;
 
-TUPLE: html-writer data last-div ;
+TUPLE: html-writer data ;
+INSTANCE: html-writer output-stream
 
 <PRIVATE
 
-! stream-nl after with-nesting or tabular-output is
-! ignored, so that HTML stream output looks like
-! UI pane output
-: last-div? ( stream -- ? )
-    [ f ] change-last-div drop ;
-
-: not-a-div ( stream -- stream )
-    f >>last-div ; inline
-
-: a-div ( stream -- stream )
-    t >>last-div ; inline
-
 : new-html-writer ( class -- html-writer )
     new V{ } clone >>data ; inline
 
@@ -40,14 +28,14 @@ TUPLE: html-sub-stream < html-writer style parent ;
     [ data>> ] [ style>> ] [ parent>> ] tri ;
 
 : object-link-tag ( xml style -- xml )
-    presented swap at [ url-of [ simple-link ] when* ] when* ;
+    presented of [ url-of [ simple-link ] when* ] when* ;
 
 : href-link-tag ( xml style -- xml )
-    href swap at [ simple-link ] when* ;
+    href of [ simple-link ] when* ;
 
 : hex-color, ( color -- )
     [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
+    [ 255 * round >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;
@@ -69,7 +57,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
     "font-family: " % % "; " % ;
 
 MACRO: make-css ( pairs -- str )
-    [ '[ _ swap at [ _ execute ] when* ] ] { } assoc>map
+    [ '[ _ of [ _ execute ] when* ] ] { } assoc>map
     '[ [ _ cleave ] "" make ] ;
 
 : span-css-style ( style -- str )
@@ -85,15 +73,11 @@ MACRO: make-css ( pairs -- str )
     span-css-style
     [ swap [XML <span style=<->><-></span> XML] ] unless-empty ; inline
 
-: emit-html ( quot stream -- )
+: emit-html ( stream quot -- )
     dip data>> push ; inline
 
-: image-resource-path ( path -- images-path )
-    normalize-path current-directory get drop-prefix drop
-    "/images" prepend ;
-
 : img-tag ( xml style -- xml )
-    image swap at [ nip image-resource-path simple-image ] when* ;
+    image-style of [ nip simple-image ] when* ;
 
 : format-html-span ( string style stream -- )
     [
@@ -108,27 +92,34 @@ MACRO: make-css ( pairs -- str )
 TUPLE: html-span-stream < html-sub-stream ;
 
 M: html-span-stream dispose
-    end-sub-stream not-a-div format-html-span ;
+    end-sub-stream format-html-span ;
 
 : border-css, ( border -- )
     "border: 1px solid #" % hex-color, "; " % ;
 
+: (padding-css,) ( horizontal vertical -- )
+    2dup = [
+        drop "padding: " % # "px; " %
+    ] [
+        "padding: " % # "px " % # "px; " %
+    ] if ;
+
 : padding-css, ( padding -- )
-    first2 "padding: " % # "px " % # "px; " % ;
+    first2 (padding-css,) ;
 
-CONSTANT: pre-css "white-space: pre; font-family: monospace;"
+: width-css, ( width -- )
+    "width: " % # "px; " % ;
 
 : div-css-style ( style -- str )
+    [ span-css-style ]
     [
         {
             { page-color bg-css, }
             { border-color border-css, }
             { inset padding-css, }
+            { wrap-margin width-css, }
         } make-css
-    ] [
-        wrap-margin swap at
-        [ pre-css append ] unless
-    ] bi ;
+    ] bi "display: inline-block; " 3append ;
 
 : div-tag ( xml style -- xml' )
     div-css-style
@@ -139,18 +130,17 @@ CONSTANT: pre-css "white-space: pre; font-family: monospace;"
 
 TUPLE: html-block-stream < html-sub-stream ;
 
-M: html-block-stream dispose ( quot style stream -- )
-    end-sub-stream a-div format-html-div ;
+M: html-block-stream dispose
+    end-sub-stream format-html-div ;
 
 : border-spacing-css, ( pair -- )
-    "padding: " % first2 max 2 /i # "px; " % ;
+    first2 [ 2 /i ] bi@ (padding-css,) ;
 
 : table-style ( style -- str )
     {
         { table-border border-css, }
         { table-gap border-spacing-css, }
-    } make-css
-    " border-collapse: collapse;" append ;
+    } make-css ;
 
 PRIVATE>
 
@@ -158,16 +148,16 @@ PRIVATE>
 M: html-writer stream-flush drop ;
 
 M: html-writer stream-write1
-    not-a-div [ 1string ] emit-html ;
+    [ 1string ] emit-html ;
 
 M: html-writer stream-write
-    not-a-div [ ] emit-html ;
+    [ ] emit-html ;
 
 M: html-writer stream-format
     format-html-span ;
 
 M: html-writer stream-nl
-    dup last-div? [ drop ] [ [ [XML <br/> XML] ] emit-html ] if ;
+    [ [XML <br/> XML] ] emit-html ;
 
 M: html-writer make-span-stream
     html-span-stream new-html-sub-stream ;
@@ -179,12 +169,12 @@ M: html-writer make-cell-stream
     html-sub-stream new-html-sub-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]
+        [XML <table style="display: inline-table; border-collapse: collapse;"><-></table> XML]
     ] emit-html ;
 
 M: html-writer dispose drop ;