gtk: Keysym names changed. Delete and Backspace translation fixed.

A couple GDK_KEY_syms vary only in case, so they are no longer
interned (rather, string->symboled) and will no longer substitute -
for _.

Delete and Backspace kludge explained in the source.

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 16522c05efd10c5f23046783f1f842799ad0feaa..487875d269b222f1f80dec75634e9bdfbef4ce31 100644 (file)
--- a/src/gtk/fix-layout.scm
+++ b/src/gtk/fix-layout.scm
@@ -240,18 +240,30 @@ USA.
           (keyval (C-> GdkEvent "GdkEvent key keyval")))
        (let ((string (c-peek-cstring alien))
             (char-bits (gdk-key-state->char-bits state)))
-        (if (zero? (string-length string))
-            (cond ((fix:= length 1)
-                   (handler widget #\NUL char-bits))
-                  ((fix:= length 0)
-                   (handler widget (gdk-keyval->name keyval) char-bits))
-                  (else (error "Unexpected length in GdkEventKey.")))
-            (let ((l (string-length string)))
-              (let loop ((i 0))
-                (if (fix:< i l)
-                    (and (handler widget (string-ref string i) char-bits)
-                         (loop (fix:1+ i)))
-                    #t)))))))))
+        (cond ((zero? (string-length string))
+               (cond ((fix:= length 1)
+                      (handler widget #\NUL char-bits))
+                     ((fix:= length 0)
+                      (handler widget (gdk-keyval->name keyval) char-bits))
+                     (else (error "Unexpected length in GdkEventKey."))))
+              ;; Kludge: BackSpace and C-h both have "key string" "\b"?!
+              ;; And Delete is already "\177" (aka (string #\rubout)).
+              ((and (fix:= 1 (string-length string))
+                    (char=? #\backspace (string-ref string 0)))
+               (let ((name (gdk-keyval->name keyval)))
+                 (cond ((string-ci=? (symbol-name name) "backspace")
+                        (handler widget #\backspace char-bits))
+                       ((memq name '(|h| |H|))
+                        (handler widget #\C-h
+                                 (fix:- char-bits char-bit:control)))
+                       (else (error "Unexpected backspace keyval:" keyval)))))
+              (else
+               (let ((l (string-length string)))
+                 (let loop ((i 0))
+                   (if (fix:< i l)
+                       (and (handler widget (string-ref string i) char-bits)
+                            (loop (fix:1+ i)))
+                       #t))))))))))
 
 (define (set-fix-widget-motion-handler! widget handler)
   (guarantee-fix-widget widget 'set-fix-widget-motion-handler!)

diff --git a/src/gtk/keys.scm b/src/gtk/keys.scm
index 3102b8919a8a44d14f6a5b83db7480052ac5bdc6..eb18764f05d5e17ee60dfe124f68943aca2fb7f6 100644 (file)
--- a/src/gtk/keys.scm
+++ b/src/gtk/keys.scm
@@ -52,8 +52,7 @@ USA.
                      (gdk-name (car gdk-name.keyval))
                      (string (symbol-name gdk-name))
                      (name (cond ((string-prefix? "GDK_KEY_" string)
-                                  (intern (string-replace
-                                           (string-tail string 8) #\_ #\-)))
+                                  (string->symbol (string-tail string 8)))
                                  (else
                                   (warn "Unexpected GdkKeysym name:" gdk-name)
                                   gdk-name))))