]> code.delx.au - gnu-emacs/blobdiff - lisp/xt-mouse.el
*** empty log message ***
[gnu-emacs] / lisp / xt-mouse.el
index dbd741e5e6c7cb8042dff366bb13eac1c7ec7aab..b87061e5316924ef5295f1ac88ec70474a82dd2f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; xt-mouse.el --- Support the mouse when emacs run in an xterm.
 
-;; Copyright (C) 1994 Free Software Foundation
+;; Copyright (C) 1994, 2000 Free Software Foundation
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: mouse, terminals
@@ -22,7 +22,7 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
-;;; Comments:
+;;; Commentary:
 
 ;; Enable mouse support when running inside an xterm or Linux console.
 
 
 ;; Clicking on the mode-line does not work, although it should.
 
-;;; Code: 
+;;; Code:
 
 (define-key function-key-map "\e[M" 'xterm-mouse-translate)
 
 (defvar xterm-mouse-last)
 
 (defun xterm-mouse-translate (event)
-  ;; Read a click and release event from XTerm.
+  "Read a click and release event from XTerm."
   (save-excursion
     (save-window-excursion
       (deactivate-mark)
@@ -86,7 +86,8 @@
                     ;; Generate a drag event.
                     (if (symbolp down-where)
                         0
-                      (list (intern (format "drag-mouse-%d" (+ 1 xterm-mouse-last)))
+                      (list (intern (format "drag-mouse-%d"
+                                            (+ 1 xterm-mouse-last)))
                             down-data click-data))
                     )))
            (if (and (symbolp down-where)
 (defvar xterm-mouse-y 0
   "Position of last xterm mouse event relative to the frame.")
 
-(defadvice mouse-position (around xterm-mouse activate)
-  "Use last key from xterm-mouse-mode if available."
-  (let ((answer ad-do-it))
-    (setq ad-return-value
-         (if xterm-mouse-mode
-             (cons (car answer) (cons xterm-mouse-x xterm-mouse-y))
-           answer))))
+;; Indicator for the xterm-mouse mode.
+(defvar xterm-mouse-mode nil)
+
+(defun xterm-mouse-position-function (pos)
+  "Bound to `mouse-position-function' in XTerm mouse mode."
+  (setcdr pos (cons xterm-mouse-x xterm-mouse-y))
+  pos)
 
 (defun xterm-mouse-event ()
-  ;; Convert XTerm mouse event to Emacs mouse event.
+  "Convert XTerm mouse event to Emacs mouse event."
   (let* ((type (- (read-char) ? ))
         (x (- (read-char) ?  1))
         (y (- (read-char) ?  1))
         (point (cons x y))
         (window (window-at x y))
-        (where (if window 
+        (where (if window
                    (coordinates-in-window-p point window)
                  'menu-bar))
         (pos (if (consp where)
          (list window pos point
                (/ (nth 2 (current-time)) 1000)))))
 
-;; Indicator for the xterm-mouse mode.
-(defvar xterm-mouse-mode nil)
-
 (or (assq 'xterm-mouse-mode minor-mode-alist)
     (setq minor-mode-alist
          (cons '(xterm-mouse-mode (" Mouse")) minor-mode-alist)))
@@ -161,22 +159,23 @@ Turn it on to use emacs mouse commands, and off to use xterm mouse commands."
       (if xterm-mouse-mode
          (progn
            (turn-off-xterm-mouse-tracking)
-           (setq xterm-mouse-mode nil)
+           (setq xterm-mouse-mode nil
+                 mouse-position-function nil)
            (set-buffer-modified-p (buffer-modified-p))))
     ;;Turn it on
-    (if xterm-mouse-mode
-       ()
-      (setq xterm-mouse-mode t)
+    (unless (or window-system xterm-mouse-mode)
+      (setq xterm-mouse-mode t
+           mouse-position-function #'xterm-mouse-position-function)
       (turn-on-xterm-mouse-tracking)
       (set-buffer-modified-p (buffer-modified-p)))))
 
 (defun turn-on-xterm-mouse-tracking ()
-  ;; Enable emacs mouse tracking in xterm.
+  "Enable Emacs mouse tracking in xterm."
   (if xterm-mouse-mode
       (send-string-to-terminal "\e[?1000h")))
 
 (defun turn-off-xterm-mouse-tracking ()
-  ;; Disable disable emacs mouse tracking in xterm.
+  "Disable disable Emacs mouse tracking in xterm."
   (if xterm-mouse-mode
       (send-string-to-terminal "\e[?1000l")))