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 ;
   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 "\n" ?tail drop "\n" ?tail drop = ;
  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 ARTICLE: "test-article-1" "This is a test article"
  91 "Hello world, how are you today." ;
  92
  93 [ t ] [ [ "test-article-1" $title ] test-gadget-text ] unit-test
  94
  95 [ t ] [ [ "test-article-1" print-topic ] test-gadget-text ] unit-test
  96
  97 ARTICLE: "test-article-2" "This is a test article"
  98 "Hello world, how are you today."
  99 { $table { "a" "b" } { "c" "d" } } ;
 100
 101 [ t ] [ [ "test-article-2" print-topic ] test-gadget-text ] unit-test
 102
 103 <pane> [ \ = see ] with-pane
 104 <pane> [ \ = print-topic ] with-pane
 105
 106 [ ] [
 107     \ = <model> [ see ] <pane-control> [ ] with-grafted-gadget
 108 ] unit-test
 109
 110 : <test-pane> ( -- foo )
 111     <gadget> pane new-pane ;
 112
 113 [ t ] [ <test-pane> dup input>> child? ] unit-test
 114 [ t ] [ <test-pane> dup last-line>> child? ] unit-test