pane-stream class to fix a delegation issue
parent
3abfe244aa
commit
761f929de9
|
@ -3,7 +3,6 @@
|
||||||
- list mouse gestures
|
- list mouse gestures
|
||||||
- search gadget should use list
|
- search gadget should use list
|
||||||
- maybe simplify list into displaying list a sequence of strings
|
- maybe simplify list into displaying list a sequence of strings
|
||||||
- control delegating to a pane is wrong
|
|
||||||
- the mouse button overload sucks, use popup menus instead
|
- the mouse button overload sucks, use popup menus instead
|
||||||
- nested presentation mouse over is not right
|
- nested presentation mouse over is not right
|
||||||
- ui quick start doc
|
- ui quick start doc
|
||||||
|
@ -11,6 +10,8 @@
|
||||||
- slider needs to be modelized
|
- slider needs to be modelized
|
||||||
- some way of intercepting all gestures
|
- some way of intercepting all gestures
|
||||||
- better help result ranking
|
- better help result ranking
|
||||||
|
- track add/remove weirdness
|
||||||
|
- minibuffer should show a title
|
||||||
|
|
||||||
+ ui:
|
+ ui:
|
||||||
|
|
||||||
|
|
|
@ -41,9 +41,41 @@ C: pane ( -- pane )
|
||||||
[ pick pick pane-current stream-format ]
|
[ pick pick pane-current stream-format ]
|
||||||
[ dup stream-terpri ] interleave 2drop ;
|
[ dup stream-terpri ] interleave 2drop ;
|
||||||
|
|
||||||
|
! Panes are streams.
|
||||||
|
|
||||||
|
: scroll-pane ( pane -- )
|
||||||
|
dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
|
||||||
|
|
||||||
|
TUPLE: pane-stream pane ;
|
||||||
|
|
||||||
|
: do-pane-stream ( pane-stream quot -- )
|
||||||
|
>r pane-stream-pane r> over slip scroll-pane ; inline
|
||||||
|
|
||||||
|
M: pane-stream stream-terpri
|
||||||
|
[
|
||||||
|
dup pane-current dup unparent prepare-print
|
||||||
|
over pane-output add-incremental
|
||||||
|
prepare-line
|
||||||
|
] do-pane-stream ;
|
||||||
|
|
||||||
|
M: pane-stream stream-write1
|
||||||
|
[ pane-current stream-write1 ] do-pane-stream ;
|
||||||
|
|
||||||
|
M: pane-stream stream-write
|
||||||
|
[ swap "\n" split pane-write ] do-pane-stream ;
|
||||||
|
|
||||||
|
M: pane-stream stream-format
|
||||||
|
[ rot "\n" split pane-format ] do-pane-stream ;
|
||||||
|
|
||||||
|
M: pane-stream stream-close drop ;
|
||||||
|
|
||||||
|
M: pane stream-flush drop ;
|
||||||
|
|
||||||
|
M: pane-stream with-stream-style (with-stream-style) ;
|
||||||
|
|
||||||
GENERIC: write-gadget ( gadget stream -- )
|
GENERIC: write-gadget ( gadget stream -- )
|
||||||
|
|
||||||
M: pane write-gadget
|
M: pane-stream write-gadget
|
||||||
#! Print a gadget to the given pane.
|
#! Print a gadget to the given pane.
|
||||||
pane-current add-gadget ;
|
pane-current add-gadget ;
|
||||||
|
|
||||||
|
@ -57,40 +89,15 @@ M: duplex-stream write-gadget
|
||||||
#! Print a gadget to the current pane.
|
#! Print a gadget to the current pane.
|
||||||
stdio get print-gadget ;
|
stdio get print-gadget ;
|
||||||
|
|
||||||
! Panes are streams.
|
|
||||||
M: pane stream-flush drop ;
|
|
||||||
|
|
||||||
: scroll-pane ( pane -- )
|
|
||||||
dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
|
|
||||||
|
|
||||||
M: pane stream-terpri
|
|
||||||
dup pane-current dup unparent prepare-print
|
|
||||||
over pane-output add-incremental
|
|
||||||
dup prepare-line
|
|
||||||
scroll-pane ;
|
|
||||||
|
|
||||||
M: pane stream-write1
|
|
||||||
[ pane-current stream-write1 ] keep scroll-pane ;
|
|
||||||
|
|
||||||
M: pane stream-write
|
|
||||||
[ swap "\n" split pane-write ] keep scroll-pane ;
|
|
||||||
|
|
||||||
M: pane stream-format
|
|
||||||
[ rot "\n" split pane-format ] keep scroll-pane ;
|
|
||||||
|
|
||||||
M: pane stream-close drop ;
|
|
||||||
|
|
||||||
M: pane with-stream-style
|
|
||||||
(with-stream-style) ;
|
|
||||||
|
|
||||||
: ?terpri
|
: ?terpri
|
||||||
dup pane-current gadget-children empty?
|
dup pane-stream-pane pane-current gadget-children empty?
|
||||||
[ dup stream-terpri ] unless drop ;
|
[ dup stream-terpri ] unless drop ;
|
||||||
|
|
||||||
: with-pane ( pane quot -- )
|
: with-pane ( pane quot -- )
|
||||||
#! Clear the pane and run the quotation in a scope with
|
#! Clear the pane and run the quotation in a scope with
|
||||||
#! stdio set to the pane.
|
#! stdio set to the pane.
|
||||||
over pane-clear over >r with-stream* r> ?terpri ; inline
|
over pane-clear >r <pane-stream> r>
|
||||||
|
over >r with-stream r> ?terpri ; inline
|
||||||
|
|
||||||
: make-pane ( quot -- pane )
|
: make-pane ( quot -- pane )
|
||||||
#! Execute the quotation with output to an output-only pane.
|
#! Execute the quotation with output to an output-only pane.
|
||||||
|
|
|
@ -15,11 +15,13 @@ TUPLE: listener-gadget input output stack minibuffer use ;
|
||||||
>r datastack r> listener-gadget-stack set-model ;
|
>r datastack r> listener-gadget-stack set-model ;
|
||||||
|
|
||||||
: listener-stream ( listener -- stream )
|
: listener-stream ( listener -- stream )
|
||||||
dup listener-gadget-input swap listener-gadget-output
|
dup listener-gadget-input
|
||||||
|
swap listener-gadget-output <pane-stream>
|
||||||
<duplex-stream> ;
|
<duplex-stream> ;
|
||||||
|
|
||||||
: <listener-input> ( -- gadget )
|
: <listener-input> ( -- gadget )
|
||||||
gadget get listener-gadget-output <interactor> ;
|
gadget get listener-gadget-output
|
||||||
|
<pane-stream> <interactor> ;
|
||||||
|
|
||||||
: <stack-display> ( -- gadget )
|
: <stack-display> ( -- gadget )
|
||||||
gadget get listener-gadget-stack
|
gadget get listener-gadget-stack
|
||||||
|
|
Loading…
Reference in New Issue