]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge remote branch 'ex-rzr/master' into gtk
authorPhilipp Brüschweiler <blei42@gmail.com>
Sat, 12 Jun 2010 14:02:22 +0000 (16:02 +0200)
committerPhilipp Brüschweiler <blei42@gmail.com>
Sat, 12 Jun 2010 14:02:22 +0000 (16:02 +0200)
Conflicts:
basis/ui/backend/gtk/gtk.factor

1  2 
basis/ui/backend/gtk/gtk.factor

index 1b417633f3746cb04f7b29e28615c8cd9990ac25,3a2835c1b1289c170f37c7d031e4f5403e7fb431..56ccbd1f5500055c526cf409278e9beade678884
@@@ -132,29 -127,10 +132,26 @@@ CONSTANT: action-key-code
  : mouse-event>gesture ( event -- modifiers button loc )
      [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
  
-     [ loc>> ] [
-         parent>> [ gadget-location ] [ { 0 0 } ] if*
-     ] bi v+ ;
 +: 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
-         move-hand fire-motion
-     ] [ window update-im-cursor-location ] bi t ;
+     drop swap
+     [ GdkEventMotion memory>struct event-loc ] dip window
+     move-hand fire-motion t ;
  
  : on-enter ( sender event user-data -- result )
      on-motion ;
      drop swap [
          GdkEventScroll memory>struct
          [ scroll-direction ] [ event-loc ] bi
-     ] dip window
-     [ send-scroll ] [ update-im-cursor-location ] bi t ;
+     ] dip window send-scroll t ;
  
- : key-sym ( event -- sym action? )
-     keyval>> dup action-key-codes at
-     [ t ] [ gdk_keyval_to_unicode 1string f ] ?if ;
+ : key-sym ( event -- sym/f action? )
+     keyval>> dup action-key-codes at [ t ]
+     [ 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 -- ? )
-     over empty? [ 2drop f ] [
-         mods>> { f { S+ } } member? [
-             [ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
-         ] [
-             [ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
-         ] if
-     ] if ;
- :: on-key-press ( sender event user-data -- result )
-     sender window :> world
-     world handle>> im-context>> :> im-context
-     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 )
-     sender window :> world
-     world handle>> im-context>> event gtk_im_context_filter_keypress
-     [
-         event GdkEventKey memory>struct
-         key-event>gesture <key-up>
-         world propagate-key-gesture
-     ] unless
-     world update-im-cursor-location t ;
 -: 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 ]
-     [ handle>> im-context>> gtk_im_context_focus_in ]
-     [ update-im-cursor-location ] tri
-     f ;
+     2drop window focus-world t ;
  
  : on-focus-out ( sender event user-data -- result )
-     2drop window [ unfocus-world ]
-     [ handle>> im-context>> gtk_im_context_focus_out ]
-     [ update-im-cursor-location ] tri
-     f ;
+     2drop window unfocus-world t ;
  
  : on-expose ( sender event user-data -- result )
      2drop window relayout t ;
@@@ -394,19 -313,33 +335,78 @@@ M: gtk-ui-backend (with-ui
      win "delete-event" [ on-delete yield ]
      GtkWidget:delete-event connect-signal ;
  
- : connect-im-signals ( im-context -- )
-     {
-         [
-             "commit" [ on-commit yield ]
-             GtkIMContext:commit connect-signal
-         ] [
-             "retrieve-surrounding" [ on-retrieve-surrounding yield ]
-             GtkIMContext:retrieve-surrounding connect-signal
-         ] [
-             "delete-surrounding" [ on-delete-surrounding yield ]
-             GtkIMContext:delete-surrounding connect-signal
-         ]
-     } cleave ;
 -: 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
      H{
@@@ -460,33 -393,26 +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-context
-     im-context f gtk_im_context_set_use_preedit
++    gtk_im_multicontext_new :> im
      
-     win im-context <window-handle> world handle<<
 -    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 connect-signals
-     im-context connect-im-signals
-     
 -    win configure-im
 -    
 -    win connect-signals
 -    
      win gtk_widget_realize
      win world window-controls>> configure-window-controls
-     im-context win gtk_widget_get_window
-     gtk_im_context_set_client_window
+     
++    win im configure-im
++    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 ] bi
 -    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