From 2523c845da0ef83046ff6f978254d43a4851b1f2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 Mar 2013 10:08:44 -0400 Subject: [PATCH] * lisp/term/xterm.el (xterm--report-background-handler): Don't burp upon timeout. (xterm--version-handler): Extract from terminal-init-xterm. (xterm--query): Don't mishandle timeout. Remove debugging messages. Allow multiple handlers. (terminal-init-xterm): Handle OSX's Terminal.app's incorrect answer. Fixes: debbugs:6758 --- lisp/ChangeLog | 7 ++++ lisp/term/xterm.el | 106 +++++++++++++++++++++++++++++------------------------ 2 files changed, 65 insertions(+), 48 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 60e01ae2d71..1f136ca398a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2013-03-11 Stefan Monnier + * term/xterm.el (xterm--report-background-handler): Don't burp + upon timeout. + (xterm--version-handler): Extract from terminal-init-xterm. + (xterm--query): Don't mishandle timeout. Remove debugging messages. + Allow multiple handlers. + (terminal-init-xterm): Handle OSX's Terminal.app's incorrect answer. + * term/xterm.el: Don't discard input (bug#6758). Use lexical-binding. (xterm--report-background-handler, xterm--query): New functions. (terminal-init-xterm): Use them. diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index a7e137bee99..dcf32e5c595 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -470,7 +470,7 @@ The relevant features are: (let ((str "") chr) ;; The reply should be: \e ] 11 ; rgb: NUMBER1 / NUMBER2 / NUMBER3 \e \\ - (while (not (equal (setq chr (read-event nil nil 2)) ?\\)) + (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?\\))) (setq str (concat str (string chr)))) (when (string-match "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str) @@ -489,34 +489,65 @@ The relevant features are: (when recompute-faces (tty-set-up-initial-frame-faces)))))) -(defun xterm--query (query reply-prefix handler) +(defun xterm--version-handler () + (let ((str "") + chr) + ;; The reply should be: \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. + (while (and (setq chr (read-event nil nil 2)) (not (equal chr ?c))) + (setq str (concat str (string chr)))) + (when (string-match "0;\\([0-9]+\\);0" str) + (let ((version (string-to-number (match-string 1 str)))) + ;; If version is 242 or higher, assume the xterm supports + ;; reporting the background color (TODO: maybe earlier + ;; versions do too...) + (when (>= version 242) + (xterm--query "\e]11;?\e\\" + '(("\e]11;" . xterm--report-background-handler)))) + + ;; If version is 216 (the version when modifyOtherKeys was + ;; introduced) or higher, initialize the + ;; modifyOtherKeys support. + (when (>= version 216) + (terminal-init-xterm-modify-other-keys)))))) + +(defun xterm--query (query handlers) ;; We used to query synchronously, but the need to use `discard-input' is ;; rather annoying (bug#6758). Maybe we could always use the asynchronous ;; approach, but it's less tested. ;; FIXME: Merge the two branches. (if (input-pending-p) (progn - (message "Doing %S asynchronously" query) - (define-key input-decode-map reply-prefix - (lambda (&optional _prompt) - ;; Unregister the handler, since we don't expect further answers. - (define-key input-decode-map reply-prefix nil) - (funcall handler) - [])) + (dolist (handler handlers) + (define-key input-decode-map (car handler) + (lambda (&optional _prompt) + ;; Unregister the handler, since we don't expect further answers. + (dolist (handler handlers) + (define-key input-decode-map (car handler) nil)) + (funcall (cdr handler)) + []))) (send-string-to-terminal query)) ;; Pending input can be mistakenly returned by the calls to ;; read-event below. Discard it. - (message "Doing %S synchronously" query) (send-string-to-terminal query) - (let ((i 0)) - (while (and (< i (length reply-prefix)) - (eq (read-event nil nil 2) (aref reply-prefix i))) - (setq i (1+ i))) - (if (= i (length reply-prefix)) - (funcall handler) - (push last-input-event unread-command-events) - (while (> i 0) - (push (aref reply-prefix (setq i (1- i))) unread-command-events)))))) + (while handlers + (let ((handler (pop handlers)) + (i 0)) + (while (and (< i (length (car handler))) + (let ((evt (read-event nil nil 2))) + (or (eq evt (aref (car handler) i)) + (progn (if evt (push evt unread-command-events)) + nil)))) + (setq i (1+ i))) + (if (= i (length (car handler))) + (funcall (cdr handler)) + (while (> i 0) + (push (aref (car handler) (setq i (1- i))) + unread-command-events))))))) (defun terminal-init-xterm () "Terminal initialization function for xterm." @@ -545,37 +576,16 @@ The relevant features are: (if (eq xterm-extra-capabilities 'check) ;; Try to find out the type of terminal by sending a "Secondary ;; Device Attributes (DA)" query. - (xterm--query - "\e[>0c" "\e[>" - (lambda () - (let ((str "") - chr) - ;; The reply should be: \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. - (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) - (let ((version (string-to-number (match-string 1 str)))) - ;; If version is 242 or higher, assume the xterm supports - ;; reporting the background color (TODO: maybe earlier - ;; versions do too...) - (when (>= version 242) - (xterm--query "\e]11;?\e\\" "\e]11;" - #'xterm--report-background-handler)) - - ;; If version is 216 (the version when modifyOtherKeys was - ;; introduced) or higher, initialize the - ;; modifyOtherKeys support. - (when (>= version 216) - (terminal-init-xterm-modify-other-keys))))))) + (xterm--query "\e[>0c" + ;; 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. + '(("\e[?" . xterm--version-handler) + ("\e[>" . xterm--version-handler))) (when (memq 'reportBackground xterm-extra-capabilities) - (xterm--query "\e]11;?\e\\" "\e]11;" - #'xterm--report-background-handler)) + (xterm--query "\e]11;?\e\\" + '(("\e]11;" . xterm--report-background-handler)))) (when (memq 'modifyOtherKeys xterm-extra-capabilities) (terminal-init-xterm-modify-other-keys))) -- 2.11.4.GIT