From 2b24fb4ef21c2753e5f88dddd99b662a0521b3a1 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 14 Mar 2010 17:02:54 +0200
Subject: [PATCH] improved terminal key handling

 * Get rid of the arrow-key kludge. We can get the correct code for
   arraw keys by telling the terminal to go into "transmit mode".

 * F1-F4 are bizarrely transmitted as VT100 PF1-PF4 on Apple Terminal
   at least, and I cannot seem to find a terminal mode that would
   change this. Becase terminals are grotty, Apple isn't probably the
   only one who does that, so add hardcoded aliases.

 * Distinct Backspace and Control-h in terminal. However, since
   bindings for C-h and Backspace are identical, there is no change in
   out-of-the box behaviour.
---
 src/tty-disp-rt.lisp |   20 +++++++++-----
 src/tty-input.lisp   |   70 +++++++++++++++++++++++++++++++++++--------------
 src/tty-screen.lisp  |   14 ++++++++--
 3 files changed, 74 insertions(+), 30 deletions(-)

diff --git a/src/tty-disp-rt.lisp b/src/tty-disp-rt.lisp
index 4e63e33..97cb12d 100644
--- a/src/tty-disp-rt.lisp
+++ b/src/tty-disp-rt.lisp
@@ -223,11 +223,13 @@
 	    (setf *old-c-cc*
 		  (vector (ccref osicat-posix::cflag-vsusp)
 			  (ccref osicat-posix::cflag-veof)
+                          (ccref osicat-posix::cflag-verase)
 			  (ccref osicat-posix::cflag-vintr)
 			  (ccref osicat-posix::cflag-vquit)
 			  (ccref osicat-posix::cflag-vstart)
 			  (ccref osicat-posix::cflag-vstop)
 			  (ccref osicat-posix::cflag-vsusp)
+                          (ccref osicat-posix::cflag-vdsusp)
 			  (ccref osicat-posix::cflag-vmin)
 			  (ccref osicat-posix::cflag-vtime)))
 	    (setf osicat-posix::lflag
@@ -244,6 +246,7 @@
 			    #+bsd osicat-posix::tty-onlcr))
 	    (setf (ccref osicat-posix::cflag-vsusp) #xff)
 	    (setf (ccref osicat-posix::cflag-veof) #xff)
+	    (setf (ccref osicat-posix::cflag-verase) (char-code #\del))
 	    (setf (ccref osicat-posix::cflag-vintr)
 		  (if *editor-windowed-input* #xff 28))
 	    (setf (ccref osicat-posix::cflag-vquit) #xff)
@@ -351,15 +354,18 @@
 	  (setf osicat-posix::lflag *old-c-lflag*)
 	  (macrolet ((ccref (slot)
 		       `(cffi:mem-ref osicat-posix::cc :uint8 ,slot)))
+            (assert (= (length *old-c-cc*) 11))
 	    (setf (ccref osicat-posix::cflag-vsusp) (elt *old-c-cc* 0)
 		  (ccref osicat-posix::cflag-veof) (elt *old-c-cc* 1)
-		  (ccref osicat-posix::cflag-vintr) (elt *old-c-cc* 2)
-		  (ccref osicat-posix::cflag-vquit) (elt *old-c-cc* 3)
-		  (ccref osicat-posix::cflag-vstart) (elt *old-c-cc* 4)
-		  (ccref osicat-posix::cflag-vstop) (elt *old-c-cc* 5)
-		  (ccref osicat-posix::cflag-vsusp) (elt *old-c-cc* 6)
-		  (ccref osicat-posix::cflag-vmin) (elt *old-c-cc* 7)
-		  (ccref osicat-posix::cflag-vtime) (elt *old-c-cc* 8)))
+		  (ccref osicat-posix::cflag-verase) (elt *old-c-cc* 2)
+		  (ccref osicat-posix::cflag-vintr) (elt *old-c-cc* 3)
+		  (ccref osicat-posix::cflag-vquit) (elt *old-c-cc* 4)
+		  (ccref osicat-posix::cflag-vstart) (elt *old-c-cc* 5)
+		  (ccref osicat-posix::cflag-vstop) (elt *old-c-cc* 6)
+		  (ccref osicat-posix::cflag-vsusp) (elt *old-c-cc* 7)
+		  (ccref osicat-posix::cflag-vdsusp) (elt *old-c-cc* 8)
+		  (ccref osicat-posix::cflag-vmin) (elt *old-c-cc* 9)
+		  (ccref osicat-posix::cflag-vtime) (elt *old-c-cc* 10)))
 	  (osicat-posix::tcsetattr fd osicat-posix::tcsaflush tios))))))
 
 #+(or)
diff --git a/src/tty-input.lisp b/src/tty-input.lisp
index ab19a92..cf671b2 100644
--- a/src/tty-input.lisp
+++ b/src/tty-input.lisp
@@ -39,33 +39,63 @@
 
 (defun register-tty-translations ()
   (assert hemlock.terminfo:*terminfo*)
-  (flet ((reg (string keysym &key kludge)
-           (when kludge
-             ;; FIXME: This is pretty terrible, but for some reason my *terminfo* has
-             ;; Esc,O,<foo> for arraw keys, whereas terminal actually sends Esc,[,<foo>
-             ;; -- either I don't understand how terminfo stuff is supposed to work,
-             ;; Apple ships with a broken terminfo db, or if something is wrong with
-             ;; the terminfo code. I'm inclined to blame me...
-             (assert (eq #\O (char string 1)))
-             (setf string (format nil "~A[~A" (char string 0) (subseq string 2))))
-           (setf (gethash (string string) *tty-translations*) keysym)))
-    (reg hemlock.terminfo:key-left #k"Leftarrow" :kludge t)
-    (reg hemlock.terminfo:key-up #k"Uparrow" :kludge t)
-    (reg hemlock.terminfo:key-down #k"Downarrow" :kludge t)
-    (reg hemlock.terminfo:key-right #k"Rightarrow" :kludge t)
+  (flet ((reg (string keysym)
+           (let ((string (etypecase string
+                           (character (string string))
+                           (list (coerce string 'simple-string))
+                           (string string))))
+              (setf (gethash string *tty-translations*) keysym))))
+    ;; KLUDGE: There seems to be no way get F1-F4 reliably transmit
+    ;; things in the terminfo db, since some terminals transmit them
+    ;; as if they were vt100 PF1-PF4, so, register these aliases here.
+    ;; If they double as something else, that will override these.
+    (reg '(#\Esc #\O #\P) #k"F1")
+    (reg '(#\Esc #\O #\Q) #k"F2")
+    (reg '(#\Esc #\O #\R) #k"F3")
+    (reg '(#\Esc #\O #\S) #k"F4")
+    ;; Terminfo definitions for F1-F12
+    (reg hemlock.terminfo:key-f1 #k"F1")
+    (reg hemlock.terminfo:key-f2 #k"F2")
+    (reg hemlock.terminfo:key-f3 #k"F3")
+    (reg hemlock.terminfo:key-f4 #k"F4")
+    (reg hemlock.terminfo:key-f5 #k"F5")
+    (reg hemlock.terminfo:key-f6 #k"F6")
+    (reg hemlock.terminfo:key-f7 #k"F7")
+    (reg hemlock.terminfo:key-f8 #k"F8")
+    (reg hemlock.terminfo:key-f9 #k"F9")
+    (reg hemlock.terminfo:key-f10 #k"F10")
+    (reg hemlock.terminfo:key-f11 #k"F11")
+    (reg hemlock.terminfo:key-f12 #k"F12")
+    ;; Terminfo definitions for movement keys
+    (reg hemlock.terminfo:key-left #k"Leftarrow")
+    (reg hemlock.terminfo:key-up #k"Uparrow")
+    (reg hemlock.terminfo:key-down #k"Downarrow")
+    (reg hemlock.terminfo:key-right #k"Rightarrow")
     (reg hemlock.terminfo:key-ppage #k"Pageup")
     (reg hemlock.terminfo:key-npage #k"Pagedown")
+    ;; Best-effort to tell C-h and backspace apart: we have set VERASE to
+    ;; #\Rubout so we can _sometimes_ do this: C-h is always send as
+    ;; backspace.
+    ;;
+    ;; FIXME: This is less elegant than we'd like, however, since
+    ;; #k"Delete" and #k"Rubout" are currently the same keysym in Hemlock:
+    ;; so we can't use
+    ;;   User-Backspace -> #k"Backspace"
+    ;;   User-Delete    -> #k"Delete"
+    ;;   User-C-h       -> #k"Rubout"
+    ;; which wold degrade gracefully by collapsing User-Backspace
+    ;; and User-C-h into #k"Rubout" -- now they collapse into #k"Control-h".
+    (reg #\Rubout #k"Backspace")
+    (reg hemlock.terminfo:key-backspace #k"Control-h")
+    (reg hemlock.terminfo:key-dc #k"Delete")
+    ;; Misc.
     (reg #\newline #k"Return")
     (reg #\tab #k"Tab")
-    (reg #\backspace #k"Backspace")
-    (reg #\rubout #k"Delete")
     (reg #\escape #k"Escape")))
 
 (defun translate-tty-event (data)
-  (let* ((string (coerce data 'string))
-         (sym (gethash string *tty-translations*)))
-    (if sym
-        (hemlock-ext:make-key-event sym 0)
+  (let ((string (coerce data 'string)))
+    (or (gethash string *tty-translations*)
         (when (= 1 (length string))
           (hemlock-ext:char-key-event (char string 0))))))
 
diff --git a/src/tty-screen.lisp b/src/tty-screen.lisp
index 550bbb6..3b76d2a 100644
--- a/src/tty-screen.lisp
+++ b/src/tty-screen.lisp
@@ -183,10 +183,18 @@
 	   (init-file-string (if init-file (get-init-file-string init-file)))
 	   (init-cm-string (termcap :init-cursor-motion)))
       (setf (tty-device-init-string device)
-	    (concatenate 'simple-string (or init-string "")
-			 (or init-file-string "") (or init-cm-string ""))))
+	    (concatenate 'simple-string
+			 (or init-string "")
+			 (or init-file-string "")
+			 (or init-cm-string "")
+			 ;; Transmit-mode: this makes arrow-keys give sequences matching
+			 ;; the terminfo db.
+			 hemlock.terminfo:keypad-xmit)))
     (setf (tty-device-cm-end-string device)
-	  (or (termcap :end-cursor-motion) ""))
+	  (concatenate 'simple-string
+		       (or (termcap :end-cursor-motion) "")
+		       ;; Exit transmit-mode.
+		       hemlock.terminfo:keypad-local))
     ;;
     ;; Screen image initialization.
     (set-up-screen-image device)
-- 
1.6.0.2.307.gc427

