ui.gadgets.menus now supports separators
parent
706fb33e38
commit
204777ec3f
|
@ -357,16 +357,16 @@ editor "editing" f {
|
||||||
{ T{ key-down f { A+ } "BACKSPACE" } delete-to-end-of-line }
|
{ T{ key-down f { A+ } "BACKSPACE" } delete-to-end-of-line }
|
||||||
} define-command-map
|
} define-command-map
|
||||||
|
|
||||||
: paste ( editor -- ) clipboard get paste-clipboard ;
|
: com-paste ( editor -- ) clipboard get paste-clipboard ;
|
||||||
|
|
||||||
: paste-selection ( editor -- ) selection get paste-clipboard ;
|
: paste-selection ( editor -- ) selection get paste-clipboard ;
|
||||||
|
|
||||||
: cut ( editor -- ) clipboard get editor-cut ;
|
: com-cut ( editor -- ) clipboard get editor-cut ;
|
||||||
|
|
||||||
editor "clipboard" f {
|
editor "clipboard" f {
|
||||||
{ paste-action paste }
|
{ paste-action com-paste }
|
||||||
{ copy-action com-copy }
|
{ copy-action com-copy }
|
||||||
{ cut-action cut }
|
{ cut-action com-cut }
|
||||||
{ T{ button-up f f 2 } paste-selection }
|
{ T{ button-up f f 2 } paste-selection }
|
||||||
{ T{ button-up } com-copy-selection }
|
{ T{ button-up } com-copy-selection }
|
||||||
} define-command-map
|
} define-command-map
|
||||||
|
@ -465,7 +465,14 @@ editor "selection" f {
|
||||||
} define-command-map
|
} define-command-map
|
||||||
|
|
||||||
: editor-menu ( editor -- )
|
: editor-menu ( editor -- )
|
||||||
{ com-undo com-redo cut com-copy paste } show-commands-menu ;
|
{
|
||||||
|
com-undo
|
||||||
|
com-redo
|
||||||
|
----
|
||||||
|
com-cut
|
||||||
|
com-copy
|
||||||
|
com-paste
|
||||||
|
} show-commands-menu ;
|
||||||
|
|
||||||
editor "misc" f {
|
editor "misc" f {
|
||||||
{ T{ button-down f f 3 } editor-menu }
|
{ T{ button-down f f 3 } editor-menu }
|
||||||
|
|
|
@ -3,20 +3,43 @@
|
||||||
USING: colors.constants kernel locals math.rectangles
|
USING: colors.constants kernel locals math.rectangles
|
||||||
namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
|
namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
|
||||||
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
|
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
|
||||||
ui.gadgets.worlds ui.gestures ui.operations ui.pens.solid
|
ui.gadgets.worlds ui.gestures ui.operations ui.pens ui.pens.solid
|
||||||
accessors ;
|
opengl math.vectors words accessors math math.order sorting ;
|
||||||
IN: ui.gadgets.menus
|
IN: ui.gadgets.menus
|
||||||
|
|
||||||
: show-menu ( owner menu -- )
|
: show-menu ( owner menu -- )
|
||||||
[ find-world ] dip hand-loc get { 0 0 } <rect> show-glass ;
|
[ find-world ] dip hand-loc get { 0 0 } <rect> show-glass ;
|
||||||
|
|
||||||
:: <menu-item> ( target hook command -- button )
|
GENERIC: <menu-item> ( target hook command -- button )
|
||||||
|
|
||||||
|
M:: object <menu-item> ( target hook command -- button )
|
||||||
command command-name [
|
command command-name [
|
||||||
hook call
|
hook call
|
||||||
target command command-button-quot call
|
target command command-button-quot call
|
||||||
hand-clicked get find-world hide-glass
|
hide-glass
|
||||||
] <roll-button> ;
|
] <roll-button> ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
TUPLE: separator-pen color ;
|
||||||
|
|
||||||
|
C: <separator-pen> separator-pen
|
||||||
|
|
||||||
|
M: separator-pen draw-interior
|
||||||
|
color>> gl-color
|
||||||
|
dim>> [ { 0 0.5 } v* ] [ { 1 0.5 } v* ] bi
|
||||||
|
[ [ >integer ] map ] bi@ gl-line ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
SINGLETON: ----
|
||||||
|
|
||||||
|
M: ---- <menu-item>
|
||||||
|
3drop
|
||||||
|
<gadget>
|
||||||
|
{ 0 5 } >>dim
|
||||||
|
COLOR: black <separator-pen> >>interior ;
|
||||||
|
|
||||||
: menu-theme ( gadget -- gadget )
|
: menu-theme ( gadget -- gadget )
|
||||||
COLOR: light-gray <solid> >>interior ;
|
COLOR: light-gray <solid> >>interior ;
|
||||||
|
|
||||||
|
@ -29,7 +52,10 @@ IN: ui.gadgets.menus
|
||||||
[ dup [ ] ] dip <commands-menu> show-menu ;
|
[ dup [ ] ] dip <commands-menu> show-menu ;
|
||||||
|
|
||||||
: <operations-menu> ( target hook -- menu )
|
: <operations-menu> ( target hook -- menu )
|
||||||
over object-operations <commands-menu> ;
|
over object-operations
|
||||||
|
[ primary-operation? ] partition
|
||||||
|
[ reverse ] [ [ [ command-name ] compare ] sort ] bi*
|
||||||
|
{ ---- } glue <commands-menu> ;
|
||||||
|
|
||||||
: show-operations-menu ( gadget target hook -- )
|
: show-operations-menu ( gadget target hook -- )
|
||||||
<operations-menu> show-menu ;
|
<operations-menu> show-menu ;
|
|
@ -45,8 +45,11 @@ operations [ <linked-hash> ] initialize
|
||||||
: find-operation ( obj quot -- command )
|
: find-operation ( obj quot -- command )
|
||||||
[ object-operations ] dip find-last nip ; inline
|
[ object-operations ] dip find-last nip ; inline
|
||||||
|
|
||||||
|
: primary-operation? ( operation -- ? )
|
||||||
|
command>> +primary+ word-prop ;
|
||||||
|
|
||||||
: primary-operation ( obj -- operation )
|
: primary-operation ( obj -- operation )
|
||||||
[ command>> +primary+ word-prop ] find-operation ;
|
[ primary-operation? ] find-operation ;
|
||||||
|
|
||||||
: invoke-primary-operation ( obj -- )
|
: invoke-primary-operation ( obj -- )
|
||||||
dup primary-operation invoke-command ;
|
dup primary-operation invoke-command ;
|
||||||
|
|
Loading…
Reference in New Issue