basis/ui/gadgets/panes/panes-tests.factor

   1 USING: alien ui.gadgets.panes ui.gadgets namespaces
   2 kernel sequences io io.styles io.streams.string tools.test
   3 prettyprint definitions help help.syntax help.markup
   4 help.stylesheet splitting tools.test.ui models math summary
   5 inspector accessors help.topics see ;
   6 IN: ui.gadgets.panes.tests
   7
   8 : #children "pane" get children>> length ;
   9
  10 [ ] [ <pane> "pane" set ] unit-test
  11
  12 [ ] [ #children "num-children" set ] unit-test
  13
  14 [ ] [
  15     "pane" get <pane-stream> [ 100 [ . ] each ] with-output-stream*
  16 ] unit-test
  17
  18 [ t ] [ #children "num-children" get = ] unit-test
  19
  20 : test-gadget-text ( quot -- ? )
  21     dup make-pane gadget-text dup print "======" print
  22     swap with-string-writer dup print = ;
  23
  24 [ t ] [ [ "hello" write ] test-gadget-text ] unit-test
  25 [ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
  26 [ t ] [
  27     [
  28         H{ { wrap-margin 100 } } [ "hello" pprint ] with-nesting
  29     ] test-gadget-text
  30 ] unit-test
  31 [ t ] [
  32     [
  33         H{ { wrap-margin 100 } } [
  34             H{ } [
  35                 "hello" pprint
  36             ] with-style
  37         ] with-nesting
  38     ] test-gadget-text
  39 ] unit-test
  40 [ t ] [ [ [ 1 2 3 ] pprint ] test-gadget-text ] unit-test
  41 [ t ] [ [ \ + describe ] test-gadget-text ] unit-test
  42 [ t ] [ [ \ = see ] test-gadget-text ] unit-test
  43 [ t ] [ [ \ = print-topic ] test-gadget-text ] unit-test
  44
  45 [ t ] [
  46     [
  47         title-style get [
  48                 "Hello world" write
  49         ] with-style
  50     ] test-gadget-text
  51 ] unit-test
  52
  53
  54 [ t ] [
  55     [
  56         title-style get [
  57                 "Hello world" write
  58         ] with-nesting
  59     ] test-gadget-text
  60 ] unit-test
  61
  62 [ t ] [
  63     [
  64         title-style get [
  65             title-style get [
  66                 "Hello world" write
  67             ] with-nesting
  68         ] with-style
  69     ] test-gadget-text
  70 ] unit-test
  71
  72 [ t ] [
  73     [
  74         title-style get [
  75             title-style get [
  76                 [ "Hello world" write ] ($block)
  77             ] with-nesting
  78         ] with-style
  79     ] test-gadget-text
  80 ] unit-test
  81
  82 [ t ] [
  83     [
  84         last-element off
  85         \ = >link $title
  86         "Hello world" print-content
  87     ] test-gadget-text
  88 ] unit-test
  89
  90 [ t ] [
  91     [
  92         last-element off
  93         \ = >link title-style get [
  94             $navigation-table
  95         ] with-nesting
  96         "Hello world" print-content
  97     ] test-gadget-text
  98 ] unit-test
  99
 100 [ t ] [
 101     [ { { "a\n" } } simple-table. ] test-gadget-text
 102 ] unit-test
 103
 104 [ t ] [
 105     [ { { "a" } } simple-table. "x" write ] test-gadget-text
 106 ] unit-test
 107
 108 [ t ] [
 109     [ H{ } [ { { "a" } } simple-table. ] with-nesting "x" write ] test-gadget-text
 110 ] unit-test
 111
 112 ARTICLE: "test-article-1" "This is a test article"
 113 "Hello world, how are you today." ;
 114
 115 [ t ] [ [ "test-article-1" $title ] test-gadget-text ] unit-test
 116
 117 [ t ] [ [ "test-article-1" print-topic ] test-gadget-text ] unit-test
 118
 119 ARTICLE: "test-article-2" "This is a test article"
 120 "Hello world, how are you today."
 121 { $table { "a" "b" } { "c" "d" } } ;
 122
 123 [ t ] [ [ "test-article-2" print-topic ] test-gadget-text ] unit-test
 124
 125 <pane> [ \ = see ] with-pane
 126 <pane> [ \ = print-topic ] with-pane
 127
 128 [ ] [
 129     \ = <model> [ see ] <pane-control> [ ] with-grafted-gadget
 130 ] unit-test
 131
 132 : <test-pane> ( -- foo )
 133     <gadget> pane new-pane ;
 134
 135 [ t ] [ <test-pane> dup input>> child? ] unit-test
 136 [ t ] [ <test-pane> dup last-line>> child? ] unit-test