ui.gadgets.menus now supports separators

db4
Slava Pestov 2009-02-18 21:00:53 -06:00
parent 706fb33e38
commit 204777ec3f
3 changed files with 47 additions and 11 deletions

View File

@ -357,16 +357,16 @@ editor "editing" f {
{ T{ key-down f { A+ } "BACKSPACE" } delete-to-end-of-line }
} define-command-map
: paste ( editor -- ) clipboard get paste-clipboard ;
: com-paste ( editor -- ) clipboard 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 {
{ paste-action paste }
{ paste-action com-paste }
{ copy-action com-copy }
{ cut-action cut }
{ cut-action com-cut }
{ T{ button-up f f 2 } paste-selection }
{ T{ button-up } com-copy-selection }
} define-command-map
@ -465,7 +465,14 @@ editor "selection" f {
} define-command-map
: 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 {
{ T{ button-down f f 3 } editor-menu }

View File

@ -3,20 +3,43 @@
USING: colors.constants kernel locals math.rectangles
namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
ui.gadgets.worlds ui.gestures ui.operations ui.pens.solid
accessors ;
ui.gadgets.worlds ui.gestures ui.operations ui.pens ui.pens.solid
opengl math.vectors words accessors math math.order sorting ;
IN: ui.gadgets.menus
: show-menu ( owner menu -- )
[ 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 [
hook call
target command command-button-quot call
hand-clicked get find-world hide-glass
hide-glass
] <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 )
COLOR: light-gray <solid> >>interior ;
@ -29,7 +52,10 @@ IN: ui.gadgets.menus
[ dup [ ] ] dip <commands-menu> show-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 -- )
<operations-menu> show-menu ;

View File

@ -45,8 +45,11 @@ operations [ <linked-hash> ] initialize
: find-operation ( obj quot -- command )
[ object-operations ] dip find-last nip ; inline
: primary-operation? ( operation -- ? )
command>> +primary+ word-prop ;
: primary-operation ( obj -- operation )
[ command>> +primary+ word-prop ] find-operation ;
[ primary-operation? ] find-operation ;
: invoke-primary-operation ( obj -- )
dup primary-operation invoke-command ;