Commit | Line | Data |
---|---|---|
9efe4a2d NR |
1 | ;;; t-mouse.el --- mouse support within the text terminal |
2 | ||
eff05ea1 NR |
3 | ;; Authors: Alessandro Rubini and Ian T Zimmerman |
4 | ;; Maintainer: Nick Roberts <nickrob@gnu.org> | |
9efe4a2d NR |
5 | ;; Keywords: mouse gpm linux |
6 | ||
eff05ea1 NR |
7 | ;; Copyright (C) 1994,1995 Alessandro Rubini <rubini@linux.it> |
8 | ;; parts are by Ian T Zimmermann <itz@rahul.net>, 1995,1998 | |
da927269 | 9 | ;; Copyright (C) 2006 |
eff05ea1 NR |
10 | ;; Free Software Foundation, Inc. |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
17 | ;; any later version. | |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
9efe4a2d | 23 | |
eff05ea1 NR |
24 | ;; You should have received a copy of the GNU General Public License |
25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
27 | ;; Boston, MA 02110-1301, USA. | |
9efe4a2d NR |
28 | |
29 | ;;; Commentary: | |
30 | ||
31 | ;; This package provides access to mouse event as reported by the | |
da927269 JPW |
32 | ;; gpm-Linux package. It uses the program "mev" to get mouse events. |
33 | ;; It tries to reproduce the functionality offered by Emacs under X. | |
9efe4a2d NR |
34 | ;; The "gpm" server runs under Linux, so this package is rather |
35 | ;; Linux-dependent. | |
36 | ||
eff05ea1 NR |
37 | ;; Modified by Nick Roberts for Emacs 22. In particular, the mode-line is |
38 | ;; now position sensitive. | |
9efe4a2d | 39 | |
da927269 | 40 | (defvar t-mouse-process nil |
556dfc1e | 41 | "Embeds the process which passes mouse events to Emacs. |
9efe4a2d NR |
42 | It is used by the program t-mouse.") |
43 | ||
44 | (defvar t-mouse-filter-accumulator "" | |
45 | "Accumulates input from the mouse reporting process.") | |
46 | ||
47 | (defvar t-mouse-debug-buffer nil | |
48 | "Events normally posted to command queue are printed here in debug mode. | |
49 | See `t-mouse-start-debug'.") | |
50 | ||
51 | (defvar t-mouse-current-xy '(0 . 0) | |
52 | "Stores the last mouse position t-mouse has been told about.") | |
53 | ||
54 | (defvar t-mouse-drag-start nil | |
55 | "Whenever a drag starts in a special part of a window | |
da927269 | 56 | \(not the text), the `translated' starting coordinates including the |
9efe4a2d NR |
57 | window and part involved are saved here. This is necessary lest they |
58 | get re-translated when the button goes up, at which time window | |
59 | configuration may have changed.") | |
60 | ||
61 | (defvar t-mouse-prev-set-selection-function 'x-set-selection) | |
62 | (defvar t-mouse-prev-get-selection-function 'x-get-selection) | |
63 | ||
64 | (defvar t-mouse-swap-alt-keys nil | |
65 | "When set, Emacs will handle mouse events with the right Alt | |
da927269 | 66 | \(a.k.a. Alt-Ger) modifier, not with the regular left Alt modifier. |
9efe4a2d NR |
67 | Useful for people who play strange games with their keyboard tables.") |
68 | ||
da927269 | 69 | (defvar t-mouse-fix-21 nil |
9efe4a2d NR |
70 | "Enable brain-dead chords for 2 button mice.") |
71 | ||
72 | \f | |
73 | ;;; Code: | |
74 | ||
75 | ;; get the number of the current virtual console | |
76 | ||
77 | (defun t-mouse-tty () | |
da927269 | 78 | "Return number of virtual terminal Emacs is running on, as a string. |
9efe4a2d | 79 | For example, \"2\" for /dev/tty2." |
eff05ea1 NR |
80 | (with-temp-buffer |
81 | (call-process "ps" nil t nil "h" (format "%s" (emacs-pid))) | |
82 | (goto-char (point-min)) | |
83 | (if (or | |
84 | ;; Many versions of "ps", all different.... | |
85 | (re-search-forward " +tty\\(.?[0-9a-f]\\)" nil t) | |
86 | (re-search-forward "p \\([0-9a-f]\\)" nil t) | |
87 | (re-search-forward "v0\\([0-9a-f]\\)" nil t) | |
88 | (re-search-forward "[0-9]+ +\\([0-9]+\\)" nil t) | |
89 | (re-search-forward "[\\t ]*[0-9]+[\\t ]+\\([0-9]+\\)" nil t) | |
90 | (re-search-forward " +vc/\\(.?[0-9a-f]\\)" nil t) | |
91 | (re-search-forward " +pts/\\(.?[0-9a-f]\\)" nil t)) | |
92 | (buffer-substring (match-beginning 1) (match-end 1))))) | |
9efe4a2d NR |
93 | |
94 | \f | |
95 | ;; due to a horrible kludge in Emacs' keymap handler | |
96 | ;; (read_key_sequence) mouse clicks on funny parts of windows generate | |
97 | ;; TWO events, the first being a dummy of the sort '(mode-line). | |
98 | ;; That's why Per Abrahamsen's code in xt-mouse.el doesn't work for | |
99 | ;; the modeline, for instance. | |
100 | ||
101 | ;; now get this: the Emacs C code that generates these fake events | |
102 | ;; depends on certain things done by the very lowest level input | |
103 | ;; handlers; namely the symbols for the events (for instance | |
104 | ;; 'C-S-double-mouse-2) must have an 'event-kind property, set to | |
105 | ;; 'mouse-click. Since events from unread-command-events do not pass | |
106 | ;; through the low level handlers, they don't get this property unless | |
107 | ;; I set it myself. I imagine this has caused innumerable attempts by | |
108 | ;; hackers to do things similar to t-mouse to lose. | |
109 | ||
110 | ;; The next page of code is devoted to fixing this ugly problem. | |
111 | ||
112 | ;; WOW! a fully general powerset generator | |
113 | ;; (C) Ian Zimmerman Mon Mar 23 12:00:16 PST 1998 :-) | |
114 | (defun t-mouse-powerset (l) | |
115 | (if (null l) '(nil) | |
116 | (let ((l1 (t-mouse-powerset (cdr l))) | |
117 | (first (nth 0 l))) | |
118 | (append | |
119 | (mapcar (function (lambda (l) (cons first l))) l1) l1)))) | |
120 | ||
121 | ;; and a slightly less general cartesian product | |
122 | (defun t-mouse-cartesian (l1 l2) | |
123 | (if (null l1) l2 | |
124 | (append (mapcar (function (lambda (x) (append (nth 0 l1) x))) l2) | |
125 | (t-mouse-cartesian (cdr l1) l2)))) | |
556dfc1e | 126 | |
9efe4a2d NR |
127 | (let* ((modifier-sets (t-mouse-powerset '(control meta shift))) |
128 | (typed-sets (t-mouse-cartesian '((down) (drag)) | |
129 | '((mouse-1) (mouse-2) (mouse-3)))) | |
130 | (multipled-sets (t-mouse-cartesian '((double) (triple)) typed-sets)) | |
131 | (all-sets (t-mouse-cartesian modifier-sets multipled-sets))) | |
132 | (while all-sets | |
133 | (let ((event-sym (event-convert-list (nth 0 all-sets)))) | |
134 | (if (not (get event-sym 'event-kind)) | |
135 | (put event-sym 'event-kind 'mouse-click))) | |
136 | (setq all-sets (cdr all-sets)))) | |
137 | ||
9efe4a2d NR |
138 | (defun t-mouse-make-event-element (x-dot-y-avec-time) |
139 | (let* ((x-dot-y (nth 0 x-dot-y-avec-time)) | |
140 | (x (car x-dot-y)) | |
141 | (y (cdr x-dot-y)) | |
9efe4a2d | 142 | (w (window-at x y)) |
eff05ea1 NR |
143 | (ltrb (window-edges w)) |
144 | (left (nth 0 ltrb)) | |
145 | (top (nth 1 ltrb))) | |
146 | (if w (posn-at-x-y (- x left) (- y top) w t) | |
147 | (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t)))))) | |
9efe4a2d NR |
148 | |
149 | ;;; This fun is partly Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk> | |
9efe4a2d | 150 | (defun t-mouse-make-event () |
da927269 JPW |
151 | "Make a Lisp style event from the contents of mouse input accumulator. |
152 | Also trim the accumulator by all the data used to build the event." | |
9efe4a2d | 153 | (let (ob (ob-pos (condition-case nil |
eff05ea1 NR |
154 | (progn |
155 | ;; this test is just needed for Fedora Core 3 | |
156 | (if (string-match "STILL RUNNING_1\n" | |
157 | t-mouse-filter-accumulator) | |
158 | (setq t-mouse-filter-accumulator | |
159 | (substring | |
160 | t-mouse-filter-accumulator (match-end 0)))) | |
161 | (read-from-string t-mouse-filter-accumulator)) | |
9efe4a2d | 162 | (error nil)))) |
eff05ea1 NR |
163 | ;; this test is just needed for Fedora Core 3 |
164 | (if (or (eq (car ob-pos) 'STILL) (eq (car ob-pos) '***) (not ob-pos)) | |
165 | nil | |
9efe4a2d NR |
166 | (setq ob (car ob-pos)) |
167 | (setq t-mouse-filter-accumulator | |
168 | (substring t-mouse-filter-accumulator (cdr ob-pos))) | |
169 | ||
170 | ;;now the real work | |
171 | ||
172 | (let ((event-type (nth 0 ob)) | |
173 | (current-xy-avec-time (nth 1 ob)) | |
174 | (type-switch (length ob))) | |
9efe4a2d NR |
175 | (if t-mouse-fix-21 |
176 | (let | |
177 | ;;Acquire the event's symbol's name. | |
178 | ((event-name-string (symbol-name event-type)) | |
179 | end-of-root-event-name | |
180 | new-event-name-string) | |
556dfc1e | 181 | |
9efe4a2d | 182 | (if (string-match "-\\(21\\|\\12\\)$" event-name-string) |
556dfc1e | 183 | |
9efe4a2d NR |
184 | ;;Transform the name to what it should have been. |
185 | (progn | |
186 | (setq end-of-root-event-name (match-beginning 0)) | |
187 | (setq new-event-name-string | |
da927269 | 188 | (concat (substring |
9efe4a2d NR |
189 | event-name-string 0 |
190 | end-of-root-event-name) "-3")) | |
556dfc1e | 191 | |
9efe4a2d NR |
192 | ;;Change the event to the symbol that corresponds to the |
193 | ;;name we made. The proper symbol already exists. | |
da927269 | 194 | (setq event-type |
9efe4a2d | 195 | (intern new-event-name-string)))))) |
556dfc1e | 196 | |
9efe4a2d NR |
197 | ;;store current position for mouse-position |
198 | ||
199 | (setq t-mouse-current-xy (nth 0 current-xy-avec-time)) | |
200 | ||
201 | ;;events have many types but fortunately they differ in length | |
202 | ||
203 | (cond | |
9efe4a2d NR |
204 | ((= type-switch 4) ;must be drag |
205 | (let ((count (nth 2 ob)) | |
206 | (start-element | |
207 | (or t-mouse-drag-start | |
208 | (t-mouse-make-event-element (nth 3 ob)))) | |
209 | (end-element | |
210 | (t-mouse-make-event-element current-xy-avec-time))) | |
211 | (setq t-mouse-drag-start nil) | |
212 | (list event-type start-element end-element count))) | |
213 | ((= type-switch 3) ;down or up | |
214 | (let ((count (nth 2 ob)) | |
215 | (element | |
216 | (t-mouse-make-event-element current-xy-avec-time))) | |
217 | (if (and (not t-mouse-drag-start) | |
218 | (symbolp (nth 1 element))) | |
219 | ;; OUCH! GOTCHA! emacs uses setc[ad]r on these! | |
220 | (setq t-mouse-drag-start (copy-sequence element)) | |
221 | (setq t-mouse-drag-start nil)) | |
222 | (list event-type element count))) | |
223 | ((= type-switch 2) ;movement | |
224 | (list (if (eq 'vertical-scroll-bar | |
225 | (nth 1 t-mouse-drag-start)) 'scroll-bar-movement | |
226 | 'mouse-movement) | |
227 | (t-mouse-make-event-element current-xy-avec-time)))))))) | |
228 | ||
9efe4a2d NR |
229 | (defun t-mouse-process-filter (proc string) |
230 | (setq t-mouse-filter-accumulator | |
231 | (concat t-mouse-filter-accumulator string)) | |
232 | (let ((event (t-mouse-make-event))) | |
233 | (while event | |
da927269 | 234 | (if (or track-mouse |
9efe4a2d NR |
235 | (not (eq 'mouse-movement (event-basic-type event)))) |
236 | (setq unread-command-events | |
237 | (nconc unread-command-events (list event)))) | |
238 | (if t-mouse-debug-buffer | |
239 | (print unread-command-events t-mouse-debug-buffer)) | |
240 | (setq event (t-mouse-make-event))))) | |
241 | ||
eff05ea1 | 242 | (defun t-mouse-mouse-position-function (pos) |
9efe4a2d NR |
243 | "Return the t-mouse-position unless running with a window system. |
244 | The (secret) scrollbar interface is not implemented yet." | |
eff05ea1 NR |
245 | (setcdr pos t-mouse-current-xy) |
246 | pos) | |
9efe4a2d NR |
247 | |
248 | ;; It should be possible to just send SIGTSTP to the inferior with | |
249 | ;; stop-process. That doesn't work; mev receives the signal fine but | |
250 | ;; is not really stopped: instead it returns from | |
251 | ;; kill(getpid(), SIGTSTP) immediately. I don't understand what's up | |
da927269 | 252 | ;; itz Tue Mar 24 14:27:38 PST 1998. |
9efe4a2d NR |
253 | |
254 | (add-hook 'suspend-hook | |
255 | (function (lambda () | |
256 | (and t-mouse-process | |
257 | ;(stop-process t-mouse-process) | |
258 | (process-send-string | |
259 | t-mouse-process "push -enone -dall -Mnone\n"))))) | |
260 | ||
261 | (add-hook 'suspend-resume-hook | |
262 | (function (lambda () | |
263 | (and t-mouse-process | |
264 | ;(continue-process t-mouse-process) | |
265 | (process-send-string t-mouse-process "pop\n"))))) | |
266 | ||
eff05ea1 NR |
267 | ;;;###autoload |
268 | (define-minor-mode t-mouse-mode | |
269 | "Toggle t-mouse mode. | |
270 | With prefix arg, turn t-mouse mode on iff arg is positive. | |
271 | ||
556dfc1e | 272 | Turn it on to use Emacs mouse commands, and off to use t-mouse commands." |
eff05ea1 NR |
273 | nil " Mouse" nil :global t |
274 | (if t-mouse-mode | |
275 | ;; Turn it on | |
276 | (unless window-system | |
277 | ;; Starts getting a stream of mouse events from an asynchronous process. | |
278 | ;; Only works if Emacs is running on a virtual terminal without a window system. | |
279 | (progn | |
280 | (setq mouse-position-function #'t-mouse-mouse-position-function) | |
281 | (let ((tty (t-mouse-tty)) | |
282 | (process-connection-type t)) | |
283 | (if (not (stringp tty)) | |
da927269 JPW |
284 | (error "Cannot find a virtual terminal")) |
285 | (setq t-mouse-process | |
eff05ea1 NR |
286 | (start-process "t-mouse" nil |
287 | "mev" "-i" "-E" "-C" tty | |
288 | (if t-mouse-swap-alt-keys | |
289 | "-M-leftAlt" "-M-rightAlt") | |
290 | "-e-move" | |
291 | "-dall" "-d-hard" | |
292 | "-f"))) | |
293 | (setq t-mouse-filter-accumulator "") | |
294 | (set-process-filter t-mouse-process 't-mouse-process-filter) | |
ab5e2abd | 295 | (set-process-query-on-exit-flag t-mouse-process nil))) |
eff05ea1 NR |
296 | ;; Turn it off |
297 | (setq mouse-position-function nil) | |
298 | (delete-process t-mouse-process) | |
299 | (setq t-mouse-process nil))) | |
9efe4a2d NR |
300 | |
301 | (provide 't-mouse) | |
302 | ||
e1b267c1 | 303 | ;; arch-tag: a63163b3-bfbe-4eb2-ab4f-201cd164b05d |
9efe4a2d | 304 | ;;; t-mouse.el ends here |