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

diff --combined basis/ui/backend/gtk/gtk.factor
index 045a75d075ab341e18e1e30661e83db83db74c73,56ccbd1f5500055c526cf409278e9beade678884..99bbe11ad8d4e9476cccfb2d4d5c54ebd95460d1
--- 1/basis/ui/backend/gtk/gtk.factor
--- 2/basis/ui/backend/gtk/gtk.factor
+++ b/basis/ui/backend/gtk/gtk.factor
@@@ -2,22 -2,27 +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
- io.backend.unix.multiplexers io.encodings.utf8 io.thread kernel
- libc literals locals math math.bitwise math.order namespaces
- sequences strings system threads 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
- glib.ffi gobject.ffi gtk.ffi gdk.ffi gdk.gl.ffi gtk.gl.ffi ;
+ combinators combinators.short-circuit command-line destructors
+ documents gdk.ffi gdk.gl.ffi glib.ffi gobject.ffi gtk.ffi
+ gtk.gl.ffi io.backend.unix.multiplexers io.encodings.utf8
+ io.thread kernel libc literals locals math math.bitwise
+ math.order math.vectors namespaces sequences strings system
+ threads ui ui.backend ui.clipboards ui.event-loop ui.gadgets
+ 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 new ] dip >>window ;
+ : <window-handle> ( window im-context -- window-handle )
+     window-handle new
+         swap >>im-context
+         swap >>window ;
  
  TUPLE: gtk-clipboard handle ;
  
@@@ -127,6 -132,22 +132,22 @@@ CONSTANT: action-key-code
  : 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 +185,17 @@@
      GdkEventKey memory>struct
      [ event-modifiers ] [ key-sym ] bi ;
  
- : send-key-gesture ( win gesture -- )
-     swap window propagate-key-gesture ;
+ : handle-key-gesture ( key-gesture world -- )
+     [ propagate-key-gesture ]
+     [ update-im-cursor-location ] bi ;
     
  : on-key-press ( sender event user-data -- result )
-     drop key-event>gesture over
-     [ <key-down> send-key-gesture ] [ 3drop drop ] if t ;
+     drop swap [ key-event>gesture <key-down> ] [ window ] bi*
+     handle-key-gesture t ;
  
  : on-key-release ( sender event user-data -- result )
-     drop key-event>gesture over
-     [ <key-up> send-key-gesture ] [ 3drop drop ] if t ;
+     drop swap [ key-event>gesture <key-up> ] [ window ] bi*
+     handle-key-gesture t ;
  
  : on-focus-in ( sender event user-data -- result )
      2drop window focus-world t ;
@@@ -313,32 -335,77 +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 )
-     swap gtk_im_context_filter_keypress 2drop f ;
- 
- : on-focus-out-for-im ( sender event user-data -- result )
-     2nip gtk_im_context_reset f ;
- 
- : on-destroy-for-im ( sender user-data -- result )
-     nip g_object_unref f ;
- 
- : on-im-commit ( sender str user_data -- )
-     [ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
- 
- :: configure-im ( win -- )
-     gtk_im_context_simple_new :> im
-     im win gtk_im_context_set_client_window
+ : on-retrieve-surrounding ( im-context user-data -- ? )
+     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-delete-surrounding ( im-context offset n user-data -- ? )
+     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-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-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 +460,27 @@@ CONSTANT: window-controls>func-flag
  
  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 ]
-     [ register-window ] 2bi
+     win im <window-handle> world handle<<
+ 
+     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 +488,12 @@@
      gtk_window_set_title ;
  
  M: gtk-ui-backend (set-fullscreen)
-     [ handle>> ] dip [ >>fullscreen? ] keep
-     [ window>> ] dip
-     [ gtk_window_fullscreen ]
-     [ gtk_window_unfullscreen ] if ;
+     [
+         [ handle>> ] dip [ >>fullscreen? ] keep
+         [ window>> ] dip
+         [ gtk_window_fullscreen ]
+         [ gtk_window_unfullscreen ] if
+     ] [ drop update-im-cursor-location ] 2bi ;
  
  M: gtk-ui-backend (fullscreen?)
      handle>> fullscreen?>> ;
@@@ -466,10 -536,7 +536,10 @@@ M:: gtk-ui-backend system-alert ( capti
      [ gtk_widget_destroy ] tri ;
  
  M: gtk-clipboard clipboard-contents
 -    handle>> gtk_clipboard_wait_for_text utf8 alien>string ;
 +    [
 +        handle>> gtk_clipboard_wait_for_text
 +        [ &g_free utf8 alien>string ] [ f ] if*
 +    ] with-destructors ;
  
  M: gtk-clipboard set-clipboard-contents
      swap [ handle>> ] [ utf8 string>alien ] bi*
@@@ -478,4 -545,3 +548,3 @@@
  gtk-ui-backend ui-backend set-global
  
  [ "ui.tools" ] main-vocab-hook set-global
-