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 xml.writer sbufs sequences inspector colors ;
   4 IN: html.streams.tests
   5
   6 : make-html-string
   7     [ with-html-writer ] with-string-writer ; inline
   8
   9 [ [ ] make-html-string ] must-infer
  10
  11 [ ] [
  12     512 <sbuf> <html-stream> drop
  13 ] unit-test
  14
  15 [ "" ] [
  16     [ "" write ] make-html-string
  17 ] unit-test
  18
  19 [ "a" ] [
  20     [ CHAR: a write1 ] make-html-string
  21 ] unit-test
  22
  23 [ "&lt;" ] [
  24     [ "<" write ] make-html-string
  25 ] unit-test
  26
  27 [ "<" ] [
  28     [ "<" H{ } output-stream get format-html-span ] make-html-string
  29 ] unit-test
  30
  31 TUPLE: funky town ;
  32
  33 M: funky browser-link-href
  34     "http://www.funky-town.com/" swap town>> append ;
  35
  36 [ "<a href='http://www.funky-town.com/austin'>&lt;</a>" ] [
  37     [
  38         "<" "austin" funky boa write-object
  39     ] make-html-string
  40 ] unit-test
  41
  42 [ "<span style='font-family: monospace; '>car</span>" ]
  43 [
  44     [
  45         "car"
  46         H{ { font "monospace" } }
  47         format
  48     ] make-html-string
  49 ] unit-test
  50
  51 [ "<span style='color: #ff00ff; '>car</span>" ]
  52 [
  53     [
  54         "car"
  55         H{ { foreground T{ rgba f 1 0 1 1 } } }
  56         format
  57     ] make-html-string
  58 ] unit-test
  59
  60 [ "<div style='background-color: #ff00ff; white-space: pre; font-family: monospace; '>cdr</div>" ]
  61 [
  62     [
  63         H{ { page-color T{ rgba f 1 0 1 1 } } }
  64         [ "cdr" write ] with-nesting
  65     ] make-html-string
  66 ] unit-test
  67
  68 [
  69     "<div style='white-space: pre; font-family: monospace; '></div>"
  70 ] [
  71     [ H{ } [ ] with-nesting nl ] make-html-string
  72 ] unit-test
  73
  74 [ ] [ [ { 1 2 3 } describe ] with-html-writer ] unit-test