(custom-theme-set-variables): Sort symbols that are

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

diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 39333f74868a1141b724980353636d8c56616674..1a41322f809394be26c614b4afb4f53917d78cc0 100644 (file)
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -1,7 +1,7 @@
 ;;; xt-mouse.el --- support the mouse when emacs run in an xterm
 
 ;; Copyright (C) 1994, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: mouse, terminals
@@ -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,
@@ -49,7 +49,8 @@
 
 ;; Mouse events symbols must have an 'event-kind property with
 ;; the value 'mouse-click.
-(dolist (event-type '(mouse-1 mouse-2 mouse-3))
+(dolist (event-type '(mouse-1 mouse-2 mouse-3
+                             M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
   (put event-type 'event-kind 'mouse-click))
 
 (defun xterm-mouse-translate (event)
@@ -105,6 +106,8 @@
 (defvar xterm-mouse-y 0
   "Position of last xterm mouse event relative to the frame.")
 
+(defvar xt-mouse-epoch nil)
+
 ;; Indicator for the xterm-mouse mode.
 
 (defun xterm-mouse-position-function (pos)
@@ -119,13 +122,34 @@
         (+ 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))
         (x (- (xterm-mouse-event-read) #o40 1))
         (y (- (xterm-mouse-event-read) #o40 1))
-        (time (current-time))
-        (timestamp (+ ( * (nth 1 time) 1000 ) (/ (nth 2 time) 1000)))
+        ;; Emulate timestamp information.  This is accurate enough
+        ;; for default value of mouse-1-click-follows-link (450msec).
+        (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,
@@ -133,6 +157,11 @@
                 ;; a release-event only, no down-event.
                 (cond ((>= type 64)
                        (format "mouse-%d" (- type 60)))
+                      ((memq type '(8 9 10))
+                       (setq xterm-mouse-last type)
+                       (format "M-down-mouse-%d" (- type 7)))
+                      ((= type 11)
+                       (format "mouse-%d" (- xterm-mouse-last 7)))
                       ((= type 3)
                        (format "mouse-%d" (+ 1 xterm-mouse-last)))
                       (t
@@ -147,18 +176,19 @@
          xterm-mouse-y y)
     (setq
      last-input-event
-     (list mouse 
+     (list mouse
           (let ((event (if w
                            (posn-at-x-y (- x left) (- y top) w t)
                          (append (list nil 'menu-bar)
-                                 (nthcdr 2 (posn-at-x-y x y w t))))))
+                                 (nthcdr 2 (posn-at-x-y x y))))))
             (setcar (nthcdr 3 event) timestamp)
             event)))))
 
 ;;;###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
@@ -193,5 +223,5 @@ down the SHIFT key while pressing the mouse button."
 
 (provide 'xt-mouse)
 
-;;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
+;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
 ;;; xt-mouse.el ends here