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