bug#6758: 23.2; xterm.el: please provide an option to not discard input in terminal-init-xterm

[Jim Paris <jim@jtan.com>]

Stefan Monnier wrote:
> > Forget the time-dependent part of what I said, let's just send the
> > query and handle the response whenever it happens to come in.  See
> > the below patch.  This fixes everything -- it still detects both
> > modifyOtherKeys and the background color, but doesn't require flushing
> > input or rely on any timeouts at all, unlike the existing code.
> > And there's nothing tricky.  What do you think?
> 
> Looks pretty good from here, thank you.
> We may want to get rid of the "\e[>" (and "\e]11;") decode rules after
> they've been used, just in case (or better yet: make them more
> robust).
> 
> Any objection?

I found a problem: the Mac OS X terminal sets TERM=xterm-color, but it
responds to the "Secondary DA" query as if it were a "Primary DA" query.
Instead of a response like xterm's "\e[>0;253;0c", it sends "\e[?1;2c".

The below patch accounts for this.  It also adds the 2-second timeout
when reading responses, and unsets the decode rules once they're
unused.

-jim

--- xterm.el-orig	2010-04-03 18:26:04.000000000 -0400
+++ xterm.el	2010-08-03 16:05:49.000000000 -0400
@@ -440,6 +440,86 @@
 ;; List of terminals for which modify-other-keys has been turned on.
 (defvar xterm-modify-other-keys-terminal-list nil)
 
+(defun xterm-osc-translate (event)
+  "Read and handle a Operating System Controls response"
+  (let* ((str "")
+	 (chr nil)
+	 (recompute-faces nil))
+
+    ;; The reply should be of the form: \e ] 11 ; rgb: NUMBER1 / NUMBER2 / NUMBER3 \e \\
+    (while (not (equal (setq chr (read-event nil nil 2)) ?\\))
+      (setq str (concat str (string chr))))
+
+    (when (string-match "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str)
+      (setq recompute-faces
+	    (xterm-maybe-set-dark-background-mode
+	     (string-to-number (match-string 1 str) 16)
+	     (string-to-number (match-string 2 str) 16)
+	     (string-to-number (match-string 3 str) 16))))
+
+    (when recompute-faces
+      (tty-set-up-initial-frame-faces))
+
+    ;; We no longer expect the OSC response
+    (define-key input-decode-map "\e]11;" nil)
+    ""))
+
+(defun xterm-primary-da-translate (event)
+  "Read and handle a Primary Device Attributes response"
+  (let* ((str "")
+	 (chr nil))
+
+    ;; The reply should be of the form: \e [ ? Pd c
+    (while (not (equal (setq chr (read-event nil nil 2)) ?c))
+      (setq str (concat str (string chr))))
+
+    ;; No need to do anything with this response.
+
+    ;; Undefine both DA responses, as we don't expect either anymore
+    (define-key input-decode-map "\e[?" nil)
+    (define-key input-decode-map "\e[>" nil)
+    ""))
+	 
+(defun xterm-secondary-da-translate (event)
+  "Read and handle a Secondary Device Attributes response"
+  (let* ((str "")
+	 (chr nil)
+	 version)
+
+    ;; The reply should be of the form: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
+    (while (not (equal (setq chr (read-event nil nil 2)) ?c))
+      (setq str (concat str (string chr))))
+
+    (when (string-match "0;\\([0-9]+\\);0" str)
+      (setq version (string-to-number
+		     (substring str (match-beginning 1) (match-end 1))))
+      ;; NUMBER2 is the xterm version number, look for something
+      ;; greater than 216, the version when modifyOtherKeys was
+      ;; introduced.
+      (when (>= version 216)
+	;; Make sure that the modifyOtherKeys state is restored when
+	;; suspending, resuming and exiting.
+	(add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys)
+	(add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys)
+	(add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys)
+	(add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys)
+	;; Add the selected frame to the list of frames that
+	;; need to deal with modify-other-keys.
+	(push (frame-terminal (selected-frame))
+	      xterm-modify-other-keys-terminal-list)
+	(xterm-turn-on-modify-other-keys))
+
+      ;; xterm version 235 supports reporting the background
+      ;; color, maybe earlier versions do too...
+      (when (>= version 235)
+	(define-key input-decode-map "\e]11;" 'xterm-osc-translate)
+	(send-string-to-terminal "\e]11;?\e\\")))
+    
+    ;; Undefine both DA responses, as we don't expect either anymore
+    (define-key input-decode-map "\e[?" nil)
+    (define-key input-decode-map "\e[>" nil)
+    ""))
+
 (defun terminal-init-xterm ()
   "Terminal initialization function for xterm."
   ;; rxvt terminals sometimes set the TERM variable to "xterm", but
@@ -469,71 +549,15 @@
     ;; C-. C-, etc.
     ;; To do that we need to find out if the current terminal supports
     ;; modifyOtherKeys. At this time only xterm does.
-    (let ((coding-system-for-read 'binary)
-	  (chr nil)
-	  (str nil)
-	  (recompute-faces nil)
-	  version)
-      ;; Pending input can be mistakenly returned by the calls to
-      ;; read-event below.  Discard it.
-      (discard-input)
-      ;; Try to find out the type of terminal by sending a "Secondary
-      ;; Device Attributes (DA)" query.
-      (send-string-to-terminal "\e[>0c")
-
-      ;; The reply should be of the form: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c
-      ;; If the timeout is completely removed for read-event, this
-      ;; might hang for terminals that pretend to be xterm, but don't
-      ;; respond to this escape sequence.  RMS' opinion was to remove
-      ;; it completely.  That might be right, but let's first try to
-      ;; see if by using a longer timeout we get rid of most issues.
-      (when (equal (read-event nil nil 2) ?\e)
-	(when (equal (read-event nil nil 2) ?\[)
-	  (while (not (equal (setq chr (read-event nil nil 2)) ?c))
-	    (setq str (concat str (string chr))))
-	  (when (string-match ">0;\\([0-9]+\\);0" str)
-	    (setq version (string-to-number
-			   (substring str (match-beginning 1) (match-end 1))))
-	    ;; xterm version 242 supports reporting the background
-	    ;; color, maybe earlier versions do too...
-	    (when (>= version 242)
-	      (send-string-to-terminal "\e]11;?\e\\")
-	      (when (equal (read-event nil nil 2) ?\e)
-		(when (equal (read-event nil nil 2) ?\])
-		  (setq str "")
-		  (while (not (equal (setq chr (read-event nil nil 2)) ?\\))
-		    (setq str (concat str (string chr))))
-		  (when (string-match "11;rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str)
-		    (setq recompute-faces
-			  (xterm-maybe-set-dark-background-mode
-			   (string-to-number (match-string 1 str) 16)
-			   (string-to-number (match-string 2 str) 16)
-			   (string-to-number (match-string 3 str) 16)))))))
-	    ;; NUMBER2 is the xterm version number, look for something
-	    ;; greater than 216, the version when modifyOtherKeys was
-	    ;; introduced.
-	    (when (>= version 216)
-	      ;; Make sure that the modifyOtherKeys state is restored when
-	      ;; suspending, resuming and exiting.
-	      (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys)
-	      (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys)
-	      (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys)
-	      (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys)
-	      ;; Add the selected frame to the list of frames that
-	      ;; need to deal with modify-other-keys.
-	      (push (frame-terminal (selected-frame))
-		    xterm-modify-other-keys-terminal-list)
-	      (xterm-turn-on-modify-other-keys))
-
-	    ;; Recompute faces here in case the background mode was
-	    ;; set to dark.  We used to call
-	    ;; `tty-set-up-initial-frame-faces' only once, but that
-	    ;; caused the light background faces to be computed
-	    ;; incorrectly.  See:
-	    ;; http://permalink.gmane.org/gmane.emacs.devel/119627
-	    (when recompute-faces
-	      (tty-set-up-initial-frame-faces))))))
 
+    ;; Try to find out the type of terminal by sending a "Secondary
+    ;; Device Attributes (DA)" query.  Some terminals (like OS X's
+    ;; Terminal.app) respond to this query as if it were a "Primary
+    ;; Device Attributes" query instead, so we should handle that too.
+    (define-key input-decode-map "\e[?" 'xterm-primary-da-translate)
+    (define-key input-decode-map "\e[>" 'xterm-secondary-da-translate)
+    (send-string-to-terminal "\e[>0c")
+    
     (run-hooks 'terminal-init-xterm-hook))
 
 ;; Set up colors, for those versions of xterm that support it.