Merge remote branch 'ex-rzr/master' into gtk

Conflicts:
	basis/ui/backend/gtk/gtk.factor

basis/ui/backend/gtk/gtk.factor

@@ -133,9 +133,7 @@ CONSTANT: action-key-codes
     [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
 
 : gadget-location ( gadget -- loc )
-    [ loc>> ] [
+    [ loc>> ] [ parent>> [ gadget-location v+ ] when* ] bi ;
-        parent>> [ gadget-location ] [ { 0 0 } ] if*
-    ] bi v+ ;
 
 : focusable-editor ( world -- editor/f )
     focusable-child dup editor? [ drop f ] unless ;
@@ -151,10 +149,9 @@ CONSTANT: action-key-codes
     ] [ drop ] if* ;
 
 : on-motion ( sender event user-data -- result )
-    drop swap [
+    drop swap
-        [ GdkEventMotion memory>struct event-loc ] dip window
+    [ GdkEventMotion memory>struct event-loc ] dip window
-        move-hand fire-motion
+    move-hand fire-motion t ;
-    ] [ window update-im-cursor-location ] bi t ;
 
 : on-enter ( sender event user-data -- result )
     on-motion ;
@@ -178,60 +175,33 @@ CONSTANT: action-key-codes
     drop swap [
         GdkEventScroll memory>struct
         [ scroll-direction ] [ event-loc ] bi
-    ] dip window
+    ] dip window send-scroll t ;
-    [ send-scroll ] [ update-im-cursor-location ] bi t ;
 
-: key-sym ( event -- sym action? )
+: key-sym ( event -- sym/f action? )
-    keyval>> dup action-key-codes at
+    keyval>> dup action-key-codes at [ t ]
-    [ t ] [ gdk_keyval_to_unicode 1string f ] ?if ;
+    [ gdk_keyval_to_unicode [ f ] [ 1string ] if-zero f ] ?if ;
 
-: key-event>gesture ( event -- modifiers sym action? )
+: key-event>gesture ( event -- mods sym/f action? )
+    GdkEventKey memory>struct
     [ event-modifiers ] [ key-sym ] bi ;
 
-: valid-input? ( string gesture -- ? )
+: handle-key-gesture ( key-gesture world -- )
-    over empty? [ 2drop f ] [
+    [ propagate-key-gesture ]
-        mods>> { f { S+ } } member? [
+    [ update-im-cursor-location ] bi ;
-            [ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
-        ] [
-            [ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
-        ] if
-    ] if ;
    
-:: on-key-press ( sender event user-data -- result )
+: on-key-press ( sender event user-data -- result )
-    sender window :> world
+    drop swap [ key-event>gesture <key-down> ] [ window ] bi*
-    world handle>> im-context>> :> im-context
+    handle-key-gesture t ;
-    im-context event gtk_im_context_filter_keypress
-    [
-        event GdkEventKey memory>struct :> ev
-        ev key-event>gesture <key-down> :> gesture
-        gesture world propagate-key-gesture
-        ev keyval>> gdk_keyval_to_unicode 1string dup
-        gesture valid-input?
-        [ world user-input ] [ drop ] if
-    ] unless
-    world update-im-cursor-location t ;
 
-:: on-key-release ( sender event user-data -- result )
+: on-key-release ( sender event user-data -- result )
-    sender window :> world
+    drop swap [ key-event>gesture <key-up> ] [ window ] bi*
-    world handle>> im-context>> event gtk_im_context_filter_keypress
+    handle-key-gesture t ;
-    [
-        event GdkEventKey memory>struct
-        key-event>gesture <key-up>
-        world propagate-key-gesture
-    ] unless
-    world update-im-cursor-location t ;
 
 : on-focus-in ( sender event user-data -- result )
-    2drop window [ focus-world ]
+    2drop window focus-world t ;
-    [ handle>> im-context>> gtk_im_context_focus_in ]
-    [ update-im-cursor-location ] tri
-    f ;
 
 : on-focus-out ( sender event user-data -- result )
-    2drop window [ unfocus-world ]
+    2drop window unfocus-world t ;
-    [ handle>> im-context>> gtk_im_context_focus_out ]
-    [ update-im-cursor-location ] tri
-    f ;
 
 : on-expose ( sender event user-data -- result )
     2drop window relayout t ;
@@ -328,40 +298,11 @@ M: gtk-ui-backend (with-ui)
         ] with-destructors
     ] ui-running ;
 
-: im-context>world ( im-context -- world )
+: connect-signal-with-data ( object signal-name callback data -- )
-    ui:windows get-global
+    [ utf8 string>alien ] 2dip f 0 g_signal_connect_data drop ;
-    [ second handle>> im-context>> = ] with find nip second ;
-
-:: on-commit ( im-context string' user-data -- )
-    im-context im-context>world :> world
-    string' utf8 alien>string :> string
-    f string f <key-down> :> gesture
-    gesture world propagate-key-gesture
-    string world user-input
-    world update-im-cursor-location ;
-
-:: on-retrieve-surrounding ( im-context user-data -- ? )
-    im-context im-context>world focusable-editor
-    [| editor |
-        editor editor-caret first2 :> ( x y )
-        im-context
-        y editor editor-line utf8 string>alien
-        -1 x
-        gtk_im_context_set_surrounding t
-    ] [ f ] if* ;
-
-:: on-delete-surrounding ( im-context offset n user-data -- ? )
-    im-context im-context>world :> world
-    world focusable-editor [| editor |
-        editor editor-caret first2 :> ( x y )
-        x offset + y [ 2array ] [ [ n + ] dip 2array ] 2bi
-        editor remove-doc-range
-        world update-im-cursor-location
-        t
-    ] [ f ] if* ;
 
 : connect-signal ( object signal-name callback -- )
-    [ utf8 string>alien ] dip f f 0 g_signal_connect_data drop ;
+    f connect-signal-with-data ;
 
 :: connect-signals ( win -- )
     win events-mask [ enum>number ] [ bitor ] map-reduce
@@ -394,19 +335,78 @@ M: gtk-ui-backend (with-ui)
     win "delete-event" [ on-delete yield ]
     GtkWidget:delete-event connect-signal ;
 
-: connect-im-signals ( im-context -- )
+: on-retrieve-surrounding ( im-context user-data -- ? )
-    {
+    window focusable-editor [| im-context editor |
-        [
+        editor editor-caret first2 :> ( x y )
-            "commit" [ on-commit yield ]
+        im-context
-            GtkIMContext:commit connect-signal
+        y editor editor-line utf8 string>alien
-        ] [
+        -1 x
-            "retrieve-surrounding" [ on-retrieve-surrounding yield ]
+        gtk_im_context_set_surrounding t
-            GtkIMContext:retrieve-surrounding connect-signal
+    ] [ drop f ] if* ;
-        ] [
+
-            "delete-surrounding" [ on-delete-surrounding yield ]
+:: on-delete-surrounding ( im-context offset n user-data -- ? )
-            GtkIMContext:delete-surrounding connect-signal
+    user-data window :> world
-        ]
+    world focusable-editor [| editor |
-    } cleave ;
+        editor editor-caret first2 :> ( x y )
+        x offset + y [ 2array ] [ [ n + ] dip 2array ] 2bi
+        editor remove-doc-range
+        world update-im-cursor-location
+        t
+    ] [ f ] if* ;
+
+: on-commit ( sender str user_data -- )
+    [ drop ] [ utf8 alien>string ] [ window ] tri*
+    [ user-input ]
+    [ [ f swap key-down boa ] dip handle-key-gesture ] 2bi ;
+
+! has to be called before the window signal handler
+: im-on-key-event ( sender event user-data -- result )
+    [ drop ] 2dip swap gtk_im_context_filter_keypress ;
+
+: im-on-focus-in ( sender event user-data -- result )
+    2drop window
+    [ handle>> im-context>> gtk_im_context_focus_in ]
+    [ update-im-cursor-location ] bi f ;
+
+: im-on-focus-out ( sender event user-data -- result )
+    2drop window
+    [ handle>> im-context>> gtk_im_context_focus_out ]
+    [ update-im-cursor-location ] bi f ;
+
+: im-on-motion ( sender event user-data -- result )
+    2drop window update-im-cursor-location f ;
+
+: im-on-destroy ( sender user-data -- result )
+    nip [ f gtk_im_context_set_client_window ]
+    [ g_object_unref ] bi f ;
+
+:: configure-im ( win im -- )
+    im win gtk_widget_get_window gtk_im_context_set_client_window
+    im f gtk_im_context_set_use_preedit
+    
+    im "commit" [ on-commit yield ]
+    GtkIMContext:commit win connect-signal-with-data
+    im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
+    GtkIMContext:retrieve-surrounding win connect-signal-with-data
+    im "delete-surrounding" [ on-delete-surrounding yield ]
+    GtkIMContext:delete-surrounding win connect-signal-with-data
+
+    win "key-press-event" [ im-on-key-event yield ]
+    GtkWidget:key-press-event im connect-signal-with-data
+    win "key-release-event" [ im-on-key-event yield ]
+    GtkWidget:key-release-event im connect-signal-with-data
+    win "focus-in-event" [ im-on-focus-in yield ]
+    GtkWidget:focus-out-event im connect-signal-with-data
+    win "focus-out-event" [ im-on-focus-out yield ]
+    GtkWidget:focus-out-event im connect-signal-with-data
+    win "motion-notify-event" [ im-on-motion yield ]
+    GtkWidget:motion-notify-event connect-signal
+    win "enter-notify-event" [ im-on-motion yield ]
+    GtkWidget:enter-notify-event connect-signal
+    win "scroll-event" [ im-on-motion yield ]
+    GtkWidget:scroll-event connect-signal
+    win "destroy" [ im-on-destroy yield ]
+    GtkObject:destroy im connect-signal-with-data ;
 
 CONSTANT: window-controls>decor-flags
     H{
@@ -451,7 +451,7 @@ CONSTANT: window-controls>func-flags
         f t GDK_GL_RGBA_TYPE enum>number gtk_widget_set_gl_capability
     ] with-world-pixel-format ;
 
-: auto-position ( window loc -- )
+: auto-position ( win loc -- )
     dup { 0 0 } = [
         drop dup window topmost-window =
         GTK_WIN_POS_CENTER GTK_WIN_POS_NONE ?
@@ -460,11 +460,9 @@ CONSTANT: window-controls>func-flags
 
 M:: gtk-ui-backend (open-window) ( world -- )
     GTK_WINDOW_TOPLEVEL gtk_window_new :> win
-    gtk_im_multicontext_new :> im-context
+    gtk_im_multicontext_new :> im
     
-    im-context f gtk_im_context_set_use_preedit
+    win im <window-handle> world handle<<
-    
-    win im-context <window-handle> world handle<<
 
     world win register-window
     
@@ -473,20 +471,16 @@ M:: gtk-ui-backend (open-window) ( world -- )
     
     world setup-gl drop
 
-    win connect-signals
-    im-context connect-im-signals
-    
     win gtk_widget_realize
     win world window-controls>> configure-window-controls
     
-    im-context win gtk_widget_get_window
+    win im configure-im
-    gtk_im_context_set_client_window
+    win connect-signals
 
     win gtk_widget_show_all ;
 
 M: gtk-ui-backend (close-window) ( handle -- )
-    [ im-context>> f gtk_im_context_set_client_window ]
+    window>> [ gtk_widget_destroy ] [ unregister-window ] bi
-    [ window>> [ gtk_widget_destroy ] [ unregister-window ] bi ] bi
     event-loop? [ gtk_main_quit ] unless ;
 
 M: gtk-ui-backend set-title