Genericize gdk keysyms; match Edwin's expectations.

diff --git a/src/gtk/keys.scm b/src/gtk/keys.scm
index 9ffc73b1eec37c6d0222fe80043aefa192dc5172..4beeddc576df840d8a2a2bfa210a73843be703c9 100644 (file)
--- a/src/gtk/keys.scm
+++ b/src/gtk/keys.scm
@@ -39,16 +39,33 @@ USA.
   (let ((entry
         (vector-binary-search gtk-key-translation-table
                               (lambda (u v) (< u v))
-                              (lambda (pair) (cdr pair))
+                              (lambda (pair) (car pair))
                               keyval)))
-    (and entry (car entry))))
+    (and entry (cdr entry))))
 
 (define-syntax translation-vector
   (sc-macro-transformer
    (lambda (form usage-env)
-     (list->vector
-      (c-enum-constant-values '(ENUM |GdkKeysyms|) form
-                             (find-c-includes usage-env))))))
+     (let* ((overrides
+            `((,(C-enum "GDK_Cancel") . stop) ;originally called Cancel
+              ))
+           (keyval.name
+            (lambda (gdk-name.keyval)
+              (let* ((keyval (cdr gdk-name.keyval))
+                     (gdk-name (car gdk-name.keyval))
+                     (string (symbol->string gdk-name))
+                     (name (cond ((assv keyval overrides) => cdr)
+                                 ((string-prefix? "GDK_" string)
+                                  (intern (string-replace
+                                           (string-tail string 4) #\_ #\-)))
+                                 (else
+                                  (warn "Unexpected GdkKeysym name:" gdk-name)
+                                  gdk-name))))
+                (cons keyval name)))))
+       (list->vector
+       (map keyval.name
+            (c-enum-constant-values '(ENUM |GdkKeysyms|) form
+                                    (find-c-includes usage-env))))))))
 
 (define gtk-key-translation-table
-  (sort! (translation-vector) (lambda (a b) (< (cdr a) (cdr b)))))
\ No newline at end of file
+  (sort! (translation-vector) (lambda (a b) (< (car a) (car b)))))
\ No newline at end of file