output current input last-line prototype scrolls?
selection-color caret mark selecting? ;
+TUPLE: pane-stream pane ;
+
+C: <pane-stream> pane-stream
+
+<PRIVATE
+
: clear-selection ( pane -- pane )
f >>caret f >>mark ; inline
M: pane gadget-selection ( pane -- string/f )
selected-children gadget-text ;
-: pane-clear ( pane -- )
- clear-selection
- [ output>> clear-incremental ]
- [ current>> clear-gadget ]
- bi ;
-
: init-prototype ( pane -- pane )
<shelf> +baseline+ >>align >>prototype ; inline
[ >>last-line ] [ 1 track-add ] bi
dup prepare-last-line ; inline
-: new-pane ( input class -- pane )
- [ vertical ] dip new-track
- swap >>input
- pane-theme
- init-prototype
- init-output
- init-current
- init-last-line ; inline
-
-: <pane> ( -- pane ) f pane new-pane ;
-
GENERIC: draw-selection ( loc obj -- )
: if-fits ( rect quot -- )
: scroll-pane ( pane -- )
dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
-TUPLE: pane-stream pane ;
-
-C: <pane-stream> pane-stream
-
: smash-line ( current -- gadget )
dup children>> {
{ [ dup empty? ] [ 2drop "" <label> ] }
[ drop ]
} cond ;
-: smash-pane ( pane -- gadget ) output>> smash-line ;
-
: pane-nl ( pane -- )
[
[ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
add-incremental
] [ next-line ] bi ;
+: ?pane-nl ( pane -- )
+ [ dup current>> children>> empty? [ pane-nl ] [ drop ] if ]
+ [ pane-nl ] bi ;
+
+: smash-pane ( pane -- gadget ) [ pane-nl ] [ output>> smash-line ] bi ;
+
: pane-write ( seq pane -- )
[ pane-nl ] [ current>> stream-write ]
bi-curry interleave ;
[ nip pane-nl ] [ current>> stream-format ]
bi-curry bi-curry interleave ;
+: do-pane-stream ( pane-stream quot -- )
+ [ pane>> ] dip keep scroll-pane ; inline
+
+M: pane-stream stream-nl
+ [ pane-nl ] do-pane-stream ;
+
+M: pane-stream stream-write1
+ [ current>> stream-write1 ] do-pane-stream ;
+
+M: pane-stream stream-write
+ [ [ string-lines ] dip pane-write ] do-pane-stream ;
+
+M: pane-stream stream-format
+ [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
+
+M: pane-stream dispose drop ;
+
+M: pane-stream stream-flush drop ;
+
+M: pane-stream make-span-stream
+ swap <style-stream> <ignore-close-stream> ;
+
+PRIVATE>
+
+: new-pane ( input class -- pane )
+ [ vertical ] dip new-track
+ swap >>input
+ pane-theme
+ init-prototype
+ init-output
+ init-current
+ init-last-line ; inline
+
+: <pane> ( -- pane ) f pane new-pane ;
+
GENERIC: write-gadget ( gadget stream -- )
M: pane-stream write-gadget ( gadget pane-stream -- )
: gadget. ( gadget -- )
output-stream get print-gadget ;
-: ?nl ( stream -- )
- dup pane>> current>> children>> empty?
- [ dup stream-nl ] unless drop ;
+: pane-clear ( pane -- )
+ clear-selection
+ [ output>> clear-incremental ]
+ [ current>> clear-gadget ]
+ bi ;
: with-pane ( pane quot -- )
- over scroll>top
- over pane-clear [ <pane-stream> ] dip
- over [ with-output-stream* ] dip ?nl ; inline
+ [ [ scroll>top ] [ pane-clear ] [ <pane-stream> ] tri ] dip
+ with-output-stream* ; inline
: make-pane ( quot -- gadget )
- <pane> [ swap with-pane ] keep smash-pane ; inline
+ [ <pane> ] dip [ with-pane ] [ drop smash-pane ] 2bi ; inline
TUPLE: pane-control < pane quot ;
swap >>quot
swap >>model ;
-: do-pane-stream ( pane-stream quot -- )
- [ pane>> ] dip keep scroll-pane ; inline
-
-M: pane-stream stream-nl
- [ pane-nl ] do-pane-stream ;
-
-M: pane-stream stream-write1
- [ current>> stream-write1 ] do-pane-stream ;
-
-M: pane-stream stream-write
- [ [ string-lines ] dip pane-write ] do-pane-stream ;
-
-M: pane-stream stream-format
- [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
-
-M: pane-stream dispose drop ;
-
-M: pane-stream stream-flush drop ;
-
-M: pane-stream make-span-stream
- swap <style-stream> <ignore-close-stream> ;
-
! Character styles
+<PRIVATE
MEMO: specified-font ( assoc -- font )
#! We memoize here to avoid creating lots of duplicate font objects.
inline
: unnest-pane-stream ( stream -- child parent )
- dup ?nl
- dup style>>
- over pane>> smash-pane style-pane
- swap parent>> ;
+ [ [ style>> ] [ pane>> smash-pane ] bi style-pane ] [ parent>> ] bi ;
TUPLE: pane-block-stream < nested-pane-stream ;
TUPLE: pane-cell-stream < nested-pane-stream ;
-M: pane-cell-stream dispose ?nl ;
+M: pane-cell-stream dispose drop ;
M: pane-stream make-cell-stream
pane-cell-stream new-nested-pane-stream ;
[
swap [ [ pane>> smash-pane ] map ] map
styled-grid
- ] dip print-gadget ;
+ ] dip write-gadget ;
! Stream utilities
M: pack dispose drop ;
: pane-menu ( pane -- ) { com-copy } show-commands-menu ;
+PRIVATE>
+
pane H{
{ T{ button-down } [ begin-selection ] }
{ T{ button-down f { S+ } 1 } [ select-to-caret ] }