suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gtk key-handling fixes

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-07 19:17:48 -06:00
parent f1e2db412f
commit 9d1ac67287
2 changed files with 25 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/mred/private/wx/gtk/keycode.rkt
View File

@ -8,7 +8,7 @@
(#xff09 . #\tab)
(#xff0a . #\newline)
(#xff0d . #\return)
(#xff1b . #\u1B); escape
(#xff1b . escape) ; escape
(#xff50 . home)
(#xff51 . left)
(#xff52 . up)

37
collects/mred/private/wx/gtk/window.rkt
View File

@ -134,8 +134,9 @@
(or
(map-key-code kv)
(integer->char (gdk_keyval_to_unicode kv))))]
[key-code (keyval->code (GdkEventKey-keyval event))]
[k (new key-event%
[key-code (keyval->code (GdkEventKey-keyval event))]
[key-code key-code]
[shift-down (bit? modifiers GDK_SHIFT_MASK)]
[control-down (bit? modifiers GDK_CONTROL_MASK)]
[meta-down (bit? modifiers GDK_META_MASK)]
@ -144,18 +145,28 @@
[y 0]
[time-stamp (GdkEventKey-time event)]
[caps-down (bit? modifiers GDK_LOCK_MASK)])])
(let-values ([(s ag sag cl) (get-alts event)])
(when s (send k set-other-shift-key-code (keyval->code s)))
(when ag (send k set-other-altgr-key-code (keyval->code ag)))
(when sag (send k set-other-shift-altgr-key-code (keyval->code sag)))
(when cl (send k set-other-caps-key-code (keyval->code cl))))
(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)))))))
(when (or (not (equal? #\u0000 key-code))
(let-values ([(s ag sag cl) (get-alts event)]
[(keyval->code*) (lambda (v)
(let ([c (keyval->code v)])
(and (not (equal? #\u0000 key-code))
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 (keyval->code s)))
(when ag (send k set-other-altgr-key-code (keyval->code ag)))
(when sag (send k set-other-shift-altgr-key-code (keyval->code sag)))
(when cl (send k set-other-caps-key-code (keyval->code cl)))
(or s ag sag cl))))
(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)