1 ;;; viper-mous.el --- mouse support for Viper
3 ;; Copyright (C) 1994, 1995, 1996, 1997 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)
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.
27 (defvar double-click-time
)
28 (defvar mouse-track-multi-click-time
)
29 (defvar viper-search-start-marker
)
30 (defvar viper-local-search-start-marker
)
31 (defvar viper-search-history
)
32 (defvar viper-s-string
)
33 (defvar viper-re-search
)
35 ;; loading happens only in non-interactive compilation
36 ;; in order to spare non-viperized emacs from being viperized
39 (let ((load-path (cons (expand-file-name ".") load-path
)))
40 (or (featurep 'viper-util
)
41 (load "viper-util.el" nil nil
'nosuffix
))
42 (or (featurep 'viper-cmd
)
43 (load "viper-cmd.el" nil nil
'nosuffix
))
50 (defgroup viper-mouse nil
51 "Support for Viper special mouse-bound commands"
58 ;; Variable used for catching the switch-frame event.
59 ;; If non-nil, indicates that previous-frame should be the selected
60 ;; one. Used by viper-mouse-click-get-word. Not a user option.
61 (defvar viper-frame-of-focus nil
)
63 ;; Frame that was selected before the switch-frame event.
64 (defconst viper-current-frame-saved
(selected-frame))
66 (defcustom viper-surrounding-word-function
'viper-surrounding-word
67 "*Function that determines what constitutes a word for clicking events.
68 Takes two parameters: a COUNT, indicating how many words to return,
69 and CLICK-COUNT, telling whether this is the first click, a double-click,
74 ;; time interval in millisecond within which successive clicks are
76 (defcustom viper-multiclick-timeout
(if (viper-window-display-p)
78 mouse-track-multi-click-time
81 "*Time interval in millisecond within which successive mouse clicks are
86 ;; current event click count; XEmacs only
87 (defvar viper-current-click-count
0)
88 ;; time stamp of the last click event; XEmacs only
89 (defvar viper-last-click-event-timestamp
0)
91 ;; Local variable used to toggle wraparound search on click.
92 (viper-deflocalvar viper-mouse-click-search-noerror t
)
94 ;; Local variable used to delimit search after wraparound.
95 (viper-deflocalvar viper-mouse-click-search-limit nil
)
97 ;; remembers prefix argument to pass along to commands invoked by second
99 ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
100 ;; causes Emacs to count the second click as if it was a single click
101 (defvar viper-global-prefix-argument nil
)
104 ;; same keys, but parsed
105 (defvar viper-mouse-up-search-key-parsed nil
)
106 (defvar viper-mouse-down-search-key-parsed nil
)
107 (defvar viper-mouse-up-insert-key-parsed nil
)
108 (defvar viper-mouse-down-insert-key-parsed nil
)
115 (defsubst viper-multiclick-p
()
116 (not (viper-sit-for-short viper-multiclick-timeout t
)))
118 ;; Returns window where click occurs
119 (defun viper-mouse-click-window (click)
120 (let ((win (if viper-xemacs-p
122 (posn-window (event-start click
)))))
123 (if (window-live-p win
)
125 (error "Click was not over a live window"))))
127 ;; Returns window where click occurs
128 (defsubst viper-mouse-click-frame
(click)
129 (window-frame (viper-mouse-click-window click
)))
131 ;; Returns the buffer of the window where click occurs
132 (defsubst viper-mouse-click-window-buffer
(click)
133 (window-buffer (viper-mouse-click-window click
)))
135 ;; Returns the name of the buffer in the window where click occurs
136 (defsubst viper-mouse-click-window-buffer-name
(click)
137 (buffer-name (viper-mouse-click-window-buffer click
)))
139 ;; Returns position of a click
140 (defsubst viper-mouse-click-posn
(click)
143 (posn-point (event-start click
))))
146 (defun viper-surrounding-word (count click-count
)
147 "Returns word surrounding point according to a heuristic.
148 COUNT indicates how many regions to return.
149 If CLICK-COUNT is 1, `word' is a word in Vi sense.
150 If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
151 If the character clicked on is a non-separator and is non-alphanumeric but
152 is adjacent to an alphanumeric symbol, then it is considered alphanumeric
153 for the purpose of this command. If this character has a matching
154 character, such as `\(' is a match for `\)', then the matching character is
155 also considered alphanumeric.
156 For convenience, in Lisp modes, `-' is considered alphanumeric.
158 If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
159 trailing space and tabs removed. In that case, the first argument, COUNT,
161 (let ((modifiers "_")
164 (if (> click-count
2)
167 (viper-skip-all-separators-forward 'within-line
)
170 (setq result
(buffer-substring beg
(point))))
172 (if (and (not (viper-looking-at-alphasep))
173 (or (save-excursion (viper-backward-char-carefully)
174 (viper-looking-at-alpha))
175 (save-excursion (viper-forward-char-carefully)
176 (viper-looking-at-alpha))))
179 (cond ((looking-at "\\\\") "\\\\")
180 ((looking-at "-") "C-C-")
181 ((looking-at "[][]") "][")
182 ((looking-at "[()]") ")(")
183 ((looking-at "[{}]") "{}")
184 ((looking-at "[<>]") "<>")
185 ((looking-at "[`']") "`'")
186 ((looking-at "\\^") "\\^")
187 ((viper-looking-at-separator) "")
188 (t (char-to-string (following-char))))
192 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
194 (not (string-match "lisp" (symbol-name major-mode
)))
195 (setq modifiers
(concat modifiers
"C-C-")))
199 (cond ((> click-count
1) (viper-skip-nonseparators 'backward
))
200 ((viper-looking-at-alpha modifiers
)
201 (viper-skip-alpha-backward modifiers
))
202 ((not (viper-looking-at-alphasep modifiers
))
203 (viper-skip-nonalphasep-backward))
204 (t (if (> click-count
1)
205 (viper-skip-nonseparators 'backward
)
206 (viper-skip-alpha-backward modifiers
))))
208 (setq word-beg
(point))
210 (setq skip-flag nil
) ; don't move 1 char forw the first time
212 (if skip-flag
(viper-forward-char-carefully 1))
213 (setq skip-flag t
) ; now always move 1 char forward
214 (if (> click-count
1)
215 (viper-skip-nonseparators 'forward
)
216 (viper-skip-alpha-forward modifiers
))
217 (setq count
(1- count
)))
219 (setq result
(buffer-substring word-beg
(point))))
221 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
222 ;; doesn't return properties together with the string, so it's not needed.
224 (set-text-properties 0 (length result
) nil result
))
229 (defun viper-mouse-click-get-word (click count click-count
)
230 "Returns word surrounding the position of a mouse click.
231 Click may be in another window. Current window and buffer isn't changed.
232 On single or double click, returns the word as determined by
233 `viper-surrounding-word-function'."
235 (let ((click-word "")
236 (click-pos (viper-mouse-click-posn click
))
237 (click-buf (viper-mouse-click-window-buffer click
)))
238 (or (natnump count
) (setq count
1))
239 (or (natnump click-count
) (setq click-count
1))
242 (save-window-excursion
245 (set-buffer click-buf
)
247 (goto-char click-pos
)
249 (funcall viper-surrounding-word-function count click-count
)))
250 (error "Click must be over a window."))
254 (defun viper-mouse-click-insert-word (click arg
)
255 "Insert word clicked or double-clicked on.
256 With prefix argument, N, insert that many words.
257 This command must be bound to a mouse click.
258 The double-click action of the same mouse button must not be bound
259 \(or it must be bound to the same function\).
260 See `viper-surrounding-word' for the definition of a word in this case."
262 (if viper-frame-of-focus
;; to handle clicks in another frame
263 (select-frame viper-frame-of-focus
))
264 (if (or (not (eq (key-binding viper-mouse-down-insert-key-parsed
)
265 'viper-mouse-catch-frame-switch
))
266 (not (eq (key-binding viper-mouse-up-insert-key-parsed
)
267 'viper-mouse-click-insert-word
))
268 (and viper-xemacs-p
(not (event-over-text-area-p click
))))
269 () ; do nothing, if binding isn't right or not over text
270 ;; turn arg into a number
271 (cond ((integerp arg
) nil
)
272 ;; prefix arg is a list when one hits C-u then command
273 ((and (listp arg
) (integerp (car arg
)))
274 (setq arg
(car arg
)))
277 (if (not (eq (key-binding viper-mouse-down-insert-key-parsed
)
278 'viper-mouse-catch-frame-switch
))
280 (let (click-count interrupting-event
)
283 ;; This trick checks if there is a pending mouse event if so, we
284 ;; use this latter event and discard the current mouse click If
285 ;; the next pending event is not a mouse event, we execute the
286 ;; current mouse event
288 (setq interrupting-event
(viper-read-event))
289 (viper-mouse-event-p last-input-event
)))
290 (progn ; interrupted wait
291 (setq viper-global-prefix-argument arg
)
292 ;; count this click for XEmacs
293 (viper-event-click-count click
))
294 ;; uninterrupted wait or the interrupting event wasn't a mouse event
295 (setq click-count
(viper-event-click-count click
))
296 (if (> click-count
1)
297 (setq arg viper-global-prefix-argument
298 viper-global-prefix-argument nil
))
299 (insert (viper-mouse-click-get-word click arg click-count
))
300 (if (and interrupting-event
301 (eventp interrupting-event
)
302 (not (viper-mouse-event-p interrupting-event
)))
303 (viper-set-unread-command-events interrupting-event
))
306 ;; arg is an event. accepts symbols and numbers, too
307 (defun viper-mouse-event-p (event)
309 (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
310 (prin1-to-string (viper-event-key event
)))))
312 ;; XEmacs has no double-click events. So, we must simulate.
313 ;; So, we have to simulate event-click-count.
314 (defun viper-event-click-count (click)
317 ;; if more than 1 second
318 (if (> (- (event-timestamp click
) viper-last-click-event-timestamp
)
319 viper-multiclick-timeout
)
320 (setq viper-current-click-count
0))
321 (setq viper-last-click-event-timestamp
(event-timestamp click
)
322 viper-current-click-count
(1+ viper-current-click-count
)))
323 (event-click-count click
)))
327 (defun viper-mouse-click-search-word (click arg
)
328 "Find the word clicked or double-clicked on. Word may be in another window.
329 With prefix argument, N, search for N-th occurrence.
330 This command must be bound to a mouse click. The double-click action of the
331 same button must not be bound \(or it must be bound to the same function\).
332 See `viper-surrounding-word' for the details on what constitutes a word for
335 (if viper-frame-of-focus
;; to handle clicks in another frame
336 (select-frame viper-frame-of-focus
))
337 (if (or (not (eq (key-binding viper-mouse-down-search-key-parsed
)
338 'viper-mouse-catch-frame-switch
))
339 (not (eq (key-binding viper-mouse-up-search-key-parsed
)
340 'viper-mouse-click-search-word
))
341 (and viper-xemacs-p
(not (event-over-text-area-p click
))))
342 () ; do nothing, if binding isn't right or not over text
343 (let ((previous-search-string viper-s-string
)
344 click-word click-count
)
348 ;; This trick checks if there is a pending mouse event if so, we use
349 ;; this latter event and discard the current mouse click If the next
350 ;; pending event is not a mouse event, we execute the current mouse
354 (viper-mouse-event-p last-input-event
)))
355 (progn ; interrupted wait
356 (setq viper-global-prefix-argument
357 (or viper-global-prefix-argument arg
))
358 ;; remember command that was before the multiclick
359 (setq this-command last-command
)
360 ;; make sure we counted this event---needed for XEmacs only
361 (viper-event-click-count click
))
362 ;; uninterrupted wait
363 (setq click-count
(viper-event-click-count click
))
364 (setq click-word
(viper-mouse-click-get-word click nil click-count
))
366 (if (> click-count
1)
367 (setq arg viper-global-prefix-argument
368 viper-global-prefix-argument nil
))
369 (setq arg
(or arg
1))
371 (viper-deactivate-mark)
372 (if (or (not (string= click-word viper-s-string
))
373 (not (markerp viper-search-start-marker
))
374 (not (equal (marker-buffer viper-search-start-marker
)
376 (not (eq last-command
'viper-mouse-click-search-word
)))
378 (setq viper-search-start-marker
(point-marker)
379 viper-local-search-start-marker viper-search-start-marker
380 viper-mouse-click-search-noerror t
381 viper-mouse-click-search-limit nil
)
383 ;; make search string known to Viper
384 (setq viper-s-string
(if viper-re-search
385 (regexp-quote click-word
)
387 (if (not (string= viper-s-string
(car viper-search-history
)))
388 (setq viper-search-history
389 (cons viper-s-string viper-search-history
)))
394 (viper-forward-word 1)
397 (if (not (search-forward
398 click-word viper-mouse-click-search-limit
399 viper-mouse-click-search-noerror
))
401 (setq viper-mouse-click-search-noerror nil
)
402 (setq viper-mouse-click-search-limit
405 (markerp viper-local-search-start-marker
)
406 (marker-buffer viper-local-search-start-marker
))
407 (goto-char viper-local-search-start-marker
))
408 (viper-line-pos 'end
)))
410 (goto-char (point-min))
411 (search-forward click-word
412 viper-mouse-click-search-limit nil
)))
413 (goto-char (match-beginning 0))
414 (message "Searching for: %s" viper-s-string
)
415 (if (<= arg
1) ; found the right occurrence of the pattern
417 (viper-adjust-window)
418 (viper-flash-search-pattern)))
421 (if (or (not (string= click-word previous-search-string
))
422 (not (eq last-command
'viper-mouse-click-search-word
)))
423 (message "`%s': String not found in %s"
424 viper-s-string
(buffer-name (current-buffer)))
426 "`%s': Last occurrence in %s. Back to beginning of search"
427 click-word
(buffer-name (current-buffer)))
428 (setq arg
1) ;; to terminate the loop
430 (setq viper-mouse-click-search-noerror t
)
431 (setq viper-mouse-click-search-limit nil
)
432 (if (and (markerp viper-local-search-start-marker
)
433 (marker-buffer viper-local-search-start-marker
))
434 (goto-char viper-local-search-start-marker
))))
438 (defun viper-mouse-catch-frame-switch (event arg
)
439 "Catch the event of switching frame.
440 Usually is bound to a `down-mouse' event to work properly. See sample
441 bindings in the Viper manual."
443 (setq viper-frame-of-focus nil
)
444 ;; pass prefix arg along to viper-mouse-click-search/insert-word
445 (setq prefix-arg arg
)
446 (if (eq last-command
'handle-switch-frame
)
447 (setq viper-frame-of-focus viper-current-frame-saved
))
448 ;; make Emacs forget that it executed viper-mouse-catch-frame-switch
449 (setq this-command last-command
))
451 ;; Called just before switching frames. Saves the old selected frame.
452 ;; Sets last-command to handle-switch-frame (this is done automatically in
454 ;; The semantics of switching frames is different in Emacs and XEmacs.
455 ;; In Emacs, if you select-frame A while mouse is over frame B and then
456 ;; start typing, input goes to frame B, which becomes selected.
457 ;; In XEmacs, input will go to frame A. This may be a bug in one of the
458 ;; Emacsen, but also may be a design decision.
459 ;; Also, in Emacs sending input to frame B generates handle-switch-frame
460 ;; event, while in XEmacs it doesn't.
461 ;; All this accounts for the difference in the behavior of
462 ;; viper-mouse-click-* commands when you click in a frame other than the one
463 ;; that was the last to receive input. In Emacs, focus will be in frame A
464 ;; until you do something other than viper-mouse-click-* command.
465 ;; In XEmacs, you have to manually select frame B (with the mouse click) in
466 ;; order to shift focus to frame B.
467 (defsubst viper-remember-current-frame
(frame)
468 (setq last-command
'handle-switch-frame
469 viper-current-frame-saved
(selected-frame)))
472 ;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
473 ;; Converts into a valid mouse button spec for the appropriate version of
474 ;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
475 ;; returns button-down key.
476 (defun viper-parse-mouse-key (key-var event-type
)
477 (let ((key (eval key-var
))
478 button-spec meta-spec shift-spec control-spec key-spec
)
485 (if (eq 'up event-type
)
486 "mouse-1" "down-mouse-1")
487 (if (eq 'up event-type
)
488 'button1up
'button1
)))
491 (if (eq 'up event-type
)
492 "mouse-2" "down-mouse-2")
493 (if (eq 'up event-type
)
494 'button2up
'button2
)))
497 (if (eq 'up event-type
)
498 "mouse-3" "down-mouse-3")
499 (if (eq 'up event-type
)
500 'button3up
'button3
)))
502 "%S: invalid button number, %S" key-var key
)))
505 (if viper-emacs-p
"M-" 'meta
)
506 (if viper-emacs-p
"" nil
))
508 (if (memq 'shift key
)
509 (if viper-emacs-p
"S-" 'shift
)
510 (if viper-emacs-p
"" nil
))
512 (if (memq 'control key
)
513 (if viper-emacs-p
"C-" 'control
)
514 (if viper-emacs-p
"" nil
)))
516 (setq key-spec
(if viper-emacs-p
520 control-spec meta-spec shift-spec button-spec
)))
525 control-spec meta-spec shift-spec button-spec
)))))
528 (defun viper-unbind-mouse-search-key ()
529 (if viper-mouse-up-search-key-parsed
530 (global-unset-key viper-mouse-up-search-key-parsed
))
531 (if viper-mouse-down-search-key-parsed
532 (global-unset-key viper-mouse-down-search-key-parsed
))
533 (setq viper-mouse-up-search-key-parsed nil
534 viper-mouse-down-search-key-parsed nil
))
536 (defun viper-unbind-mouse-insert-key ()
537 (if viper-mouse-up-insert-key-parsed
538 (global-unset-key viper-mouse-up-insert-key-parsed
))
539 (if viper-mouse-down-insert-key-parsed
540 (global-unset-key viper-mouse-down-insert-key-parsed
))
541 (setq viper-mouse-up-insert-key-parsed nil
542 viper-mouse-down-insert-key-parsed nil
))
544 ;; If FORCE, bind even if this mouse action is already bound to something else
545 (defun viper-bind-mouse-search-key (&optional force
)
546 (setq viper-mouse-up-search-key-parsed
547 (viper-parse-mouse-key 'viper-mouse-search-key
'up
)
548 viper-mouse-down-search-key-parsed
549 (viper-parse-mouse-key 'viper-mouse-search-key
'down
))
550 (cond ((or (null viper-mouse-up-search-key-parsed
)
551 (null viper-mouse-down-search-key-parsed
))
554 (key-binding viper-mouse-up-search-key-parsed
)
555 (not (eq (key-binding viper-mouse-up-search-key-parsed
)
556 'viper-mouse-click-search-word
)))
558 "%S already bound to a mouse event. Viper mouse-search feature disabled"
559 viper-mouse-up-search-key-parsed
))
561 (key-binding viper-mouse-down-search-key-parsed
)
562 (not (eq (key-binding viper-mouse-down-search-key-parsed
)
563 'viper-mouse-catch-frame-switch
)))
565 "%S already bound to a mouse event. Viper mouse-search feature disabled"
566 viper-mouse-down-search-key-parsed
))
568 (global-set-key viper-mouse-up-search-key-parsed
569 'viper-mouse-click-search-word
)
570 (global-set-key viper-mouse-down-search-key-parsed
571 'viper-mouse-catch-frame-switch
))))
573 ;; If FORCE, bind even if this mouse action is already bound to something else
574 (defun viper-bind-mouse-insert-key (&optional force
)
575 (setq viper-mouse-up-insert-key-parsed
576 (viper-parse-mouse-key 'viper-mouse-insert-key
'up
)
577 viper-mouse-down-insert-key-parsed
578 (viper-parse-mouse-key 'viper-mouse-insert-key
'down
))
579 (cond ((or (null viper-mouse-up-insert-key-parsed
)
580 (null viper-mouse-down-insert-key-parsed
))
583 (key-binding viper-mouse-up-insert-key-parsed
)
584 (not (eq (key-binding viper-mouse-up-insert-key-parsed
)
585 'viper-mouse-click-insert-word
)))
587 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
588 viper-mouse-up-insert-key-parsed
))
590 (key-binding viper-mouse-down-insert-key-parsed
)
591 (not (eq (key-binding viper-mouse-down-insert-key-parsed
)
592 'viper-mouse-catch-frame-switch
)))
594 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
595 viper-mouse-down-insert-key-parsed
))
597 (global-set-key viper-mouse-up-insert-key-parsed
598 'viper-mouse-click-insert-word
)
599 (global-set-key viper-mouse-down-insert-key-parsed
600 'viper-mouse-catch-frame-switch
))))
602 (defun viper-reset-mouse-search-key (symb val
)
603 (viper-unbind-mouse-search-key)
605 (viper-bind-mouse-search-key 'force
))
607 (defun viper-reset-mouse-insert-key (symb val
)
608 (viper-unbind-mouse-insert-key)
610 (viper-bind-mouse-insert-key 'force
))
613 (defcustom viper-mouse-search-key
'(meta shift
1)
614 "*Key used to click-search in Viper.
615 This must be a list that specifies the mouse button and modifiers.
616 The supported modifiers are `meta', `shift', and `control'.
617 For instance, `(meta shift 1)' means that holding the meta and shift
618 keys down and clicking on a word with mouse button 1
619 will search for that word in the buffer that was current before the click.
620 This buffer may be different from the one where the click occurred."
621 :type
'(list (set :inline t
:tag
"Modifiers" :format
"%t: %v"
622 (const :format
"%v " meta
)
623 (const :format
"%v " shift
)
625 (integer :tag
"Button"))
626 :set
'viper-reset-mouse-search-key
629 (defcustom viper-mouse-insert-key
'(meta shift
2)
630 "*Key used to click-insert in Viper.
631 Must be a list that specifies the mouse button and modifiers.
632 The supported modifiers are `meta', `shift', and `control'.
633 For instance, `(meta shift 2)' means that holding the meta and shift keys
634 down, and clicking on a word with mouse button 2, will insert that word
635 at the cursor in the buffer that was current just before the click.
636 This buffer may be different from the one where the click occurred."
637 :type
'(list (set :inline t
:tag
"Modifiers" :format
"%t: %v"
638 (const :format
"%v " meta
)
639 (const :format
"%v " shift
)
641 (integer :tag
"Button"))
642 :set
'viper-reset-mouse-insert-key
648 ;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
652 ;;; viper-mous.el ends here