basis/html/streams/streams-tests.factor

   1 USING: html.streams html.streams.private accessors io
   2 io.streams.string io.styles kernel namespaces tools.test
   3 sbufs sequences inspector colors xml.writer
   4 classes.predicate prettyprint ;
   5 IN: html.streams.tests
   6
   7 : make-html-string ( quot -- string )
   8     [ with-html-writer write-xml ] with-string-writer ; inline
   9
  10 [ [ ] make-html-string ] must-infer
  11
  12 [ "" ] [
  13     [ "" write ] make-html-string
  14 ] unit-test
  15
  16 [ "a" ] [
  17     [ CHAR: a write1 ] make-html-string
  18 ] unit-test
  19
  20 [ "&lt;" ] [
  21     [ "<" write ] make-html-string
  22 ] unit-test
  23
  24 TUPLE: funky town ;
  25
  26 M: funky url-of "http://www.funky-town.com/" swap town>> append ;
  27
  28 [ "<a href=\"http://www.funky-town.com/austin\">&lt;</a>" ] [
  29     [
  30         "<" "austin" funky boa write-object
  31     ] make-html-string
  32 ] unit-test
  33
  34 [ "<span style=\"font-family: monospace; \">car</span>" ]
  35 [
  36     [
  37         "car"
  38         H{ { font-name "monospace" } }
  39         format
  40     ] make-html-string
  41 ] unit-test
  42
  43 [ "<span style=\"color: #ff00ff; \">car</span>" ]
  44 [
  45     [
  46         "car"
  47         H{ { foreground T{ rgba f 1 0 1 1 } } }
  48         format
  49     ] make-html-string
  50 ] unit-test
  51
  52 [ "<div style=\"background-color: #ff00ff; white-space: pre; font-family: monospace; display: inline-block;\">cdr</div>" ]
  53 [
  54     [
  55         H{ { page-color T{ rgba f 1 0 1 1 } } }
  56         [ "cdr" write ] with-nesting
  57     ] make-html-string
  58 ] unit-test
  59
  60 [ "<div style=\"white-space: pre; font-family: monospace; display: inline-block;\"></div><br/>" ] [
  61     [ H{ } [ ] with-nesting nl ] make-html-string
  62 ] unit-test
  63
  64 [ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
  65
  66 [ "<img src=\"/icons/class-word.tiff\"/>" ] [
  67     [
  68         "text"
  69         { { image "vocab:definitions/icons/class-word.tiff" } }
  70         format
  71     ] make-html-string
  72 ] unit-test