;;; xt-mouse.el --- support the mouse when emacs run in an xterm
;; Copyright (C) 1994, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: mouse, terminals
;; 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,
;;; Code:
+(defvar xterm-mouse-debug-buffer nil)
+
;; XXX Perhaps this should be terminal-local instead. --lorentey
(define-key function-key-map "\e[M" 'xterm-mouse-translate)
;; 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)
(list (intern (format "drag-mouse-%d"
(+ 1 xterm-mouse-last)))
down-data click-data)))))
+ (if xterm-mouse-debug-buffer
+ (print unread-command-events xterm-mouse-debug-buffer))
(if (and (symbolp down-where)
(consp down-where))
(vector (list down-where down-data) down)
;;(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)
(+ 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))
- (mouse (intern
+ ;; 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,
;; function EditorButton), and there seems to come in
;; 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
(set-terminal-parameter nil 'xterm-mouse-y y)
(setq
last-input-event
- (if w
- (list mouse (posn-at-x-y (- x left) (- y top) w t))
- (list mouse
- (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t))))))))
+ (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))))))
+ (setcar (nthcdr 3 event) timestamp)
+ event)))))
;;;###autoload
(define-minor-mode xterm-mouse-mode
(provide 'xt-mouse)
-;;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
+;; arch-tag: 84962d4e-fae9-4c13-a9d7-ef4925a4ac03
;;; xt-mouse.el ends here