summaryrefslogtreecommitdiff
path: root/lisp/xt-mouse.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2007-05-25 14:34:35 +0000
committerStefan Monnier <monnier@iro.umontreal.ca>2007-05-25 14:34:35 +0000
commit6ab93c85b827be908a86135d8f303cfea79d1e4b (patch)
tree0f110f16c03971a96853d99256a3fc236294be5d /lisp/xt-mouse.el
parentdade3ed8e7efa44d9c07871733bffc790df04cad (diff)
downloademacs-6ab93c85b827be908a86135d8f303cfea79d1e4b.tar.gz
(xterm-mouse-truncate-wrap): New function.
(xterm-mouse-event): Use it.
Diffstat (limited to 'lisp/xt-mouse.el')
-rw-r--r--lisp/xt-mouse.el29
1 files changed, 22 insertions, 7 deletions
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 3a7c8fd553a..349bfb3f764 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -126,6 +126,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))
@@ -133,12 +148,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
@@ -210,5 +225,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