ui.gadgets.menus now supports separators

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 1cb2e2a51de904379a85dd315ed1513720bbd452..f3de3493620d530f8bec7da5af6a12c06c3a0ca6 100755 (executable)
--- 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 9bfee85d6566f7d5e73e04820be2e533f10e0750..a0038b55e5e5bd493f619d78e60ccf7b3a850500 100644 (file)
--- 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 } <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 ;
\ No newline at end of file

diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor
index b15c34e35f97514f57b5be6dead0371825d5acfb..2f9cfba961adf3795f1de6eeba25b25c2f8aac85 100644 (file)
--- a/basis/ui/operations/operations.factor
+++ b/basis/ui/operations/operations.factor
@@ -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 ;