diff options
| -rw-r--r-- | lisp/xt-mouse.el | 74 |
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 @@ | |||
| 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) |
| @@ -53,23 +44,56 @@ | |||
| 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. |
| @@ -78,7 +102,9 @@ | |||
| 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) |
| @@ -92,6 +118,8 @@ | |||
| 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))))) |