Merge from emacs--rel--22

[gnu-emacs] / lisp / xt-mouse.el

diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index dea232179c66394e76d740e8f95940873f74192f..15aebb08ab262bf78b4f6f7b7d014879bce35b2b 100644 (file)
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -10,7 +10,7 @@
 
 ;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -131,6 +131,21 @@
         (+ c #x8000000 128)
       c)))
 
+(defun xterm-mouse-truncate-wrap (f)
+  "Truncate with wrap-around."
+  (condition-case nil
+      ;; First try the built-in truncate, in case there's no overflow.
+      (truncate f)
+    ;; In case of overflow, do wraparound by hand.
+    (range-error
+     ;; In our case, we wrap around every 3 days or so, so if we assume
+     ;; a maximum of 65536 wraparounds, we're safe for a couple years.
+     ;; Using a power of 2 makes rounding errors less likely.
+     (let* ((maxwrap (* 65536 2048))
+            (dbig (truncate (/ f maxwrap)))
+            (fdiff (- f (* 1.0 maxwrap dbig))))
+       (+ (truncate fdiff) (* maxwrap dbig))))))
+
 (defun xterm-mouse-event ()
   "Convert XTerm mouse event to Emacs mouse event."
   (let* ((type (- (xterm-mouse-event-read) #o40))
@@ -138,12 +153,12 @@
         (y (- (xterm-mouse-event-read) #o40 1))
         ;; Emulate timestamp information.  This is accurate enough
         ;; for default value of mouse-1-click-follows-link (450msec).
-        (timestamp (truncate
-                    (* 1000
-                       (- (float-time)
-                          (or xt-mouse-epoch
-                              (setq xt-mouse-epoch (float-time)))))))
-        (mouse (intern
+        (timestamp (xterm-mouse-truncate-wrap
+                     (* 1000
+                        (- (float-time)
+                           (or xt-mouse-epoch
+                               (setq xt-mouse-epoch (float-time)))))))
+         (mouse (intern
                 ;; For buttons > 3, the release-event looks
                 ;; differently (see xc/programs/xterm/button.c,
                 ;; function EditorButton), and there seems to come in
@@ -180,7 +195,8 @@
 ;;;###autoload
 (define-minor-mode xterm-mouse-mode
   "Toggle XTerm mouse mode.
-With prefix arg, turn XTerm mouse mode on iff arg is positive.
+With prefix arg, turn XTerm mouse mode on if arg is positive, otherwise turn
+it off.
 
 Turn it on to use Emacs mouse commands, and off to use xterm mouse commands.
 This works in terminal emulators compatible with xterm.  It only
@@ -192,9 +208,32 @@ down the SHIFT key while pressing the mouse button."
   (if xterm-mouse-mode
       ;; Turn it on
       (progn
+       ;; Frame creation and deletion.
+       (add-hook 'after-make-frame-functions 
+                 '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 'after-make-frame-functions 
+                'turn-on-xterm-mouse-tracking-on-terminal)
+    (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)))
 
@@ -230,18 +269,7 @@ down the SHIFT key while pressing the mouse button."
             (<= 1 (length (frames-on-display-list (frame-terminal frame)))))
     (turn-off-xterm-mouse-tracking-on-terminal frame)))
 
-;; Frame creation and deletion.
-(add-hook 'after-make-frame-functions '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)
-
 (provide 'xt-mouse)
 
-;;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
+;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
 ;;; xt-mouse.el ends here