Merge branch 'gtk' of git://github.com/Blei/factor

basis/gdk/ffi/ffi.factor

@@ -23,7 +23,7 @@ GdkEventScroll GdkEventMotion GdkEventExpose GdkEventVisibility
 GdkEventCrossing GdkEventFocus GdkEventConfigure GdkEventProperty
 GdkEventSelection GdkEventDND GdkEventProximity GdkEventClient
 GdkEventNoExpose GdkEventWindowState GdkEventSetting
-GdkEventOwnerChange GdkEventGrabBroken ;
+GdkEventOwnerChange GdkEventGrabBroken GdkRectangle ;
 
 GIR: vocab:gdk/Gdk-2.0.gir
 

basis/ui/backend/gtk/gtk.factor

@@ -2,22 +2,27 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.accessors alien.c-types alien.data
 alien.enums alien.strings arrays ascii assocs classes.struct
-combinators.short-circuit command-line destructors
+combinators combinators.short-circuit command-line destructors
-io.backend.unix.multiplexers io.encodings.utf8 io.thread kernel
+documents gdk.ffi gdk.gl.ffi glib.ffi gobject.ffi gtk.ffi
-libc literals locals math math.bitwise math.order namespaces
+gtk.gl.ffi io.backend.unix.multiplexers io.encodings.utf8
-sequences strings system threads ui ui.backend ui.clipboards
+io.thread kernel libc literals locals math math.bitwise
-ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
+math.order math.vectors namespaces sequences strings system
-ui.gestures ui.pixel-formats ui.pixel-formats.private ui.private
+threads ui ui.backend ui.clipboards ui.event-loop ui.gadgets
-glib.ffi gobject.ffi gtk.ffi gdk.ffi gdk.gl.ffi gtk.gl.ffi ;
+ui.gadgets.editors ui.gadgets.line-support ui.gadgets.private
+ui.gadgets.worlds ui.gestures ui.pixel-formats
+ui.pixel-formats.private ui.private ;
+RENAME: windows ui.private => ui:windows
 IN: ui.backend.gtk
 
 SINGLETON: gtk-ui-backend
 
 TUPLE: handle ;
-TUPLE: window-handle < handle window fullscreen? ;
+TUPLE: window-handle < handle window fullscreen? im-context ;
 
-: <window-handle> ( window -- window-handle )
+: <window-handle> ( window im-context -- window-handle )
-    [ window-handle new ] dip >>window ;
+    window-handle new
+        swap >>im-context
+        swap >>window ;
 
 TUPLE: gtk-clipboard handle ;
 
@@ -127,6 +132,22 @@ CONSTANT: action-key-codes
 : mouse-event>gesture ( event -- modifiers button loc )
     [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
 
+: gadget-location ( gadget -- loc )
+    [ loc>> ] [ parent>> [ gadget-location v+ ] when* ] bi ;
+
+: focusable-editor ( world -- editor/f )
+    focusable-child dup editor? [ drop f ] unless ;
+
+: get-cursor-location ( editor -- GdkRectangle )
+    [ [ gadget-location ] [ caret-loc ] bi v+ first2 ]
+    [ line-height ] bi 0 swap GdkRectangle <struct-boa> ;
+
+: update-im-cursor-location ( world -- )
+    dup focusable-editor [
+        [ handle>> im-context>> ] [ get-cursor-location ] bi*
+        gtk_im_context_set_cursor_location
+    ] [ drop ] if* ;
+
 : on-motion ( sender event user-data -- result )
     drop swap
     [ GdkEventMotion memory>struct event-loc ] dip window
@@ -164,16 +185,17 @@ CONSTANT: action-key-codes
     GdkEventKey memory>struct
     [ event-modifiers ] [ key-sym ] bi ;
 
-: send-key-gesture ( win gesture -- )
+: handle-key-gesture ( key-gesture world -- )
-    swap window propagate-key-gesture ;
+    [ propagate-key-gesture ]
+    [ update-im-cursor-location ] bi ;
    
 : on-key-press ( sender event user-data -- result )
-    drop key-event>gesture over
+    drop swap [ key-event>gesture <key-down> ] [ window ] bi*
-    [ <key-down> send-key-gesture ] [ 3drop drop ] if t ;
+    handle-key-gesture t ;
 
 : on-key-release ( sender event user-data -- result )
-    drop key-event>gesture over
+    drop swap [ key-event>gesture <key-up> ] [ window ] bi*
-    [ <key-up> send-key-gesture ] [ 3drop drop ] if t ;
+    handle-key-gesture t ;
 
 : on-focus-in ( sender event user-data -- result )
     2drop window focus-world t ;
@@ -313,32 +335,77 @@ M: gtk-ui-backend (with-ui)
     win "delete-event" [ on-delete yield ]
     GtkWidget:delete-event connect-signal ;
 
-: on-key-event-for-im ( sender event user-data -- result )
+: on-retrieve-surrounding ( im-context user-data -- ? )
-    swap gtk_im_context_filter_keypress 2drop f ;
+    window focusable-editor [| im-context editor |
+        editor editor-caret first2 :> ( x y )
+        im-context
+        y editor editor-line utf8 string>alien
+        -1 x
+        gtk_im_context_set_surrounding t
+    ] [ drop f ] if* ;
 
-: on-focus-out-for-im ( sender event user-data -- result )
+:: on-delete-surrounding ( im-context offset n user-data -- ? )
-    2nip gtk_im_context_reset f ;
+    user-data window :> 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* ;
 
-: on-destroy-for-im ( sender user-data -- result )
+: on-commit ( sender str user_data -- )
-    nip g_object_unref f ;
+    [ drop ] [ utf8 alien>string ] [ window ] tri*
+    [ user-input ]
+    [ [ f swap key-down boa ] dip handle-key-gesture ] 2bi ;
 
-: on-im-commit ( sender str user_data -- )
+! has to be called before the window signal handler
-    [ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
+: im-on-key-event ( sender event user-data -- result )
+    [ drop ] 2dip swap gtk_im_context_filter_keypress ;
 
-:: configure-im ( win -- )
+: im-on-focus-in ( sender event user-data -- result )
-    gtk_im_context_simple_new :> im
+    2drop window
-    im win gtk_im_context_set_client_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-im-commit yield ]
+    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" [ on-key-event-for-im ]
+    win "key-press-event" [ im-on-key-event yield ]
     GtkWidget:key-press-event im connect-signal-with-data
-    win "key-release-event" [ on-key-event-for-im ]
+    win "key-release-event" [ im-on-key-event yield ]
     GtkWidget:key-release-event im connect-signal-with-data
-    win "focus-out-event" [ on-focus-out-for-im ]
+    win "focus-in-event" [ im-on-focus-in yield ]
     GtkWidget:focus-out-event im connect-signal-with-data
-    win "destroy" [ on-destroy-for-im ]
+    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
@@ -393,26 +460,27 @@ CONSTANT: window-controls>func-flags
 
 M:: gtk-ui-backend (open-window) ( world -- )
     GTK_WINDOW_TOPLEVEL gtk_window_new :> win
+    gtk_im_multicontext_new :> im
     
-    world win [ <window-handle> >>handle drop ]
+    win im <window-handle> world handle<<
-    [ register-window ] 2bi
+
+    world win register-window
     
     win world [ window-loc>> auto-position ]
     [ dim>> first2 gtk_window_set_default_size ] 2bi
     
     world setup-gl drop
 
-    win configure-im
-    
-    win connect-signals
-    
     win gtk_widget_realize
     win world window-controls>> configure-window-controls
     
+    win im configure-im
+    win connect-signals
+
     win gtk_widget_show_all ;
 
 M: gtk-ui-backend (close-window) ( handle -- )
-    window>> [ unregister-window ] [ gtk_widget_destroy ] bi
+    window>> [ gtk_widget_destroy ] [ unregister-window ] bi
     event-loop? [ gtk_main_quit ] unless ;
 
 M: gtk-ui-backend set-title
@@ -420,10 +488,12 @@ M: gtk-ui-backend set-title
     gtk_window_set_title ;
 
 M: gtk-ui-backend (set-fullscreen)
-    [ handle>> ] dip [ >>fullscreen? ] keep
+    [
-    [ window>> ] dip
+        [ handle>> ] dip [ >>fullscreen? ] keep
-    [ gtk_window_fullscreen ]
+        [ window>> ] dip
-    [ gtk_window_unfullscreen ] if ;
+        [ gtk_window_fullscreen ]
+        [ gtk_window_unfullscreen ] if
+    ] [ drop update-im-cursor-location ] 2bi ;
 
 M: gtk-ui-backend (fullscreen?)
     handle>> fullscreen?>> ;
@@ -478,4 +548,3 @@ M: gtk-clipboard set-clipboard-contents
 gtk-ui-backend ui-backend set-global
 
 [ "ui.tools" ] main-vocab-hook set-global
-