diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 1cb2e2a51d..f3de349362 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -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 } diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor index 9bfee85d65..a0038b55e5 100644 --- a/basis/ui/gadgets/menus/menus.factor +++ b/basis/ui/gadgets/menus/menus.factor @@ -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 } show-glass ; -:: ( target hook command -- button ) +GENERIC: ( target hook command -- button ) + +M:: object ( target hook command -- button ) command command-name [ hook call target command command-button-quot call - hand-clicked get find-world hide-glass + hide-glass ] ; + 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: ---- + 3drop + + { 0 5 } >>dim + COLOR: black >>interior ; + : menu-theme ( gadget -- gadget ) COLOR: light-gray >>interior ; @@ -29,7 +52,10 @@ IN: ui.gadgets.menus [ dup [ ] ] dip show-menu ; : ( target hook -- menu ) - over object-operations ; + over object-operations + [ primary-operation? ] partition + [ reverse ] [ [ [ command-name ] compare ] sort ] bi* + { ---- } glue ; : show-operations-menu ( gadget target hook -- ) show-menu ; \ No newline at end of file diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index b15c34e35f..2f9cfba961 100644 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -45,8 +45,11 @@ operations [ ] 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 ;