: 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 ;