summaryrefslogtreecommitdiff
path: root/lisp/xt-mouse.el
diff options
context:
space:
mode:
authorRichard M. Stallman <rms@gnu.org>1995-11-11 04:07:39 +0000
committerRichard M. Stallman <rms@gnu.org>1995-11-11 04:07:39 +0000
commitcec01ccbd1ed0d090147ff700460238401c6dc88 (patch)
tree577f7d32f5916648a546a83977a2b1763a78107f /lisp/xt-mouse.el
parent6d0150f9a721108b95f3a96dc36f45d4a6746493 (diff)
downloademacs-cec01ccbd1ed0d090147ff700460238401c6dc88.tar.gz
(global-map): Removed bindings of down events to ignore.
(xterm-mouse-translate): Only generate down event when bound. Cleanup. Support for mode line and vertical bar dragging, and menu-bar events. (xterm-mouse-x): New variable. (xterm-mouse-y): New variable. (mouse-position): Advice to use above variables. (xterm-mouse-event): Support menu-bar. Set xterm-mouse-x and xterm-mouse-y.
Diffstat (limited to 'lisp/xt-mouse.el')
-rw-r--r--lisp/xt-mouse.el74
1 files changed, 51 insertions, 23 deletions
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index a0ea223af81..f7f0aaa4633 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -36,15 +36,6 @@
;;; Code:
-;; Emacs only generates down events when needed.
-;; This is too hard to emulate, so we cheat instead.
-(or (lookup-key global-map [ down-mouse-1 ])
- (define-key global-map [ down-mouse-1 ] 'ignore))
-(or (lookup-key global-map [ down-mouse-2 ])
- (define-key global-map [ down-mouse-2 ] 'ignore))
-(or (lookup-key global-map [ down-mouse-3 ])
- (define-key global-map [ down-mouse-3 ] 'ignore))
-
(define-key function-key-map "\e[M" 'xterm-mouse-translate)
(defun xterm-mouse-translate (event)
@@ -53,23 +44,56 @@
(save-window-excursion
(deactivate-mark)
(let* ((last)
- (down (xterm-mouse-event)))
+ (down (xterm-mouse-event))
+ (down-command (nth 0 down))
+ (down-data (nth 1 down))
+ (down-where (nth 1 down-data))
+ (down-binding (key-binding (if (symbolp down-where)
+ (vector down-where down-command)
+ (vector down-command)))))
(or (and (eq (read-char) ?\e)
(eq (read-char) ?\[)
(eq (read-char) ?M))
(error "Unexpected escape sequence from XTerm"))
- (let ((click (xterm-mouse-event)))
- (setq unread-command-events
- (append unread-command-events
- (if (eq (nth 1 (nth 1 down)) (nth 1 (nth 1 click)))
- (list click)
- (list
- ;; Generate move event to cheat `mouse-drag-region'.
- (list 'mouse-movement (nth 1 click))
- ;; Generate a drag event.
- (list (intern (concat "drag-mouse-" (+ 1 last)))
- (nth 1 down) (nth 1 click)))))))
- (vector down)))))
+ (let* ((click (xterm-mouse-event))
+ (click-command (nth 0 click))
+ (click-data (nth 1 click))
+ (click-where (nth 1 click-data)))
+ (if (memq down-binding '(nil ignore))
+ (if (and (symbolp click-where)
+ (not (eq 'menu-bar click-where)))
+ (vector (list click-where click-data) click)
+ (vector click))
+ (setq unread-command-events
+ (if (eq down-where click-where)
+ (list click)
+ (list
+ ;; Cheat `mouse-drag-region' with move event.
+ (list 'mouse-movement click-data)
+ ;; Generate a drag event.
+ (if (symbolp down-where)
+ 0
+ (list (intern (concat "drag-mouse-" (+ 1 last)))
+ down-data click-data))
+ )))
+ (if (and (symbolp down-where)
+ (not (eq 'menu-bar down-where)))
+ (vector (list down-where down-data) down)
+ (vector down))))))))
+
+(defvar xterm-mouse-x 0
+ "Position of last xterm mouse event relative to the frame.")
+
+(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))))
(defun xterm-mouse-event ()
;; Convert XTerm mouse event to Emacs mouse event.
@@ -78,7 +102,9 @@
(y (- (read-char) ? 1))
(point (cons x y))
(window (window-at x y))
- (where (coordinates-in-window-p point window))
+ (where (if window
+ (coordinates-in-window-p point window)
+ 'menu-bar))
(pos (if (consp where)
(progn
(select-window window)
@@ -92,6 +118,8 @@
(concat "mouse-" (+ 1 last))
(setq last type)
(concat "down-mouse-" (+ 1 type))))))
+ (setq xterm-mouse-x x
+ xterm-mouse-y y)
(list mouse
(list window pos point
(/ (nth 2 (current-time)) 1000)))))