Mercurial > emacs
comparison lisp/xt-mouse.el @ 13500:5de4c8a3f702
(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.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sat, 11 Nov 1995 04:07:39 +0000 |
| parents | 01f90e21a1db |
| children | 3a5b5eeba5b5 |
comparison
equal
deleted
inserted
replaced
| 13499:309b1a308079 | 13500:5de4c8a3f702 |
|---|---|
| 34 | 34 |
| 35 ;; Clicking on the mode-line does not work, although it should. | 35 ;; Clicking on the mode-line does not work, although it should. |
| 36 | 36 |
| 37 ;;; Code: | 37 ;;; Code: |
| 38 | 38 |
| 39 ;; Emacs only generates down events when needed. | |
| 40 ;; This is too hard to emulate, so we cheat instead. | |
| 41 (or (lookup-key global-map [ down-mouse-1 ]) | |
| 42 (define-key global-map [ down-mouse-1 ] 'ignore)) | |
| 43 (or (lookup-key global-map [ down-mouse-2 ]) | |
| 44 (define-key global-map [ down-mouse-2 ] 'ignore)) | |
| 45 (or (lookup-key global-map [ down-mouse-3 ]) | |
| 46 (define-key global-map [ down-mouse-3 ] 'ignore)) | |
| 47 | |
| 48 (define-key function-key-map "\e[M" 'xterm-mouse-translate) | 39 (define-key function-key-map "\e[M" 'xterm-mouse-translate) |
| 49 | 40 |
| 50 (defun xterm-mouse-translate (event) | 41 (defun xterm-mouse-translate (event) |
| 51 ;; Read a click and release event from XTerm. | 42 ;; Read a click and release event from XTerm. |
| 52 (save-excursion | 43 (save-excursion |
| 53 (save-window-excursion | 44 (save-window-excursion |
| 54 (deactivate-mark) | 45 (deactivate-mark) |
| 55 (let* ((last) | 46 (let* ((last) |
| 56 (down (xterm-mouse-event))) | 47 (down (xterm-mouse-event)) |
| 48 (down-command (nth 0 down)) | |
| 49 (down-data (nth 1 down)) | |
| 50 (down-where (nth 1 down-data)) | |
| 51 (down-binding (key-binding (if (symbolp down-where) | |
| 52 (vector down-where down-command) | |
| 53 (vector down-command))))) | |
| 57 (or (and (eq (read-char) ?\e) | 54 (or (and (eq (read-char) ?\e) |
| 58 (eq (read-char) ?\[) | 55 (eq (read-char) ?\[) |
| 59 (eq (read-char) ?M)) | 56 (eq (read-char) ?M)) |
| 60 (error "Unexpected escape sequence from XTerm")) | 57 (error "Unexpected escape sequence from XTerm")) |
| 61 (let ((click (xterm-mouse-event))) | 58 (let* ((click (xterm-mouse-event)) |
| 62 (setq unread-command-events | 59 (click-command (nth 0 click)) |
| 63 (append unread-command-events | 60 (click-data (nth 1 click)) |
| 64 (if (eq (nth 1 (nth 1 down)) (nth 1 (nth 1 click))) | 61 (click-where (nth 1 click-data))) |
| 65 (list click) | 62 (if (memq down-binding '(nil ignore)) |
| 66 (list | 63 (if (and (symbolp click-where) |
| 67 ;; Generate move event to cheat `mouse-drag-region'. | 64 (not (eq 'menu-bar click-where))) |
| 68 (list 'mouse-movement (nth 1 click)) | 65 (vector (list click-where click-data) click) |
| 69 ;; Generate a drag event. | 66 (vector click)) |
| 70 (list (intern (concat "drag-mouse-" (+ 1 last))) | 67 (setq unread-command-events |
| 71 (nth 1 down) (nth 1 click))))))) | 68 (if (eq down-where click-where) |
| 72 (vector down))))) | 69 (list click) |
| 70 (list | |
| 71 ;; Cheat `mouse-drag-region' with move event. | |
| 72 (list 'mouse-movement click-data) | |
| 73 ;; Generate a drag event. | |
| 74 (if (symbolp down-where) | |
| 75 0 | |
| 76 (list (intern (concat "drag-mouse-" (+ 1 last))) | |
| 77 down-data click-data)) | |
| 78 ))) | |
| 79 (if (and (symbolp down-where) | |
| 80 (not (eq 'menu-bar down-where))) | |
| 81 (vector (list down-where down-data) down) | |
| 82 (vector down)))))))) | |
| 83 | |
| 84 (defvar xterm-mouse-x 0 | |
| 85 "Position of last xterm mouse event relative to the frame.") | |
| 86 | |
| 87 (defvar xterm-mouse-y 0 | |
| 88 "Position of last xterm mouse event relative to the frame.") | |
| 89 | |
| 90 (defadvice mouse-position (around xterm-mouse activate) | |
| 91 "Use last key from xterm-mouse-mode if available." | |
| 92 (let ((answer ad-do-it)) | |
| 93 (setq ad-return-value | |
| 94 (if xterm-mouse-mode | |
| 95 (cons (car answer) (cons xterm-mouse-x xterm-mouse-y)) | |
| 96 answer)))) | |
| 73 | 97 |
| 74 (defun xterm-mouse-event () | 98 (defun xterm-mouse-event () |
| 75 ;; Convert XTerm mouse event to Emacs mouse event. | 99 ;; Convert XTerm mouse event to Emacs mouse event. |
| 76 (let* ((type (- (read-char) ? )) | 100 (let* ((type (- (read-char) ? )) |
| 77 (x (- (read-char) ? 1)) | 101 (x (- (read-char) ? 1)) |
| 78 (y (- (read-char) ? 1)) | 102 (y (- (read-char) ? 1)) |
| 79 (point (cons x y)) | 103 (point (cons x y)) |
| 80 (window (window-at x y)) | 104 (window (window-at x y)) |
| 81 (where (coordinates-in-window-p point window)) | 105 (where (if window |
| 106 (coordinates-in-window-p point window) | |
| 107 'menu-bar)) | |
| 82 (pos (if (consp where) | 108 (pos (if (consp where) |
| 83 (progn | 109 (progn |
| 84 (select-window window) | 110 (select-window window) |
| 85 (goto-char (window-start window)) | 111 (goto-char (window-start window)) |
| 86 (move-to-window-line (cdr where)) | 112 (move-to-window-line (cdr where)) |
| 90 where)) | 116 where)) |
| 91 (mouse (intern (if (eq type 3) | 117 (mouse (intern (if (eq type 3) |
| 92 (concat "mouse-" (+ 1 last)) | 118 (concat "mouse-" (+ 1 last)) |
| 93 (setq last type) | 119 (setq last type) |
| 94 (concat "down-mouse-" (+ 1 type)))))) | 120 (concat "down-mouse-" (+ 1 type)))))) |
| 121 (setq xterm-mouse-x x | |
| 122 xterm-mouse-y y) | |
| 95 (list mouse | 123 (list mouse |
| 96 (list window pos point | 124 (list window pos point |
| 97 (/ (nth 2 (current-time)) 1000))))) | 125 (/ (nth 2 (current-time)) 1000))))) |
| 98 | 126 |
| 99 ;; Indicator for the xterm-mouse mode. | 127 ;; Indicator for the xterm-mouse mode. |