From 77ca41138d50bdfa74abc0333cefb6e1ad930079 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sun, 12 Aug 2012 15:31:42 -0700
Subject: [PATCH] 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.
---
 src/gtk/fix-layout.scm | 36 ++++++++++++++++++++++++------------
 src/gtk/keys.scm       |  3 +--
 2 files changed, 25 insertions(+), 14 deletions(-)

diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm
index 16522c05e..487875d26 100644
--- 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 3102b8919..eb18764f0 100644
--- 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))))
-- 
2.25.1