]> code.delx.au - gnu-emacs/blobdiff - lisp/term/xterm.el
Merge from emacs-24, up to 2012-04-10T02:06:19Z!larsi@gnus.org
[gnu-emacs] / lisp / term / xterm.el
index 559bd037ffd051e12e1a30dc13a31f4937ef293c..7e56cd9fa1da1e6f3be965a7a431b32378337cbc 100644 (file)
@@ -1,7 +1,6 @@
 ;;; xterm.el --- define function key sequences and standard colors for xterm
 
-;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: FSF
 ;; Keywords: terminals
 
 ;;; Code:
 
+(defgroup xterm nil
+  "XTerm support."
+  :version "24.1"
+  :group 'emacs)
+
+(defcustom xterm-extra-capabilities 'check
+  "Whether Xterm supports some additional, more modern, features.
+If nil, just assume that it does not.
+If `check', try to check if it does.
+If a list, assume that the listed features are supported, without checking.
+
+The relevant features are:
+  modifyOtherKeys  -- if supported, more key bindings work (e.g, \"\\C-,\")
+  reportBackground -- if supported, Xterm reports its background color
+"
+  :version "24.1"
+  :group 'xterm
+  :type '(choice (const :tag "No" nil)
+                 (const :tag "Check" check)
+                 ;; NOTE: If you add entries here, make sure to update
+                 ;; `tocheck-capabilities' in `terminal-init-xterm' as well.
+                 (set (const :tag "modifyOtherKeys support" modifyOtherKeys)
+                      (const :tag "report background" reportBackground))))
+
 (defvar xterm-function-map
   (let ((map (make-sparse-keymap)))
 
   "Terminal initialization function for xterm."
   ;; rxvt terminals sometimes set the TERM variable to "xterm", but
   ;; rxvt's keybindings are incompatible with xterm's. It is
-  ;; better in that case to use rxvt's initializion function.
+  ;; better in that case to use rxvt's initialization function.
   (if (and (getenv "COLORTERM" (selected-frame))
           (string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame))))
       (tty-run-terminal-initialization (selected-frame) "rxvt")
       (set-keymap-parent map (keymap-parent input-decode-map))
       (set-keymap-parent input-decode-map map)))
 
-    (xterm-register-default-colors)
-    ;; This recomputes all the default faces given the colors we've just set up.
-    (tty-set-up-initial-frame-faces)
-    
-    ;; Try to turn on the modifyOtherKeys feature on modern xterms.
-    ;; When it is turned on many more key bindings work: things like
-    ;; C-. C-, etc.
-    ;; To do that we need to find out if the current terminal supports
-    ;; modifyOtherKeys. At this time only xterm does.
+  (xterm-register-default-colors)
+  (tty-set-up-initial-frame-faces)
+
+  ;; Try to turn on the modifyOtherKeys feature on modern xterms.
+  ;; When it is turned on many more key bindings work: things like
+  ;; C-. C-, etc.
+  ;; To do that we need to find out if the current terminal supports
+  ;; modifyOtherKeys.  At this time only xterm does.
+  (when xterm-extra-capabilities
     (let ((coding-system-for-read 'binary)
-         (chr nil)
-         (str nil))
+          (chr nil)
+          (str "")
+          (recompute-faces nil)
+          ;; If `xterm-extra-capabilities' is 'check, we don't know
+          ;; the capabilities.  We need to check for those defined
+          ;; as `xterm-extra-capabilities' set options.  Otherwise,
+          ;; we don't need to check for any capabilities because
+          ;; they are given by setting `xterm-extra-capabilities' to
+          ;; a list (which could be empty).
+          (tocheck-capabilities (if (eq 'check xterm-extra-capabilities)
+                                    '(modifyOtherKeys reportBackground)))
+          ;; The given capabilities are either the contents of
+          ;; `xterm-extra-capabilities', if it's a list, or an empty list.
+          (given-capabilities (if (consp xterm-extra-capabilities)
+                                  xterm-extra-capabilities))
+          version)
+      ;; 1. Set `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
+      ;; 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.
-      (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)
-           ;; NUMBER2 is the xterm version number, look for something
-           ;; greater than 216, the version when modifyOtherKeys was
-           ;; introduced.
-           (when (>= (string-to-number
-                      (substring str (match-beginning 1) (match-end 1))) 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))))))
+      (when (and (equal (read-event nil nil 2) ?\e)
+                 (equal (read-event nil nil 2) ?\[))
+        (while (not (equal (setq chr (read-event nil nil 2)) ?c))
+          (setq str (concat str (string chr))))
+        (if (string-match ">0;\\([0-9]+\\);0" str)
+            (setq version (string-to-number (match-string 1 str)))))
+      ;; 2. If reportBackground is known to be supported, or the
+      ;; version is 242 or higher, assume the xterm supports
+      ;; reporting the background color (TODO: maybe earlier
+      ;; versions do too...)
+      (when (or (memq 'reportBackground given-capabilities)
+                (and (memq 'reportBackground tocheck-capabilities)
+                     version
+                     (>= version 242)))
+        (send-string-to-terminal "\e]11;?\e\\")
+        (when (and (equal (read-event nil nil 2) ?\e)
+                   (equal (read-event nil nil 2) ?\]))
+          (setq str "")
+          (while (not (equal (setq chr (read-event nil nil 2)) ?\\))
+            (setq str (concat str (string chr))))
+          (if (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))))))
+
+      ;; 3. If modifyOtherKeys is known to be supported or the
+      ;; version is 216 (the version when modifyOtherKeys was
+      ;; introduced) or higher, initialize the modifyOtherKeys support.
+      (if (or (memq 'modifyOtherKeys given-capabilities)
+              (and (memq 'modifyOtherKeys tocheck-capabilities)
+                   version
+                   (>= version 216)))
+          (terminal-init-xterm-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))))
 
     (run-hooks 'terminal-init-xterm-hook))
 
+(defun terminal-init-xterm-modify-other-keys ()
+  "Terminal initialization for xterm's modifyOtherKeys support."
+  ;; 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))
+
 ;; Set up colors, for those versions of xterm that support it.
 (defvar xterm-standard-colors
   ;; The names in the comments taken from XTerm-col.ad in the xterm
@@ -564,7 +644,7 @@ versions of xterm."
        ;; 216 non-gray colors first
        (let ((r 0) (g 0) (b 0))
          (while (> ncolors 24)
-           ;; This and other formulae taken from 256colres.pl and
+           ;; This and other formulas taken from 256colres.pl and
            ;; 88colres.pl in the xterm distribution.
            (tty-color-define (format "color-%d" (- 256 ncolors))
                              (- 256 ncolors)
@@ -624,27 +704,33 @@ versions of xterm."
     (clear-face-cache)))
 
 (defun xterm-turn-on-modify-other-keys ()
-  "Turn on the modifyOtherKeys feature of xterm."
+  "Turn the modifyOtherKeys feature of xterm back on."
   (let ((terminal (frame-terminal (selected-frame))))
     (when (and (terminal-live-p terminal)
               (memq terminal xterm-modify-other-keys-terminal-list))
-      (send-string-to-terminal "\e[>4;1m"))))
+      (send-string-to-terminal "\e[>4;1m" terminal))))
 
 (defun xterm-turn-off-modify-other-keys (&optional frame)
-  "Turn off the modifyOtherKeys feature of xterm."
+  "Temporarily turn off the modifyOtherKeys feature of xterm."
   (let ((terminal (when frame (frame-terminal frame))))
-    (when (and (frame-live-p terminal)
+    (when (and (terminal-live-p terminal)
                (memq terminal xterm-modify-other-keys-terminal-list))
-      (send-string-to-terminal "\e[>4m"))))
+      (send-string-to-terminal "\e[>4m" terminal))))
 
 (defun xterm-remove-modify-other-keys (&optional terminal)
-  "Turn off the modifyOtherKeys feature of xterm and remove frame from consideration."
-  (setq terminal (and terminal (frame-terminal (selected-frame))))
+  "Turn off the modifyOtherKeys feature of xterm for good."
+  (setq terminal (or terminal (frame-terminal (selected-frame))))
   (when (and (terminal-live-p terminal)
             (memq terminal xterm-modify-other-keys-terminal-list))
     (setq xterm-modify-other-keys-terminal-list
          (delq terminal xterm-modify-other-keys-terminal-list))
-    (send-string-to-terminal "\e[>4m")))
+    (send-string-to-terminal "\e[>4m" terminal)))
+
+(defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
+  ;; Use the heuristic in `frame-set-background-mode' to decide if a
+  ;; frame is dark.
+  (when (< (+ redc greenc bluec) (* .6 (+ 65535 65535 65535)))
+    (set-terminal-parameter nil 'background-mode 'dark)
+    t))
 
-;; arch-tag: 12e7ebdd-1e6c-4b25-b0f9-35ace25e855a
 ;;; xterm.el ends here