]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix conflict
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 1 Feb 2009 04:41:26 +0000 (22:41 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sun, 1 Feb 2009 04:41:26 +0000 (22:41 -0600)
1  2 
basis/html/streams/streams-tests.factor
basis/html/streams/streams.factor

index 94229b3aeaab8552dfde841692f2d00054e429ab,18ab17218f32fdc7c00f926e3899670c7b6af3b5..249861b12a8b93e7c6125ec827705219b4a5eb81
@@@ -43,7 -35,7 +35,7 @@@ M: funky url-of "http://www.funky-town.
  [
      [
          "car"
--        H{ { font "monospace" } }
++        H{ { font-name "monospace" } }
          format
      ] make-html-string
  ] unit-test
index 3283adf06995df4c5853b460eda349d6b1168ab4,0a4b8eddd4b6cbc2f432aabcf0333f84ab7ffdcd..768f2bbaa809c4c7913d8ba42d3ea656e51babe6
@@@ -76,32 -67,29 +67,29 @@@ TUPLE: html-sub-stream < html-writer st
  : 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-name  [ font-css,  ] apply-style
-         font-style [ style-css, ] apply-style
-         font-size  [ size-css,  ] apply-style
-     ] make-css ;
- : span-tag ( style quot -- )
-     over span-css-style [
-         call
-     ] [
-         <span =style span> call </span>
-     ] if-empty ; inline
+     {
+         { foreground fg-css, }
+         { background bg-css, }
 -        { font font-css, }
++        { font-name font-css, }
+         { font-style style-css, }
+         { font-size size-css, }
+     } make-css ;
+ : 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 ;