steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

html.streams now emits clickable URLs for $url markup elements

db4
Slava Pestov 2008-09-29 04:09:02 -05:00
parent ded36a2279
commit e62f068db7
5 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/help/markup/markup.factor
View File

@ -71,7 +71,10 @@ ALIAS: $slot $snippet
[ strong-style get print-element* ] ($span) ; [ strong-style get print-element* ] ($span) ;
: $url ( children -- ) : $url ( children -- )
[ url-style get print-element* ] ($span) ; [
dup first href associate url-style get assoc-union
print-element*
] ($span) ;
: $nl ( children -- ) : $nl ( children -- )
nl nl drop ; nl nl drop ;

6
basis/html/streams/streams-docs.factor
View File

@ -13,13 +13,13 @@ HELP: <html-stream>
{ $values { "stream" "an output stream" } { "html-stream" html-stream } } { $values { "stream" "an output stream" } { "html-stream" html-stream } }
{ $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ; { $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ;
HELP: with-html-stream HELP: with-html-writer
{ $values { "quot" quotation } } { $values { "quot" quotation } }
{ $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." } { $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." }
{ $examples { $examples
{ $example { $example
"USING: io io.styles html.streams ;" "USING: io io.styles html.streams ;"
"[ \"Hello\" { { font-style bold } } format nl ] with-html-stream" "[ \"Hello\" { { font-style bold } } format nl ] with-html-writer"
"<span style='font-style: normal; font-weight: bold; '>Hello</span><br/>" "<span style='font-style: normal; font-weight: bold; '>Hello</span><br/>"
} }
} ; } ;
@ -28,6 +28,6 @@ ARTICLE: "html.streams" "HTML streams"
"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream." "The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream."
{ $subsection html-stream } { $subsection html-stream }
{ $subsection <html-stream> } { $subsection <html-stream> }
{ $subsection with-html-stream } ; { $subsection with-html-writer } ;
ABOUT: "html.streams" ABOUT: "html.streams"

4
basis/html/streams/streams-tests.factor
View File

@ -4,7 +4,7 @@ xml.writer sbufs sequences inspector colors ;
IN: html.streams.tests IN: html.streams.tests
: make-html-string : make-html-string
[ with-html-stream ] with-string-writer ; inline [ with-html-writer ] with-string-writer ; inline
[ [ ] make-html-string ] must-infer [ [ ] make-html-string ] must-infer
@ -71,4 +71,4 @@ M: funky browser-link-href
[ H{ } [ ] with-nesting nl ] make-html-string [ H{ } [ ] with-nesting nl ] make-html-string
] unit-test ] unit-test
[ ] [ [ { 1 2 3 } describe ] with-html-stream ] unit-test [ ] [ [ { 1 2 3 } describe ] with-html-writer ] unit-test

9
basis/html/streams/streams.factor
View File

@ -22,7 +22,7 @@ TUPLE: html-stream stream last-div ;
: not-a-div ( stream -- stream ) : not-a-div ( stream -- stream )
f >>last-div ; inline f >>last-div ; inline
: a-div ( stream -- straem ) : a-div ( stream -- stream )
t >>last-div ; inline t >>last-div ; inline
: <html-stream> ( stream -- html-stream ) : <html-stream> ( stream -- html-stream )
@ -48,6 +48,9 @@ TUPLE: html-sub-stream < html-stream style parent ;
] [ call ] if* ] [ call ] if*
] [ call ] if* ; inline ] [ call ] if* ; inline
: href-link-tag ( style quot -- )
href pick at [ <a =href a> call </a> ] [ call ] if* ; inline
: hex-color, ( color -- ) : hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri
[ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ; [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ;
@ -95,7 +98,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
: format-html-span ( string style stream -- ) : format-html-span ( string style stream -- )
stream>> [ stream>> [
[ [ drop write ] span-tag ] object-link-tag [ [ [ drop write ] span-tag ] href-link-tag ] object-link-tag
] with-output-stream* ; ] with-output-stream* ;
TUPLE: html-span-stream < html-sub-stream ; TUPLE: html-span-stream < html-sub-stream ;
@ -192,5 +195,5 @@ M: html-stream stream-write-table
M: html-stream dispose stream>> dispose ; M: html-stream dispose stream>> dispose ;
: with-html-stream ( quot -- ) : with-html-writer ( quot -- )
output-stream get <html-stream> swap with-output-stream* ; inline output-stream get <html-stream> swap with-output-stream* ; inline

2
basis/io/styles/styles.factor
View File

@ -20,6 +20,8 @@ SYMBOL: presented
SYMBOL: presented-path SYMBOL: presented-path
SYMBOL: presented-printer SYMBOL: presented-printer
SYMBOL: href
! Paragraph styles ! Paragraph styles
SYMBOL: page-color SYMBOL: page-color
SYMBOL: border-color SYMBOL: border-color