ui.gadgets.panes: rewrite a few words

db4
Eduardo Cavazos 2008-07-16 00:12:47 -05:00
parent 19919bb130
commit 344ee0aa5d
1 changed files with 50 additions and 60 deletions

View File

@ -10,57 +10,46 @@ sorting splitting io.streams.nested assocs
ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
ui.gadgets.grid-lines classes.tuple models continuations
destructors accessors math.geometry.rect ;
IN: ui.gadgets.panes
TUPLE: pane < pack
output current prototype scrolls?
selection-color caret mark selecting? ;
: clear-selection ( pane -- )
f >>caret
f >>mark
drop ;
: clear-selection ( pane -- pane ) f >>caret f >>mark ;
: add-output ( current pane -- )
[ set-pane-output ] [ swap add-gadget drop ] 2bi ;
: add-output ( pane current -- pane ) [ >>output ] [ add-gadget ] bi ;
: add-current ( pane current -- pane ) [ >>current ] [ add-gadget ] bi ;
: add-current ( current pane -- )
[ set-pane-current ] [ swap add-gadget drop ] 2bi ;
: prepare-line ( pane -- pane )
clear-selection
dup prototype>> clone add-current ;
: prepare-line ( pane -- )
[ clear-selection ]
[ [ pane-prototype clone ] keep add-current ] bi ;
: pane-caret&mark ( pane -- caret mark )
[ caret>> ] [ mark>> ] bi ;
: pane-caret&mark ( pane -- caret mark ) [ caret>> ] [ mark>> ] bi ;
: selected-children ( pane -- seq )
[ pane-caret&mark sort-pair ] keep gadget-subtree ;
M: pane gadget-selection? pane-caret&mark and ;
M: pane gadget-selection
selected-children gadget-text ;
M: pane gadget-selection ( pane -- string/f ) selected-children gadget-text ;
: pane-clear ( pane -- )
[ clear-selection ]
clear-selection
[ pane-output clear-incremental ]
[ pane-current clear-gadget ]
tri ;
: pane-theme ( pane -- pane )
selection-color >>selection-color ; inline
bi ;
: new-pane ( class -- pane )
new-gadget
{ 0 1 } >>orientation
<shelf> >>prototype
<incremental> over add-output
dup prepare-line
pane-theme ;
<incremental> add-output
prepare-line
selection-color >>selection-color ;
: <pane> ( -- pane )
pane new-pane ;
: <pane> ( -- pane ) pane new-pane ;
GENERIC: draw-selection ( loc obj -- )
@ -102,25 +91,25 @@ C: <pane-stream> pane-stream
: smash-pane ( pane -- gadget ) pane-output smash-line ;
: pane-nl ( pane -- )
: pane-nl ( pane -- pane )
dup pane-current dup unparent smash-line
over pane-output add-incremental
prepare-line ;
: pane-write ( pane seq -- )
[ dup pane-nl ]
[ pane-nl ]
[ over pane-current stream-write ]
interleave drop ;
: pane-format ( style pane seq -- )
[ dup pane-nl ]
[ pane-nl ]
[ 2over pane-current stream-format ]
interleave 2drop ;
GENERIC: write-gadget ( gadget stream -- )
M: pane-stream write-gadget
pane-stream-pane pane-current swap add-gadget drop ;
M: pane-stream write-gadget ( gadget pane-stream -- )
pane>> current>> swap add-gadget drop ;
M: style-stream write-gadget
stream>> write-gadget ;
@ -148,8 +137,8 @@ M: style-stream write-gadget
TUPLE: pane-control < pane quot ;
M: pane-control model-changed
swap model-value swap dup pane-control-quot with-pane ;
M: pane-control model-changed ( model pane-control -- )
[ value>> ] [ dup quot>> ] bi* with-pane ;
: <pane-control> ( model quot -- pane )
pane-control new-pane
@ -160,7 +149,7 @@ M: pane-control model-changed
>r pane-stream-pane r> keep scroll-pane ; inline
M: pane-stream stream-nl
[ pane-nl ] do-pane-stream ;
[ pane-nl drop ] do-pane-stream ;
M: pane-stream stream-write1
[ pane-current stream-write1 ] do-pane-stream ;
@ -337,8 +326,9 @@ M: paragraph stream-format
2drop
] if ;
: caret>mark ( pane -- )
dup pane-caret over set-pane-mark relayout-1 ;
: caret>mark ( pane -- pane )
dup caret>> >>mark
dup relayout-1 ;
GENERIC: sloppy-pick-up* ( loc gadget -- n )
@ -362,25 +352,25 @@ M: f sloppy-pick-up*
[ 3drop { } ]
if ;
: move-caret ( pane -- )
: move-caret ( pane -- pane )
dup hand-rel
over sloppy-pick-up
over set-pane-caret
relayout-1 ;
dup relayout-1 ;
: begin-selection ( pane -- )
dup move-caret f swap set-pane-mark ;
move-caret f swap set-pane-mark ;
: extend-selection ( pane -- )
hand-moved? [
dup selecting?>> [
dup move-caret
move-caret
] [
dup hand-clicked get child? [
t >>selecting?
dup hand-clicked set-global
dup move-caret
dup caret>mark
move-caret
caret>mark
] when
] if
dup dup pane-caret gadget-at-path scroll>gadget
@ -395,8 +385,8 @@ M: f sloppy-pick-up*
] if ;
: select-to-caret ( pane -- )
dup pane-mark [ dup caret>mark ] unless
dup move-caret
dup pane-mark [ caret>mark ] unless
move-caret
dup request-focus
com-copy-selection ;