(wait_reading_process_input): Use getpid when generating SIGIO.
[emacs.git] / lisp / emulation / viper-mous.el
blob257c2c2cbd1386fb560e34a6dad9dfa9042f368f
1 ;;; viper-mous.el --- mouse support for Viper
3 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
22 (require 'viper-util)
25 ;;; Variables
27 ;; Variable used for catching the switch-frame event.
28 ;; If non-nil, indicates that previous-frame should be the selected
29 ;; one. Used by vip-mouse-click-get-word. Not a user option.
30 (defvar vip-frame-of-focus nil)
32 ;; Frame that was selected before the switch-frame event.
33 (defconst vip-current-frame-saved (selected-frame))
35 (defvar vip-surrounding-word-function 'vip-surrounding-word
36 "*Function that determines what constitutes a word for clicking events.
37 Takes two parameters: a COUNT, indicating how many words to return,
38 and CLICK-COUNT, telling whether this is the first click, a double-click,
39 or a tripple-click.")
41 ;; time interval in millisecond within which successive clicks are
42 ;; considered related
43 (defconst vip-multiclick-timeout (if vip-xemacs-p
44 mouse-track-multi-click-time
45 double-click-time)
46 "*Time interval in millisecond within which successive clicks are
47 considered related.")
49 ;; current event click count; XEmacs only
50 (defvar vip-current-click-count 0)
51 ;; time stamp of the last click event; XEmacs only
52 (defvar vip-last-click-event-timestamp 0)
54 ;; Local variable used to toggle wraparound search on click.
55 (vip-deflocalvar vip-mouse-click-search-noerror t)
57 ;; Local variable used to delimit search after wraparound.
58 (vip-deflocalvar vip-mouse-click-search-limit nil)
60 ;; remembers prefix argument to pass along to commands invoked by second
61 ;; click.
62 ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
63 ;; causes Emacs to count the second click as if it was a single click
64 (defvar vip-global-prefix-argument nil)
68 ;;; Code
70 (defsubst vip-multiclick-p ()
71 (not (vip-sit-for-short vip-multiclick-timeout t)))
73 ;; Returns window where click occurs
74 (defsubst vip-mouse-click-window (click)
75 (if vip-xemacs-p
76 (event-window click)
77 (posn-window (event-start click))))
79 ;; Returns window where click occurs
80 (defsubst vip-mouse-click-frame (click)
81 (window-frame (vip-mouse-click-window click)))
83 ;; Returns the buffer of the window where click occurs
84 (defsubst vip-mouse-click-window-buffer (click)
85 (window-buffer (vip-mouse-click-window click)))
87 ;; Returns the name of the buffer in the window where click occurs
88 (defsubst vip-mouse-click-window-buffer-name (click)
89 (buffer-name (vip-mouse-click-window-buffer click)))
91 ;; Returns position of a click
92 (defsubst vip-mouse-click-posn (click)
93 (if vip-xemacs-p
94 (event-point click)
95 (posn-point (event-start click))))
98 (defun vip-surrounding-word (count click-count)
99 "Returns word surrounding point according to a heuristic.
100 COUNT indicates how many regions to return.
101 If CLICK-COUNT is 1, `word' is a word in Vi sense.
102 If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
103 If the character clicked on is a non-separator and is non-alphanumeric but
104 is adjacent to an alphanumeric symbol, then it is considered alphanumeric
105 for the purpose of this command. If this character has a matching
106 character, such as `\(' is a match for `\)', then the matching character is
107 also considered alphanumeric.
108 For convenience, in Lisp modes, `-' is considered alphanumeric.
110 If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
111 trailing space and tabs removed. In that case, the first argument, COUNT,
112 is ignored."
113 (let ((modifiers "")
114 beg skip-flag result
115 word-beg)
116 (if (> click-count 2)
117 (save-excursion
118 (beginning-of-line)
119 (vip-skip-all-separators-forward 'within-line)
120 (setq beg (point))
121 (end-of-line)
122 (setq result (buffer-substring beg (point))))
124 (if (and (not (vip-looking-at-alphasep))
125 (or (save-excursion (vip-backward-char-carefully)
126 (vip-looking-at-alpha))
127 (save-excursion (vip-forward-char-carefully)
128 (vip-looking-at-alpha))))
129 (setq modifiers
130 (cond ((looking-at "\\\\") "\\\\")
131 ((looking-at "-") "C-C-")
132 ((looking-at "[][]") "][")
133 ((looking-at "[()]") ")(")
134 ((looking-at "[{}]") "{}")
135 ((looking-at "[<>]") "<>")
136 ((looking-at "[`']") "`'")
137 ((looking-at "\\^") "\\^")
138 ((vip-looking-at-separator) "")
139 (t (char-to-string (following-char))))
142 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
143 (or (looking-at "-")
144 (not (string-match "lisp" (symbol-name major-mode)))
145 (setq modifiers (concat modifiers "C-C-")))
148 (save-excursion
149 (cond ((> click-count 1) (vip-skip-nonseparators 'backward))
150 ((vip-looking-at-alpha modifiers)
151 (vip-skip-alpha-backward modifiers))
152 ((not (vip-looking-at-alphasep modifiers))
153 (vip-skip-nonalphasep-backward))
154 (t (if (> click-count 1)
155 (vip-skip-nonseparators 'backward)
156 (vip-skip-alpha-backward modifiers))))
158 (setq word-beg (point))
160 (setq skip-flag nil) ; don't move 1 char forw the first time
161 (while (> count 0)
162 (if skip-flag (vip-forward-char-carefully 1))
163 (setq skip-flag t) ; now always move 1 char forward
164 (if (> click-count 1)
165 (vip-skip-nonseparators 'forward)
166 (vip-skip-alpha-forward modifiers))
167 (setq count (1- count)))
169 (setq result (buffer-substring word-beg (point))))
170 ) ; if
171 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
172 ;; doesn't return properties together with the string, so it's not needed.
173 (if vip-emacs-p
174 (set-text-properties 0 (length result) nil result))
175 result
179 (defun vip-mouse-click-get-word (click count click-count)
180 "Returns word surrounding the position of a mouse click.
181 Click may be in another window. Current window and buffer isn't changed.
182 On single or double click, returns the word as determined by
183 `vip-surrounding-word-function'."
185 (let ((click-word "")
186 (click-pos (vip-mouse-click-posn click))
187 (click-buf (vip-mouse-click-window-buffer click)))
188 (or (numberp count) (setq count 1))
189 (or (numberp click-count) (setq click-count 1))
191 (save-excursion
192 (save-window-excursion
193 (if click-pos
194 (progn
195 (set-buffer click-buf)
197 (goto-char click-pos)
198 (setq click-word
199 (funcall vip-surrounding-word-function count click-count)))
200 (error "Click must be over a window."))
201 click-word))))
204 (defun vip-mouse-click-insert-word (click arg)
205 "Insert word clicked or double-clicked on.
206 With prefix argument, N, insert that many words.
207 This command must be bound to a mouse click.
208 The double-click action of the same mouse button must not be bound
209 \(or it must be bound to the same function\).
210 See `vip-surrounding-word' for the definition of a word in this case."
211 (interactive "e\nP")
212 (if vip-frame-of-focus ;; to handle clicks in another frame
213 (select-frame vip-frame-of-focus))
215 ;; turn arg into a number
216 (cond ((numberp arg) nil)
217 ;; prefix arg is a list when one hits C-u then command
218 ((and (listp arg) (numberp (car arg)))
219 (setq arg (car arg)))
220 (t (setq arg 1)))
222 (let (click-count interrupting-event)
223 (if (and
224 (vip-multiclick-p)
225 ;; This trick checks if there is a pending mouse event
226 ;; if so, we use this latter event and discard the current mouse click
227 ;; If the next pending event is not a mouse event, we execute
228 ;; the current mouse event
229 (progn
230 (setq interrupting-event (vip-read-event))
231 (vip-mouse-event-p last-input-event)))
232 (progn ;; interrupted wait
233 (setq vip-global-prefix-argument arg)
234 ;; count this click for XEmacs
235 (vip-event-click-count click))
236 ;; uninterrupted wait or the interrupting event wasn't a mouse event
237 (setq click-count (vip-event-click-count click))
238 (if (> click-count 1)
239 (setq arg vip-global-prefix-argument
240 vip-global-prefix-argument nil))
241 (insert (vip-mouse-click-get-word click arg click-count))
242 (if (and interrupting-event
243 (eventp interrupting-event)
244 (not (vip-mouse-event-p interrupting-event)))
245 (vip-set-unread-command-events interrupting-event))
248 ;; arg is an event. accepts symbols and numbers, too
249 (defun vip-mouse-event-p (event)
250 (if (eventp event)
251 (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
252 (prin1-to-string (vip-event-key event)))))
254 ;; XEmacs has no double-click events. So, we must simulate.
255 ;; So, we have to simulate event-click-count.
256 (defun vip-event-click-count (click)
257 (if vip-xemacs-p
258 (progn
259 ;; if more than 1 second
260 (if (> (- (event-timestamp click) vip-last-click-event-timestamp)
261 vip-multiclick-timeout)
262 (setq vip-current-click-count 0))
263 (setq vip-last-click-event-timestamp (event-timestamp click)
264 vip-current-click-count (1+ vip-current-click-count)))
265 (event-click-count click)))
269 (defun vip-mouse-click-search-word (click arg)
270 "Find the word clicked or double-clicked on. Word may be in another window.
271 With prefix argument, N, search for N-th occurrence.
272 This command must be bound to a mouse click. The double-click action of the
273 same button must not be bound \(or it must be bound to the same function\).
274 See `vip-surrounding-word' for the details on what constitutes a word for
275 this command."
276 (interactive "e\nP")
277 (if vip-frame-of-focus ;; to handle clicks in another frame
278 (select-frame vip-frame-of-focus))
279 (let (click-word click-count
280 (previous-search-string vip-s-string))
282 (if (and
283 (vip-multiclick-p)
284 ;; This trick checks if there is a pending mouse event
285 ;; if so, we use this latter event and discard the current mouse click
286 ;; If the next pending event is not a mouse event, we execute
287 ;; the current mouse event
288 (progn
289 (vip-read-event)
290 (vip-mouse-event-p last-input-event)))
291 (progn ;; interrupted wait
292 (setq vip-global-prefix-argument
293 (or vip-global-prefix-argument arg))
294 ;; remember command that was before the multiclick
295 (setq this-command last-command)
296 ;; make sure we counted this event---needed for XEmacs only
297 (vip-event-click-count click))
298 ;; uninterrupted wait
299 (setq click-count (vip-event-click-count click))
300 (setq click-word (vip-mouse-click-get-word click nil click-count))
302 (if (> click-count 1)
303 (setq arg vip-global-prefix-argument
304 vip-global-prefix-argument nil))
305 (setq arg (or arg 1))
307 (vip-deactivate-mark)
308 (if (or (not (string= click-word vip-s-string))
309 (not (markerp vip-search-start-marker))
310 (not (equal (marker-buffer vip-search-start-marker)
311 (current-buffer)))
312 (not (eq last-command 'vip-mouse-click-search-word)))
313 (progn
314 (setq vip-search-start-marker (point-marker)
315 vip-local-search-start-marker vip-search-start-marker
316 vip-mouse-click-search-noerror t
317 vip-mouse-click-search-limit nil)
319 ;; make search string known to Viper
320 (setq vip-s-string (if vip-re-search
321 (regexp-quote click-word)
322 click-word))
323 (if (not (string= vip-s-string (car vip-search-history)))
324 (setq vip-search-history
325 (cons vip-s-string vip-search-history)))
328 (push-mark nil t)
329 (while (> arg 0)
330 (vip-forward-word 1)
331 (condition-case nil
332 (progn
333 (if (not (search-forward click-word vip-mouse-click-search-limit
334 vip-mouse-click-search-noerror))
335 (progn
336 (setq vip-mouse-click-search-noerror nil)
337 (setq vip-mouse-click-search-limit
338 (save-excursion
339 (if (and
340 (markerp vip-local-search-start-marker)
341 (marker-buffer vip-local-search-start-marker))
342 (goto-char vip-local-search-start-marker))
343 (vip-line-pos 'end)))
345 (goto-char (point-min))
346 (search-forward click-word
347 vip-mouse-click-search-limit nil)))
348 (goto-char (match-beginning 0))
349 (message "Searching for: %s" vip-s-string)
350 (if (<= arg 1)
351 (vip-flash-search-pattern))
353 (error (beep 1)
354 (if (or (not (string= click-word previous-search-string))
355 (not (eq last-command 'vip-mouse-click-search-word)))
356 (message "`%s': String not found in %s"
357 vip-s-string (buffer-name (current-buffer)))
358 (message
359 "`%s': Last occurrence in %s. Back to beginning of search"
360 click-word (buffer-name (current-buffer)))
361 (setq arg 1) ;; to terminate the loop
362 (sit-for 2))
363 (setq vip-mouse-click-search-noerror t)
364 (setq vip-mouse-click-search-limit nil)
365 (if (and (markerp vip-local-search-start-marker)
366 (marker-buffer vip-local-search-start-marker))
367 (goto-char vip-local-search-start-marker))))
368 (setq arg (1- arg)))
371 (defun vip-mouse-catch-frame-switch (event arg)
372 "Catch the event of switching frame.
373 Usually is bound to a 'down-mouse' event to work properly. See sample
374 bindings in viper.el and in the Viper manual."
375 (interactive "e\nP")
376 (setq vip-frame-of-focus nil)
377 ;; pass prefix arg along to vip-mouse-click-search/insert-word
378 (setq prefix-arg arg)
379 (if (eq last-command 'handle-switch-frame)
380 (setq vip-frame-of-focus vip-current-frame-saved))
381 ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
382 (setq this-command last-command))
384 ;; Called just before switching frames. Saves the old selected frame.
385 ;; Sets last-command to handle-switch-frame (this is done automatically in
386 ;; Emacs.
387 ;; The semantics of switching frames is different in Emacs and XEmacs.
388 ;; In Emacs, if you select-frame A while mouse is over frame B and then
389 ;; start typing, input goes to frame B, which becomes selected.
390 ;; In XEmacs, input will go to frame A. This may be a bug in one of the
391 ;; Emacsen, but also may be a design decision.
392 ;; Also, in Emacs sending input to frame B generates handle-switch-frame
393 ;; event, while in XEmacs it doesn't.
394 ;; All this accounts for the difference in the behavior of
395 ;; vip-mouse-click-* commands when you click in a frame other than the one
396 ;; that was the last to receive input. In Emacs, focus will be in frame A
397 ;; until you do something other than vip-mouse-click-* command.
398 ;; In XEmacs, you have to manually select frame B (with the mouse click) in
399 ;; order to shift focus to frame B.
400 (defsubst vip-remember-current-frame (frame)
401 (setq last-command 'handle-switch-frame
402 vip-current-frame-saved (selected-frame)))
405 (cond ((vip-window-display-p)
406 (let* ((search-key (if vip-xemacs-p
407 [(meta shift button1up)] [M-S-mouse-1]))
408 (search-key-catch (if vip-xemacs-p
409 [(meta shift button1)] [M-S-down-mouse-1]))
410 (insert-key (if vip-xemacs-p
411 [(meta shift button2up)] [M-S-mouse-2]))
412 (insert-key-catch (if vip-xemacs-p
413 [(meta shift button2)] [M-S-down-mouse-2]))
414 (search-key-unbound (and (not (key-binding search-key))
415 (not (key-binding search-key-catch))))
416 (insert-key-unbound (and (not (key-binding insert-key))
417 (not (key-binding insert-key-catch))))
420 (if search-key-unbound
421 (global-set-key search-key 'vip-mouse-click-search-word))
422 (if insert-key-unbound
423 (global-set-key insert-key 'vip-mouse-click-insert-word))
425 ;; The following would be needed if you want to use the above two
426 ;; while clicking in another frame. If you only want to use them
427 ;; by clicking in another window, not frame, the bindings below
428 ;; aren't necessary.
430 ;; These must be bound to mouse-down event for the same mouse
431 ;; buttons as 'vip-mouse-click-search-word and
432 ;; 'vip-mouse-click-insert-word
433 (if search-key-unbound
434 (global-set-key search-key-catch 'vip-mouse-catch-frame-switch))
435 (if insert-key-unbound
436 (global-set-key insert-key-catch 'vip-mouse-catch-frame-switch))
438 (if vip-xemacs-p
439 (add-hook 'mouse-leave-frame-hook
440 'vip-remember-current-frame)
441 (defadvice handle-switch-frame (before vip-frame-advice activate)
442 "Remember the selected frame before the switch-frame event."
443 (vip-remember-current-frame (selected-frame))))
448 (provide 'viper-mous)
450 ;;; viper-mous.el ends here