ui.backend.*: new vocab for keysym handling which is the same on x11 and gtk

diff --git a/basis/ui/backend/gtk/gtk-tests.factor b/basis/ui/backend/gtk/gtk-tests.factor
index a3a285a4777d7da7e0e6f785433c69ab11790229..1a3b2f5da1745055ab87d3767fc988b11e72a7bd 100644 (file)
--- a/basis/ui/backend/gtk/gtk-tests.factor
+++ b/basis/ui/backend/gtk/gtk-tests.factor
@@ -49,6 +49,7 @@ IN: ui.backend.gtk.tests
 
 ! The Mac build servers doesn't have the gtk libs
 os linux? [
+    ! key-event>gesture
     {
         T{ key-down f f "F2" }
         T{ key-up f f "H" }
@@ -58,6 +59,11 @@ os linux? [
         gdk-key-release-event key-event>gesture
         gdk-space-key-press-event key-event>gesture
     ] unit-test
+
+    ! key-sym
+    { "F2" t } [
+        GDK_KEY_F2 key-sym
+    ] unit-test
 ] when
 
 { 9854 } [

diff --git a/basis/ui/backend/gtk/gtk.factor b/basis/ui/backend/gtk/gtk.factor
index 887d0318ad34dfc482e565eeedee9781d42edbe6..75167fb43af90353e3a1416d32c51e674d8f3a83 100644 (file)
--- a/basis/ui/backend/gtk/gtk.factor
+++ b/basis/ui/backend/gtk/gtk.factor
@@ -7,10 +7,10 @@ gobject-introspection.standard-types gobject.ffi gtk.ffi gtk.gl.ffi
 io.encodings.binary io.encodings.utf8 io.files io.pathnames kernel
 libc literals locals math math.bitwise math.vectors namespaces
 sequences strings system threads ui ui.backend
-ui.backend.gtk.input-methods ui.backend.gtk.io ui.clipboards
-ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gestures ui.pixel-formats ui.pixel-formats.private ui.private
-vocabs.loader ;
+ui.backend.gtk.input-methods ui.backend.gtk.io ui.backend.x11.keys
+ui.clipboards ui.event-loop ui.gadgets ui.gadgets.private
+ui.gadgets.worlds ui.gestures ui.pixel-formats
+ui.pixel-formats.private ui.private vocabs.loader ;
 IN: ui.backend.gtk
 
 SINGLETON: gtk-ui-backend
@@ -97,49 +97,6 @@ CONSTANT: events-mask
         GDK_FOCUS_CHANGE_MASK
     }
 
-CONSTANT: modifiers
-    {
-        { S+ $ GDK_SHIFT_MASK }
-        { C+ $ GDK_CONTROL_MASK }
-        { A+ $ GDK_MOD1_MASK }
-    }
-
-CONSTANT: action-key-codes
-    H{
-        { $ GDK_KEY_BackSpace "BACKSPACE" }
-        { $ GDK_KEY_Tab "TAB" }
-        { $ GDK_KEY_ISO_Left_Tab "TAB" }
-        { $ GDK_KEY_Return "RET" }
-        { $ GDK_KEY_KP_Enter "ENTER" }
-        { $ GDK_KEY_Escape "ESC" }
-        { $ GDK_KEY_Delete "DELETE" }
-        { $ GDK_KEY_Insert "INSERT" }
-        { $ GDK_KEY_Home "HOME" }
-        { $ GDK_KEY_Left "LEFT" }
-        { $ GDK_KEY_Up "UP" }
-        { $ GDK_KEY_Right "RIGHT" }
-        { $ GDK_KEY_Down "DOWN" }
-        { $ GDK_KEY_Page_Up "PAGE_UP" }
-        { $ GDK_KEY_Page_Down "PAGE_DOWN" }
-        { $ GDK_KEY_End "END" }
-        { $ GDK_KEY_Begin "BEGIN" }
-        { $ GDK_KEY_F1 "F1" }
-        { $ GDK_KEY_F2 "F2" }
-        { $ GDK_KEY_F3 "F3" }
-        { $ GDK_KEY_F4 "F4" }
-        { $ GDK_KEY_F5 "F5" }
-        { $ GDK_KEY_F6 "F6" }
-        { $ GDK_KEY_F7 "F7" }
-        { $ GDK_KEY_F8 "F8" }
-        { $ GDK_KEY_F9 "F9" }
-        { $ GDK_KEY_F10 "F10" }
-        { $ GDK_KEY_F11 "F11" }
-        { $ GDK_KEY_F12 "F12" }
-    }
-
-: event-modifiers ( event -- seq )
-    state>> modifiers modifier ;
-
 : event-loc ( event -- loc )
     [ x>> ] [ y>> ] bi [ >fixnum ] bi@ 2array ;
 
@@ -197,13 +154,11 @@ CONSTANT: action-key-codes
         [ scroll-direction ] [ event-loc ] bi
     ] dip window send-scroll t ;
 
-: key-sym ( event -- sym/f action? )
-    keyval>> dup action-key-codes at [ t ] [
-        gdk_keyval_to_unicode [ f ] [ 1string ] if-zero f
-    ] ?if ;
+: key-sym ( keyval -- string/f action? )
+    code>sym [ dup integer? [ gdk_keyval_to_unicode 1string ] when ] dip ;
 
 : key-event>gesture ( event -- key-gesture )
-    [ event-modifiers ] [ key-sym ] [
+    [ event-modifiers ] [ keyval>> key-sym ] [
         type>> GDK_KEY_PRESS = [ <key-down> ] [ <key-up> ] if
     ] tri ;
 

diff --git a/basis/ui/backend/x11/keys/keys-tests.factor b/basis/ui/backend/x11/keys/keys-tests.factor
new file mode 100644 (file)
index 0000000..87c1491
--- /dev/null
+++ b/basis/ui/backend/x11/keys/keys-tests.factor
@@ -0,0 +1,12 @@
+USING: tools.test ui.backend.x11.keys x11.keysymdef ;
+IN: ui.backend.x11.keys.tests
+
+{
+    65 f
+    "RET" t
+    f f
+} [
+    65 code>sym
+    XK_Return code>sym
+    XK_Hyper_R code>sym
+] unit-test

diff --git a/basis/ui/backend/x11/keys/keys.factor b/basis/ui/backend/x11/keys/keys.factor
new file mode 100644 (file)
index 0000000..183b410
--- /dev/null
+++ b/basis/ui/backend/x11/keys/keys.factor
@@ -0,0 +1,71 @@
+! Copyright (C) 2016 Björn Lindqvist
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs columns kernel literals math sequences
+sets ui.gestures x11.keysymdef ;
+IN: ui.backend.x11.keys
+
+CONSTANT: modifiers
+    {
+        { S+ 0x1 }
+        { C+ 0x4 }
+        { A+ 0x8 }
+    }
+
+CONSTANT: codes
+    H{
+        { $ XK_BackSpace "BACKSPACE" }
+        { $ XK_Tab "TAB" }
+        { $ XK_ISO_Left_Tab "TAB" }
+        { $ XK_Return "RET" }
+        { $ XK_KP_Enter "ENTER" }
+        { $ XK_Escape "ESC" }
+        { $ XK_Delete "DELETE" }
+        { $ XK_Insert "INSERT" }
+        { $ XK_Home "HOME" }
+        { $ XK_Left "LEFT" }
+        { $ XK_Up "UP" }
+        { $ XK_Right "RIGHT" }
+        { $ XK_Down "DOWN" }
+        { $ XK_Page_Up "PAGE_UP" }
+        { $ XK_Page_Down "PAGE_DOWN" }
+        { $ XK_End "END" }
+        { $ XK_Begin "BEGIN" }
+        { $ XK_F1 "F1" }
+        { $ XK_F2 "F2" }
+        { $ XK_F3 "F3" }
+        { $ XK_F4 "F4" }
+        { $ XK_F5 "F5" }
+        { $ XK_F6 "F6" }
+        { $ XK_F7 "F7" }
+        { $ XK_F8 "F8" }
+        { $ XK_F9 "F9" }
+        { $ XK_F10 "F10" }
+        { $ XK_F11 "F11" }
+        { $ XK_F11 "F12" }
+
+        { $ XK_Shift_L f }
+        { $ XK_Shift_R f }
+        { $ XK_Control_L f }
+        { $ XK_Control_R f }
+        { $ XK_Caps_Lock f }
+        { $ XK_Shift_Lock f }
+
+        { $ XK_Meta_L f }
+        { $ XK_Meta_R f }
+        { $ XK_Alt_L f }
+        { $ XK_Alt_R f }
+        { $ XK_Super_L f }
+        { $ XK_Super_R f }
+        { $ XK_Hyper_L f }
+        { $ XK_Hyper_R f }
+    }
+
+: code>sym ( code -- name/code/f action? )
+    dup codes at* [ nip dup t and ] when ;
+
+: modifier ( mod modifiers -- seq )
+    [ second swap bitand 0 > ] with filter
+    0 <column> members [ f ] [ >array ] if-empty ;
+
+: event-modifiers ( event -- seq )
+    state>> modifiers modifier ;

diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index 4b04964bb95ea7520be1854cc513c72bdbf5c74a..ce2133c94c735c1320755fb95eb92a42c32b57a8 100644 (file)
--- a/basis/ui/backend/x11/x11.factor
+++ b/basis/ui/backend/x11/x11.factor
@@ -4,10 +4,10 @@ USING: accessors alien.c-types alien.data alien.syntax arrays ascii
 assocs classes.struct combinators combinators.short-circuit
 environment io.encodings.ascii io.encodings.string io.encodings.utf8
 kernel literals locals math namespaces sequences specialized-arrays
-strings ui ui.backend ui.clipboards ui.event-loop ui.gadgets
-ui.gadgets.private ui.gadgets.worlds ui.gestures ui.pixel-formats
-ui.pixel-formats.private ui.private x11 x11.clipboard x11.constants
-x11.events x11.glx x11.io x11.keysymdef x11.windows x11.xim x11.xlib ;
+strings ui ui.backend ui.backend.x11.keys ui.clipboards ui.event-loop
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
+ui.pixel-formats ui.pixel-formats.private ui.private x11 x11.clipboard
+x11.constants x11.events x11.glx x11.io x11.windows x11.xim x11.xlib ;
 FROM: libc => system ;
 SPECIALIZED-ARRAYS: uchar ulong ;
 IN: ui.backend.x11
@@ -94,63 +94,8 @@ M: x11-ui-backend (pixel-format-attribute)
         { int } [ glXGetConfig drop ] with-out-parameters
     ] if-empty ;
 
-CONSTANT: modifiers
-    {
-        { S+ 0x1 }
-        { C+ 0x4 }
-        { A+ 0x8 }
-    }
-
-CONSTANT: key-codes
-    H{
-        { $ XK_BackSpace "BACKSPACE" }
-        { $ XK_Tab "TAB" }
-        { $ XK_ISO_Left_Tab "TAB" }
-        { $ XK_Return "RET" }
-        { $ XK_KP_Enter "ENTER" }
-        { $ XK_Escape "ESC" }
-        { $ XK_Delete "DELETE" }
-        { $ XK_Home "HOME" }
-        { $ XK_Left "LEFT" }
-        { $ XK_Up "UP" }
-        { $ XK_Right "RIGHT" }
-        { $ XK_Down "DOWN" }
-        { $ XK_Page_Up "PAGE_UP" }
-        { $ XK_Page_Down "PAGE_DOWN" }
-        { $ XK_End "END" }
-        { $ XK_Begin "BEGIN" }
-        { $ XK_F1 "F1" }
-        { $ XK_F2 "F2" }
-        { $ XK_F3 "F3" }
-        { $ XK_F4 "F4" }
-        { $ XK_F5 "F5" }
-        { $ XK_F6 "F6" }
-        { $ XK_F7 "F7" }
-        { $ XK_F8 "F8" }
-        { $ XK_F9 "F9" }
-
-        { $ XK_Shift_L f }
-        { $ XK_Shift_R f }
-        { $ XK_Control_L f }
-        { $ XK_Control_R f }
-        { $ XK_Caps_Lock f }
-        { $ XK_Shift_Lock f }
-
-        { $ XK_Meta_L f }
-        { $ XK_Meta_R f }
-        { $ XK_Alt_L f }
-        { $ XK_Alt_R f }
-        { $ XK_Super_L f }
-        { $ XK_Super_R f }
-        { $ XK_Hyper_L f }
-        { $ XK_Hyper_R f }
-    }
-
-: key-code ( keysym -- keycode action? )
-    dup key-codes at* [ nip dup t and ] [ [ 1string ] dip ] if ;
-
-: event-modifiers ( event -- seq )
-    state>> modifiers modifier ;
+: key-code ( code -- string/f action? )
+    code>sym [ dup integer? [ 1string ] when ] dip ;
 
 : valid-input? ( string gesture -- ? )
     over empty? [ 2drop f ] [

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 82cf068164f7f813ded0f99acdb95fcf590df5e2..6c8b3049c584840984a0b52a0adf8e8dfbebdeb0 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -1,10 +1,9 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel math math.order models
-namespaces make sequences words strings system hashtables math.parser
-math.vectors classes.tuple classes boxes calendar timers combinators
-sets columns fry deques ui.gadgets ui.gadgets.private ascii
-combinators.short-circuit ;
+USING: accessors arrays ascii assocs boxes calendar classes
+combinators combinators.short-circuit deques fry kernel make math
+math.order math.parser math.vectors namespaces sequences system timers
+ui.gadgets ui.gadgets.private words ;
 IN: ui.gestures
 
 : get-gesture-handler ( gesture gadget -- quot )
@@ -98,13 +97,13 @@ SINGLETONS:
     revert-action close-action ;
 
 UNION: action
-undo-action redo-action
-cut-action copy-action paste-action
-delete-action select-all-action
-left-action right-action up-action down-action
-zoom-in-action zoom-out-action
-new-action open-action save-action save-as-action
-revert-action close-action ;
+    undo-action redo-action
+    cut-action copy-action paste-action
+    delete-action select-all-action
+    left-action right-action up-action down-action
+    zoom-in-action zoom-out-action
+    new-action open-action save-action save-as-action
+    revert-action close-action ;
 
 CONSTANT: action-gestures
     {
@@ -128,7 +127,7 @@ TUPLE: key-gesture mods sym ;
 
 TUPLE: key-down < key-gesture ;
 
-: new-key-gesture ( mods sym action? class -- mods' sym' )
+: new-key-gesture ( mods sym action? class -- key-gesture )
     [ [ [ S+ swap remove f like ] dip ] unless ] dip boa ; inline
 
 : <key-down> ( mods sym action? -- key-down )
@@ -234,10 +233,6 @@ SYMBOL: drag-timer
         focus<<
     ] if ;
 
-: modifier ( mod modifiers -- seq )
-    [ second swap bitand 0 > ] with filter
-    0 <column> members [ f ] [ >array ] if-empty ;
-
 : drag-loc ( -- loc )
     hand-loc get-global hand-click-loc get-global v- ;