Merge from emacs-23 branch
[bpt/emacs.git] / lisp / xt-mouse.el
index 5109596..eca5f81 100644 (file)
@@ -1,17 +1,16 @@
 ;;; xt-mouse.el --- support the mouse when emacs run in an xterm
 
-;; Copyright (C) 1994, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2000-2011 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: mouse, terminals
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -53,7 +50,7 @@
                              M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
   (put event-type 'event-kind 'mouse-click))
 
-(defun xterm-mouse-translate (event)
+(defun xterm-mouse-translate (_event)
   "Read a click and release event from XTerm."
   (save-excursion
     (save-window-excursion
 
 ;; read xterm sequences above ascii 127 (#x7f)
 (defun xterm-mouse-event-read ()
+  ;; We get the characters decoded by the keyboard coding system.  Try
+  ;; to recover the raw character.
   (let ((c (read-char)))
-    (if (< c 0)
-        (+ c #x8000000 128)
-      c)))
+    (cond ;; If meta-flag is t we get a meta character
+         ((>= c ?\M-\^@)
+          (- c (- ?\M-\^@ 128)))
+         ;; Reencode the character in the keyboard coding system, if
+         ;; this is a non-ASCII character.
+         ((>= c #x80)
+          (aref (encode-coding-string (string c) (keyboard-coding-system)) 0))
+         (t c))))
 
 (defun xterm-mouse-truncate-wrap (f)
   "Truncate with wrap-around."
                       ((= type 11)
                        (format "mouse-%d" (- xterm-mouse-last 7)))
                       ((= type 3)
-                       (format "mouse-%d" (+ 1 xterm-mouse-last)))
+                       ;; For buttons > 5 xterm only reports a
+                       ;; button-release event.  Avoid error by mapping
+                       ;; them all to mouse-1.
+                       (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
                       (t
                        (setq xterm-mouse-last type)
                        (format "down-mouse-%d" (+ 1 type))))))
@@ -202,50 +209,43 @@ single clicks are supported.  When turned on, the normal xterm
 mouse functionality for such clicks is still available by holding
 down the SHIFT key while pressing the mouse button."
   :global t :group 'mouse
+  (let ((do-hook (if xterm-mouse-mode 'add-hook 'remove-hook)))
+    (funcall do-hook 'terminal-init-xterm-hook
+             'turn-on-xterm-mouse-tracking-on-terminal)
+    (funcall do-hook 'delete-terminal-functions
+             'turn-off-xterm-mouse-tracking-on-terminal)
+    (funcall do-hook 'suspend-tty-functions
+             'turn-off-xterm-mouse-tracking-on-terminal)
+    (funcall do-hook 'resume-tty-functions
+             'turn-on-xterm-mouse-tracking-on-terminal)
+    (funcall do-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
+    (funcall do-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
+    (funcall do-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking))
   (if xterm-mouse-mode
       ;; Turn it on
       (progn
-       ;; Frame creation and deletion.
-        (add-hook 'terminal-init-xterm-hook
-                  'turn-on-xterm-mouse-tracking-on-terminal)
-
-       (add-hook 'delete-frame-functions 'xterm-mouse-handle-delete-frame)
-       
-       ;; Restore normal mouse behaviour outside Emacs.
-        (add-hook 'suspend-tty-functions
-                 'turn-off-xterm-mouse-tracking-on-terminal)
-       (add-hook 'resume-tty-functions
-                 'turn-on-xterm-mouse-tracking-on-terminal)
-       (add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
-       (add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
-       (add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)
        (setq mouse-position-function #'xterm-mouse-position-function)
        (turn-on-xterm-mouse-tracking))
     ;; Turn it off
-    (remove-hook 'delete-frame-functions 'xterm-mouse-handle-delete-frame)
-    (remove-hook 'suspend-tty-functions 
-                'turn-off-xterm-mouse-tracking-on-terminal)
-    (remove-hook 'resume-tty-functions 
-                'turn-on-xterm-mouse-tracking-on-terminal)
-    (remove-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
-    (remove-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
-    (remove-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)
     (turn-off-xterm-mouse-tracking 'force)
     (setq mouse-position-function nil)))
 
 (defun turn-on-xterm-mouse-tracking ()
   "Enable Emacs mouse tracking in xterm."
-  (dolist (terminal (delete-dups (mapcar 'frame-terminal (frame-list))))
+  (dolist (terminal (terminal-list))
     (turn-on-xterm-mouse-tracking-on-terminal terminal)))
 
-(defun turn-off-xterm-mouse-tracking (&optional force)
+(defun turn-off-xterm-mouse-tracking (&optional _force)
   "Disable Emacs mouse tracking in xterm."
-  (dolist (terminal (delete-dups (mapcar 'frame-terminal (frame-list))))
+  (dolist (terminal (terminal-list))
     (turn-off-xterm-mouse-tracking-on-terminal terminal)))
 
 (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
   "Enable xterm mouse tracking on TERMINAL."
-  (when (and xterm-mouse-mode (eq t (terminal-live-p terminal)))
+  (when (and xterm-mouse-mode (eq t (terminal-live-p terminal))
+            ;; Avoid the initial terminal which is not a termcap device.
+            ;; FIXME: is there more elegant way to detect the initial terminal?
+            (not (string= (terminal-name terminal) "initial_terminal")))
     (unless (terminal-parameter terminal 'xterm-mouse-mode)
       ;; Simulate selecting a terminal by selecting one of its frames ;-(
       (with-selected-frame (car (frames-on-display-list terminal))
@@ -258,7 +258,10 @@ down the SHIFT key while pressing the mouse button."
   ;; Only send the disable command to those terminals to which we've already
   ;; sent the enable command.
   (when (and (terminal-parameter terminal 'xterm-mouse-mode)
-             (eq t (terminal-live-p terminal)))
+             (eq t (terminal-live-p terminal))
+            ;; Avoid the initial terminal which is not a termcap device.
+            ;; FIXME: is there more elegant way to detect the initial terminal?
+            (not (string= (terminal-name terminal) "initial_terminal")))
     ;; We could remove the key-binding and unset the `xterm-mouse-mode'
     ;; terminal parameter, but it seems less harmful to send this escape
     ;; command too many times (or to catch an unintended key sequence), than
@@ -266,13 +269,6 @@ down the SHIFT key while pressing the mouse button."
     ;; pass by untranslated).
     (send-string-to-terminal "\e[?1000l" terminal)))
 
-(defun xterm-mouse-handle-delete-frame (frame)
-  "Turn off xterm mouse tracking if FRAME is the last frame on its device."
-  (when (and (eq t (frame-live-p frame))
-            (<= 1 (length (frames-on-display-list (frame-terminal frame)))))
-    (turn-off-xterm-mouse-tracking-on-terminal frame)))
-
 (provide 'xt-mouse)
 
-;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
 ;;; xt-mouse.el ends here