From d6e4425fbb29e53cd9636dbca069ca3c8bc120b0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 17 Jan 2011 18:28:16 -0700 Subject: [PATCH] gtk: enable input-method (e.g., Chinese) support original commit: d8e123753c40fadc6d51513cf1fa5e4eca614bc8 --- collects/mred/private/wx/gtk/canvas.rkt | 80 +++++++++++++++ collects/mred/private/wx/gtk/types.rkt | 1 + collects/mred/private/wx/gtk/window.rkt | 124 +++++++++++++----------- 3 files changed, 151 insertions(+), 54 deletions(-) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 1e4f0e6c..cd0d5418 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -108,6 +108,52 @@ (define-gdk gdk_gc_set_rgb_fg_color (_fun _pointer _GdkColor-pointer -> _void)) (define-gdk gdk_draw_rectangle (_fun _GdkWindow _pointer _gboolean _int _int _int _int -> _void)) +(define _GtkIMContext (_cpointer 'GtkIMContext)) +(define-gtk gtk_im_multicontext_new (_fun -> _GtkIMContext)) +(define-gtk gtk_im_context_set_use_preedit (_fun _GtkIMContext _gboolean -> _void)) +(define-gtk gtk_im_context_focus_in (_fun _GtkIMContext -> _void)) +(define-gtk gtk_im_context_focus_out (_fun _GtkIMContext -> _void)) +(define-gtk gtk_im_context_filter_keypress (_fun _GtkIMContext _GdkEventKey-pointer -> _gboolean)) +(define-gtk gtk_im_context_set_client_window (_fun _GtkIMContext _GdkWindow -> _void)) +(define-gtk gtk_im_context_set_cursor_location (_fun _GtkIMContext _GdkRectangle-pointer -> _void)) + +(define im-string-result #f) +(define im-filtering? #f) +(define im-canvas #f) + +(define-signal-handler connect-commit "commit" + (_fun _GtkIMContext _string -> _void) + (lambda (im str) + (cond + [im-filtering? + ;; filtering an event => we can handle the string + ;; result directly + (set! im-string-result str)] + [(and im-canvas + (weak-box-value im-canvas)) + ;; not filtering, but there's a target canvas => + ;; queue a made-up key press event for each character + ;; of the string + => (lambda (wx) + (for ([c (in-string str)]) + (let ([e (new key-event% + [key-code c] + [shift-down #f] + [control-down #f] + [meta-down #f] + [alt-down #f] + [x 0] + [y 0] + [time-stamp 0] + [caps-down #f])]) + (queue-window-event wx (lambda () + (send wx dispatch-on-char e #f))))))]))) + +(define im (gtk_im_multicontext_new)) +(void (connect-commit (cast im _pointer _GtkWidget))) + +(gtk_im_context_set_use_preedit im #f) + ;; We rely some on the implementation of GtkComboBoxEntry to replace ;; the drawing routine. (define-cstruct _GList ([data _pointer])) @@ -595,6 +641,40 @@ (define/public (set-combo-text t) (void)) + (define/override (focus-change on?) + ;; input-method management + (if on? + (begin + (set! im-canvas (make-weak-box this)) + (gtk_im_context_focus_in im) + (gtk_im_context_set_client_window im (widget-window client-gtk)) + (let ([w (box 0)] + [h (box 0)]) + (get-client-size w h) + (gtk_im_context_set_cursor_location + im + (make-GdkRectangle 0 0 (unbox w) (unbox h))))) + (when (and im-canvas + (eq? this (weak-box-value im-canvas))) + (gtk_im_context_focus_out im) + (set! im-canvas #f)))) + + (define/override (filter-key-event e) + ;; give the input method a chance to handle the + ;; key event; see call in "window.rkt" for + ;; information on the results + (if (and im-canvas + (eq? this (weak-box-value im-canvas))) + (begin + (set! im-filtering? #t) + (set! im-string-result #f) + (if (begin0 + (gtk_im_context_filter_keypress im e) + (set! im-filtering? #f)) + im-string-result + 'none)) + 'none)) + (define/public (do-scroll direction) (if (is-auto-scroll?) (refresh-for-autoscroll) diff --git a/collects/mred/private/wx/gtk/types.rkt b/collects/mred/private/wx/gtk/types.rkt index 20bb567c..710d6395 100644 --- a/collects/mred/private/wx/gtk/types.rkt +++ b/collects/mred/private/wx/gtk/types.rkt @@ -31,6 +31,7 @@ (struct-out GdkEventExpose) _GdkEventSelection _GdkEventSelection-pointer (struct-out GdkEventSelection) + _GdkRectangle _GdkRectangle-pointer (struct-out GdkRectangle) _GdkColor _GdkColor-pointer (struct-out GdkColor))) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index 8de24f60..18dbf5cf 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -130,6 +130,7 @@ (lambda (gtk event) (let ([wx (gtk->wx gtk)]) (when wx + (send wx focus-change #t) (send (send wx get-top-win) on-focus-child #t) (queue-window-event wx (lambda () (send wx on-set-focus)))) #f))) @@ -138,6 +139,7 @@ (lambda (gtk event) (let ([wx (gtk->wx gtk)]) (when wx + (send wx focus-change #f) (send (send wx get-top-win) on-focus-child #f) (queue-window-event wx (lambda () (send wx on-kill-focus)))) #f))) @@ -180,60 +182,71 @@ (let ([wx (gtk->wx gtk)]) (and wx - (let* ([modifiers (if scroll? - (GdkEventScroll-state event) - (GdkEventKey-state event))] - [bit? (lambda (m v) (positive? (bitwise-and m v)))] - [keyval->code (lambda (kv) - (or - (map-key-code kv) - (integer->char (gdk_keyval_to_unicode kv))))] - [key-code (if scroll? - (if (= (GdkEventScroll-direction event) - GDK_SCROLL_UP) - 'wheel-up - 'wheel-down) - (keyval->code (GdkEventKey-keyval event)))] - [k (new key-event% - [key-code key-code] - [shift-down (bit? modifiers GDK_SHIFT_MASK)] - [control-down (bit? modifiers GDK_CONTROL_MASK)] - [meta-down (bit? modifiers GDK_MOD1_MASK)] - [alt-down (bit? modifiers GDK_META_MASK)] - [x 0] - [y 0] - [time-stamp (if scroll? - (GdkEventScroll-time event) - (GdkEventKey-time event))] - [caps-down (bit? modifiers GDK_LOCK_MASK)])]) - (when (or (and (not scroll?) - (let-values ([(s ag sag cl) (get-alts event)] - [(keyval->code*) (lambda (v) - (and v - (let ([c (keyval->code v)]) - (and (not (equal? #\u0000 c)) - c))))]) - (let ([s (keyval->code* s)] - [ag (keyval->code* ag)] - [sag (keyval->code* sag)] - [cl (keyval->code* cl)]) - (when s (send k set-other-shift-key-code s)) - (when ag (send k set-other-altgr-key-code ag)) - (when sag (send k set-other-shift-altgr-key-code sag)) - (when cl (send k set-other-caps-key-code cl)) - (or s ag sag cl)))) - (not (equal? #\u0000 key-code))) - (unless (or scroll? down?) - ;; swap altenate with main - (send k set-key-release-code (send k get-key-code)) - (send k set-key-code 'release)) - (if (send wx handles-events? gtk) - (begin - (queue-window-event wx (lambda () (send wx dispatch-on-char k #f))) - #t) - (constrained-reply (send wx get-eventspace) - (lambda () (send wx dispatch-on-char k #t)) - #t))))))) + (let ([im-str (if scroll? + 'none + ;; Result from `filter-key-event' is one of + ;; - #f => drop the event + ;; - 'none => no replacement; handle as usual + ;; - a string => use as the keycode + (send wx filter-key-event event))]) + (when im-str + (let* ([modifiers (if scroll? + (GdkEventScroll-state event) + (GdkEventKey-state event))] + [bit? (lambda (m v) (positive? (bitwise-and m v)))] + [keyval->code (lambda (kv) + (or + (map-key-code kv) + (integer->char (gdk_keyval_to_unicode kv))))] + [key-code (if scroll? + (if (= (GdkEventScroll-direction event) + GDK_SCROLL_UP) + 'wheel-up + 'wheel-down) + (keyval->code (GdkEventKey-keyval event)))] + [k (new key-event% + [key-code (if (and (string? im-str) + (= 1 (string-length im-str))) + (string-ref im-str 0) + key-code)] + [shift-down (bit? modifiers GDK_SHIFT_MASK)] + [control-down (bit? modifiers GDK_CONTROL_MASK)] + [meta-down (bit? modifiers GDK_MOD1_MASK)] + [alt-down (bit? modifiers GDK_META_MASK)] + [x 0] + [y 0] + [time-stamp (if scroll? + (GdkEventScroll-time event) + (GdkEventKey-time event))] + [caps-down (bit? modifiers GDK_LOCK_MASK)])]) + (when (or (and (not scroll?) + (let-values ([(s ag sag cl) (get-alts event)] + [(keyval->code*) (lambda (v) + (and v + (let ([c (keyval->code v)]) + (and (not (equal? #\u0000 c)) + c))))]) + (let ([s (keyval->code* s)] + [ag (keyval->code* ag)] + [sag (keyval->code* sag)] + [cl (keyval->code* cl)]) + (when s (send k set-other-shift-key-code s)) + (when ag (send k set-other-altgr-key-code ag)) + (when sag (send k set-other-shift-altgr-key-code sag)) + (when cl (send k set-other-caps-key-code cl)) + (or s ag sag cl)))) + (not (equal? #\u0000 key-code))) + (unless (or scroll? down?) + ;; swap altenate with main + (send k set-key-release-code (send k get-key-code)) + (send k set-key-code 'release)) + (if (send wx handles-events? gtk) + (begin + (queue-window-event wx (lambda () (send wx dispatch-on-char k #f))) + #t) + (constrained-reply (send wx get-eventspace) + (lambda () (send wx dispatch-on-char k #t)) + #t))))))))) (define-signal-handler connect-button-press "button-press-event" (_fun _GtkWidget _GdkEventButton-pointer -> _gboolean) @@ -562,6 +575,9 @@ (define/public (on-set-focus) (void)) (define/public (on-kill-focus) (void)) + (define/public (focus-change on?) (void)) + (define/public (filter-key-event e) 'none) + (define/private (pre-event-refresh) ;; Since we break the connection between the ;; Gtk queue and event handling, we