Fix UI panes
parent
7e7ba4ca38
commit
ca652dc157
|
@ -34,10 +34,12 @@ M: filter-writer stream-write-table
|
||||||
stream>> stream-write-table ;
|
stream>> stream-write-table ;
|
||||||
|
|
||||||
M: filter-writer dispose
|
M: filter-writer dispose
|
||||||
drop ;
|
stream>> dispose ;
|
||||||
|
|
||||||
TUPLE: ignore-close-stream < filter-writer ;
|
TUPLE: ignore-close-stream < filter-writer ;
|
||||||
|
|
||||||
|
M: ignore-close-stream dispose drop ;
|
||||||
|
|
||||||
C: <ignore-close-stream> ignore-close-stream
|
C: <ignore-close-stream> ignore-close-stream
|
||||||
|
|
||||||
TUPLE: style-stream < filter-writer style ;
|
TUPLE: style-stream < filter-writer style ;
|
||||||
|
|
|
@ -12,7 +12,7 @@ M: plain-writer stream-format
|
||||||
nip stream-write ;
|
nip stream-write ;
|
||||||
|
|
||||||
M: plain-writer make-span-stream
|
M: plain-writer make-span-stream
|
||||||
swap <style-stream> ;
|
swap <style-stream> <ignore-close-stream> ;
|
||||||
|
|
||||||
M: plain-writer make-block-stream
|
M: plain-writer make-block-stream
|
||||||
nip <ignore-close-stream> ;
|
nip <ignore-close-stream> ;
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
IN: ui.gadgets.panes.tests
|
IN: ui.gadgets.panes.tests
|
||||||
USING: alien ui.gadgets.panes ui.gadgets namespaces
|
USING: alien ui.gadgets.panes ui.gadgets namespaces
|
||||||
kernel sequences io io.streams.string tools.test prettyprint
|
kernel sequences io io.styles io.streams.string tools.test
|
||||||
definitions help help.syntax help.markup splitting
|
prettyprint definitions help help.syntax help.markup
|
||||||
tools.test.ui models ;
|
help.stylesheet splitting tools.test.ui models math inspector ;
|
||||||
|
|
||||||
: #children "pane" get gadget-children length ;
|
: #children "pane" get gadget-children length ;
|
||||||
|
|
||||||
|
@ -17,20 +17,79 @@ tools.test.ui models ;
|
||||||
[ t ] [ #children "num-children" get = ] unit-test
|
[ t ] [ #children "num-children" get = ] unit-test
|
||||||
|
|
||||||
: test-gadget-text
|
: test-gadget-text
|
||||||
dup make-pane gadget-text
|
dup make-pane gadget-text dup print "======" print
|
||||||
swap with-string-writer "\n" ?tail drop "\n" ?tail drop = ;
|
swap with-string-writer dup print "\n" ?tail drop "\n" ?tail drop = ;
|
||||||
|
|
||||||
[ t ] [ [ "hello" write ] test-gadget-text ] unit-test
|
[ t ] [ [ "hello" write ] test-gadget-text ] unit-test
|
||||||
[ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
|
[ t ] [ [ "hello" pprint ] test-gadget-text ] unit-test
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
H{ { wrap-margin 100 } } [ "hello" pprint ] with-nesting
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
H{ { wrap-margin 100 } } [
|
||||||
|
H{ } [
|
||||||
|
"hello" pprint
|
||||||
|
] with-style
|
||||||
|
] with-nesting
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
[ t ] [ [ [ 1 2 3 ] pprint ] test-gadget-text ] unit-test
|
[ t ] [ [ [ 1 2 3 ] pprint ] test-gadget-text ] unit-test
|
||||||
|
[ t ] [ [ \ + describe ] test-gadget-text ] unit-test
|
||||||
[ t ] [ [ \ = see ] test-gadget-text ] unit-test
|
[ t ] [ [ \ = see ] test-gadget-text ] unit-test
|
||||||
[ t ] [ [ \ = help ] test-gadget-text ] unit-test
|
[ t ] [ [ \ = help ] test-gadget-text ] unit-test
|
||||||
|
|
||||||
ARTICLE: "test-article" "This is a test article"
|
[ t ] [
|
||||||
|
[
|
||||||
|
title-style get [
|
||||||
|
"Hello world" write
|
||||||
|
] with-style
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
title-style get [
|
||||||
|
"Hello world" write
|
||||||
|
] with-nesting
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
title-style get [
|
||||||
|
title-style get [
|
||||||
|
"Hello world" write
|
||||||
|
] with-nesting
|
||||||
|
] with-style
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
[
|
||||||
|
title-style get [
|
||||||
|
title-style get [
|
||||||
|
[ "Hello world" write ] ($block)
|
||||||
|
] with-nesting
|
||||||
|
] with-style
|
||||||
|
] test-gadget-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
ARTICLE: "test-article-1" "This is a test article"
|
||||||
|
"Hello world, how are you today." ;
|
||||||
|
|
||||||
|
[ t ] [ [ "test-article-1" $title ] test-gadget-text ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ [ "test-article-1" help ] test-gadget-text ] unit-test
|
||||||
|
|
||||||
|
ARTICLE: "test-article-2" "This is a test article"
|
||||||
"Hello world, how are you today."
|
"Hello world, how are you today."
|
||||||
{ $table { "a" "b" } { "c" "d" } } ;
|
{ $table { "a" "b" } { "c" "d" } } ;
|
||||||
|
|
||||||
[ t ] [ [ "test-article" help ] test-gadget-text ] unit-test
|
[ t ] [ [ "test-article-2" help ] test-gadget-text ] unit-test
|
||||||
|
|
||||||
<pane> [ \ = see ] with-pane
|
<pane> [ \ = see ] with-pane
|
||||||
<pane> [ \ = help ] with-pane
|
<pane> [ \ = help ] with-pane
|
||||||
|
|
|
@ -166,7 +166,7 @@ M: pane-stream dispose drop ;
|
||||||
M: pane-stream stream-flush drop ;
|
M: pane-stream stream-flush drop ;
|
||||||
|
|
||||||
M: pane-stream make-span-stream
|
M: pane-stream make-span-stream
|
||||||
swap <style-stream> ;
|
swap <style-stream> <ignore-close-stream> ;
|
||||||
|
|
||||||
! Character styles
|
! Character styles
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue