(cua-highlight-region-shift-only, cua-paste-pop): Fix typos in docstrings.
[bpt/emacs.git] / lisp / emulation / viper-mous.el
CommitLineData
be010748
RS
1;;; viper-mous.el --- mouse support for Viper
2
5fd6d89f 3;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002, 2003, 2004,
f0fa15c5 4;; 2005, 2006, 2007 Free Software Foundation, Inc.
d6fd318f 5
50a07e18 6;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
02f34c70 7
6c2e12f4
KH
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
e0085d62 12;; the Free Software Foundation; either version 3, or (at your option)
6c2e12f4
KH
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
b578f267 21;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
6c2e12f4 24
60370d40
PJ
25;;; Commentary:
26
27;;; Code:
03fc1246 28
9b70a748 29(provide 'viper-mous)
6c2e12f4 30
03fc1246
MK
31;; compiler pacifier
32(defvar double-click-time)
33(defvar mouse-track-multi-click-time)
8626cfa2
MK
34(defvar viper-search-start-marker)
35(defvar viper-local-search-start-marker)
36(defvar viper-search-history)
37(defvar viper-s-string)
38(defvar viper-re-search)
9b70a748 39
726e270f
MK
40;; loading happens only in non-interactive compilation
41;; in order to spare non-viperized emacs from being viperized
42(if noninteractive
43 (eval-when-compile
44 (let ((load-path (cons (expand-file-name ".") load-path)))
45 (or (featurep 'viper-util)
46 (load "viper-util.el" nil nil 'nosuffix))
47 (or (featurep 'viper-cmd)
48 (load "viper-cmd.el" nil nil 'nosuffix))
49 )))
9b70a748
MK
50;; end pacifier
51
52(require 'viper-util)
53
03fc1246 54
1e70790f 55(defgroup viper-mouse nil
eca4927a 56 "Support for Viper special mouse-bound commands."
8626cfa2 57 :prefix "viper-"
1e70790f
MK
58 :group 'viper)
59
6c2e12f4
KH
60\f
61;;; Variables
a1506d29 62
6c2e12f4
KH
63;; Variable used for catching the switch-frame event.
64;; If non-nil, indicates that previous-frame should be the selected
3af0304a 65;; one. Used by viper-mouse-click-get-word. Not a user option.
8626cfa2 66(defvar viper-frame-of-focus nil)
a1506d29 67
6c2e12f4 68;; Frame that was selected before the switch-frame event.
8ea74b0e 69(defvar viper-current-frame-saved (selected-frame))
a1506d29 70
8626cfa2 71(defcustom viper-surrounding-word-function 'viper-surrounding-word
6c2e12f4 72 "*Function that determines what constitutes a word for clicking events.
a1506d29 73Takes two parameters: a COUNT, indicating how many words to return,
6c2e12f4 74and CLICK-COUNT, telling whether this is the first click, a double-click,
1e70790f 75or a tripple-click."
3af0304a 76 :type 'symbol
1e70790f 77 :group 'viper-mouse)
a1506d29 78
6c2e12f4
KH
79;; time interval in millisecond within which successive clicks are
80;; considered related
8626cfa2
MK
81(defcustom viper-multiclick-timeout (if (viper-window-display-p)
82 (if viper-xemacs-p
1e70790f
MK
83 mouse-track-multi-click-time
84 double-click-time)
85 500)
86 "*Time interval in millisecond within which successive mouse clicks are
87considered related."
88 :type 'integer
89 :group 'viper-mouse)
6c2e12f4
KH
90
91;; current event click count; XEmacs only
8626cfa2 92(defvar viper-current-click-count 0)
6c2e12f4 93;; time stamp of the last click event; XEmacs only
8626cfa2 94(defvar viper-last-click-event-timestamp 0)
6c2e12f4
KH
95
96;; Local variable used to toggle wraparound search on click.
8626cfa2 97(viper-deflocalvar viper-mouse-click-search-noerror t)
a1506d29 98
6c2e12f4 99;; Local variable used to delimit search after wraparound.
8626cfa2 100(viper-deflocalvar viper-mouse-click-search-limit nil)
a1506d29 101
6c2e12f4
KH
102;; remembers prefix argument to pass along to commands invoked by second
103;; click.
104;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
105;; causes Emacs to count the second click as if it was a single click
8626cfa2
MK
106(defvar viper-global-prefix-argument nil)
107
108
109;; same keys, but parsed
110(defvar viper-mouse-up-search-key-parsed nil)
111(defvar viper-mouse-down-search-key-parsed nil)
112(defvar viper-mouse-up-insert-key-parsed nil)
113(defvar viper-mouse-down-insert-key-parsed nil)
114
6c2e12f4
KH
115
116
117\f
118;;; Code
119
8626cfa2
MK
120(defsubst viper-multiclick-p ()
121 (not (viper-sit-for-short viper-multiclick-timeout t)))
95d70c42
MK
122
123;; Returns window where click occurs
328b4b70 124(defun viper-mouse-click-window (click)
50a07e18
MK
125 (let ((win (viper-cond-compile-for-xemacs-or-emacs
126 (event-window click) ; xemacs
127 (posn-window (event-start click)) ; emacs
128 )))
328b4b70
MK
129 (if (window-live-p win)
130 win
131 (error "Click was not over a live window"))))
95d70c42
MK
132
133;; Returns window where click occurs
8626cfa2
MK
134(defsubst viper-mouse-click-frame (click)
135 (window-frame (viper-mouse-click-window click)))
95d70c42
MK
136
137;; Returns the buffer of the window where click occurs
8626cfa2
MK
138(defsubst viper-mouse-click-window-buffer (click)
139 (window-buffer (viper-mouse-click-window click)))
95d70c42
MK
140
141;; Returns the name of the buffer in the window where click occurs
8626cfa2
MK
142(defsubst viper-mouse-click-window-buffer-name (click)
143 (buffer-name (viper-mouse-click-window-buffer click)))
95d70c42
MK
144
145;; Returns position of a click
8626cfa2 146(defsubst viper-mouse-click-posn (click)
50a07e18
MK
147 (viper-cond-compile-for-xemacs-or-emacs
148 (event-point click) ; xemacs
149 (posn-point (event-start click)) ; emacs
150 ))
a1506d29 151
95d70c42 152
8626cfa2 153(defun viper-surrounding-word (count click-count)
6c2e12f4
KH
154 "Returns word surrounding point according to a heuristic.
155COUNT indicates how many regions to return.
61d0d254
MK
156If CLICK-COUNT is 1, `word' is a word in Vi sense.
157If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
6c2e12f4
KH
158If the character clicked on is a non-separator and is non-alphanumeric but
159is adjacent to an alphanumeric symbol, then it is considered alphanumeric
3af0304a 160for the purpose of this command. If this character has a matching
6c2e12f4
KH
161character, such as `\(' is a match for `\)', then the matching character is
162also considered alphanumeric.
61d0d254
MK
163For convenience, in Lisp modes, `-' is considered alphanumeric.
164
165If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
3af0304a 166trailing space and tabs removed. In that case, the first argument, COUNT,
61d0d254 167is ignored."
22b63058 168 (let ((modifiers "_")
c9dd7f74 169 beg skip-flag result
a595547c 170 word-beg)
c9dd7f74 171 (if (> click-count 2)
61d0d254
MK
172 (save-excursion
173 (beginning-of-line)
8626cfa2 174 (viper-skip-all-separators-forward 'within-line)
61d0d254
MK
175 (setq beg (point))
176 (end-of-line)
c9dd7f74 177 (setq result (buffer-substring beg (point))))
a1506d29 178
8626cfa2
MK
179 (if (and (not (viper-looking-at-alphasep))
180 (or (save-excursion (viper-backward-char-carefully)
181 (viper-looking-at-alpha))
182 (save-excursion (viper-forward-char-carefully)
183 (viper-looking-at-alpha))))
a595547c 184 (setq modifiers
22b63058
KH
185 (concat modifiers
186 (cond ((looking-at "\\\\") "\\\\")
187 ((looking-at "-") "C-C-")
188 ((looking-at "[][]") "][")
189 ((looking-at "[()]") ")(")
190 ((looking-at "[{}]") "{}")
191 ((looking-at "[<>]") "<>")
192 ((looking-at "[`']") "`'")
193 ((looking-at "\\^") "\\^")
194 ((viper-looking-at-separator) "")
195 (t (char-to-string (following-char))))
196 )
a595547c 197 ))
a1506d29 198
a595547c 199 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
61d0d254
MK
200 (or (looking-at "-")
201 (not (string-match "lisp" (symbol-name major-mode)))
a595547c 202 (setq modifiers (concat modifiers "C-C-")))
a1506d29
JB
203
204
61d0d254 205 (save-excursion
8626cfa2
MK
206 (cond ((> click-count 1) (viper-skip-nonseparators 'backward))
207 ((viper-looking-at-alpha modifiers)
208 (viper-skip-alpha-backward modifiers))
209 ((not (viper-looking-at-alphasep modifiers))
210 (viper-skip-nonalphasep-backward))
a595547c 211 (t (if (> click-count 1)
8626cfa2
MK
212 (viper-skip-nonseparators 'backward)
213 (viper-skip-alpha-backward modifiers))))
a595547c 214
61d0d254 215 (setq word-beg (point))
a1506d29 216
a595547c 217 (setq skip-flag nil) ; don't move 1 char forw the first time
61d0d254 218 (while (> count 0)
8626cfa2 219 (if skip-flag (viper-forward-char-carefully 1))
a595547c
MK
220 (setq skip-flag t) ; now always move 1 char forward
221 (if (> click-count 1)
8626cfa2
MK
222 (viper-skip-nonseparators 'forward)
223 (viper-skip-alpha-forward modifiers))
61d0d254 224 (setq count (1- count)))
a595547c 225
c9dd7f74
MK
226 (setq result (buffer-substring word-beg (point))))
227 ) ; if
a595547c 228 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
c9dd7f74 229 ;; doesn't return properties together with the string, so it's not needed.
8626cfa2 230 (if viper-emacs-p
c9dd7f74
MK
231 (set-text-properties 0 (length result) nil result))
232 result
233 ))
6c2e12f4
KH
234
235
8626cfa2 236(defun viper-mouse-click-get-word (click count click-count)
6c2e12f4 237 "Returns word surrounding the position of a mouse click.
3af0304a 238Click may be in another window. Current window and buffer isn't changed.
61d0d254 239On single or double click, returns the word as determined by
8626cfa2 240`viper-surrounding-word-function'."
a1506d29 241
6c2e12f4 242 (let ((click-word "")
8626cfa2
MK
243 (click-pos (viper-mouse-click-posn click))
244 (click-buf (viper-mouse-click-window-buffer click)))
bbe6126c
MK
245 (or (natnump count) (setq count 1))
246 (or (natnump click-count) (setq click-count 1))
a1506d29 247
6c2e12f4
KH
248 (save-excursion
249 (save-window-excursion
250 (if click-pos
251 (progn
252 (set-buffer click-buf)
a1506d29 253
6c2e12f4
KH
254 (goto-char click-pos)
255 (setq click-word
8626cfa2 256 (funcall viper-surrounding-word-function count click-count)))
60370d40 257 (error "Click must be over a window"))
6c2e12f4
KH
258 click-word))))
259
6c2e12f4 260
8626cfa2 261(defun viper-mouse-click-insert-word (click arg)
6c2e12f4
KH
262 "Insert word clicked or double-clicked on.
263With prefix argument, N, insert that many words.
264This command must be bound to a mouse click.
265The double-click action of the same mouse button must not be bound
266\(or it must be bound to the same function\).
8626cfa2 267See `viper-surrounding-word' for the definition of a word in this case."
6c2e12f4 268 (interactive "e\nP")
8626cfa2
MK
269 (if viper-frame-of-focus ;; to handle clicks in another frame
270 (select-frame viper-frame-of-focus))
3af0304a
MK
271 (if (save-excursion
272 (or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
273 'viper-mouse-catch-frame-switch))
274 (not (eq (key-binding viper-mouse-up-insert-key-parsed)
275 'viper-mouse-click-insert-word))
276 (and viper-xemacs-p (not (event-over-text-area-p click)))))
96dffd25
MK
277 () ; do nothing, if binding isn't right or not over text
278 ;; turn arg into a number
279 (cond ((integerp arg) nil)
280 ;; prefix arg is a list when one hits C-u then command
281 ((and (listp arg) (integerp (car arg)))
282 (setq arg (car arg)))
283 (t (setq arg 1)))
a1506d29 284
96dffd25
MK
285 (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
286 'viper-mouse-catch-frame-switch))
287 () ; do nothing
288 (let (click-count interrupting-event)
289 (if (and
290 (viper-multiclick-p)
291 ;; This trick checks if there is a pending mouse event if so, we
292 ;; use this latter event and discard the current mouse click If
293 ;; the next pending event is not a mouse event, we execute the
294 ;; current mouse event
295 (progn
296 (setq interrupting-event (viper-read-event))
297 (viper-mouse-event-p last-input-event)))
298 (progn ; interrupted wait
299 (setq viper-global-prefix-argument arg)
300 ;; count this click for XEmacs
301 (viper-event-click-count click))
302 ;; uninterrupted wait or the interrupting event wasn't a mouse event
303 (setq click-count (viper-event-click-count click))
304 (if (> click-count 1)
305 (setq arg viper-global-prefix-argument
306 viper-global-prefix-argument nil))
307 (insert (viper-mouse-click-get-word click arg click-count))
308 (if (and interrupting-event
309 (eventp interrupting-event)
310 (not (viper-mouse-event-p interrupting-event)))
311 (viper-set-unread-command-events interrupting-event))
312 )))))
a1506d29 313
3af0304a 314;; Arg is an event. Accepts symbols and numbers, too
8626cfa2 315(defun viper-mouse-event-p (event)
6c2e12f4
KH
316 (if (eventp event)
317 (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
8626cfa2 318 (prin1-to-string (viper-event-key event)))))
a1506d29 319
3af0304a 320;; XEmacs has no double-click events. So, we must simulate.
6c2e12f4 321;; So, we have to simulate event-click-count.
8626cfa2 322(defun viper-event-click-count (click)
50a07e18
MK
323 (viper-cond-compile-for-xemacs-or-emacs
324 (viper-event-click-count-xemacs click) ; xemacs
325 (event-click-count click) ; emacs
326 ))
a1506d29 327
3af0304a
MK
328;; kind of semaphore for updating viper-current-click-count
329(defvar viper-counting-clicks-p nil)
50a07e18
MK
330(viper-cond-compile-for-xemacs-or-emacs
331 (defun viper-event-click-count-xemacs (click)
332 (let ((time-delta (- (event-timestamp click)
333 viper-last-click-event-timestamp))
334 inhibit-quit)
335 (while viper-counting-clicks-p
336 (ignore))
337 (setq viper-counting-clicks-p t)
338 (if (> time-delta viper-multiclick-timeout)
339 (setq viper-current-click-count 0))
340 (discard-input)
341 (setq viper-current-click-count (1+ viper-current-click-count)
342 viper-last-click-event-timestamp (event-timestamp click))
343 (setq viper-counting-clicks-p nil)
344 (if (viper-sit-for-short viper-multiclick-timeout t)
345 viper-current-click-count
346 0)
347 ))
348 nil ; emacs
349 )
a1506d29 350
6c2e12f4 351
8626cfa2 352(defun viper-mouse-click-search-word (click arg)
3af0304a 353 "Find the word clicked or double-clicked on. Word may be in another window.
6c2e12f4 354With prefix argument, N, search for N-th occurrence.
3af0304a 355This command must be bound to a mouse click. The double-click action of the
6c2e12f4 356same button must not be bound \(or it must be bound to the same function\).
8626cfa2 357See `viper-surrounding-word' for the details on what constitutes a word for
6c2e12f4
KH
358this command."
359 (interactive "e\nP")
8626cfa2
MK
360 (if viper-frame-of-focus ;; to handle clicks in another frame
361 (select-frame viper-frame-of-focus))
3af0304a
MK
362 (if (save-excursion
363 (or (not (eq (key-binding viper-mouse-down-search-key-parsed)
364 'viper-mouse-catch-frame-switch))
365 (not (eq (key-binding viper-mouse-up-search-key-parsed)
366 'viper-mouse-click-search-word))
367 (and viper-xemacs-p (not (event-over-text-area-p click)))))
96dffd25 368 () ; do nothing, if binding isn't right or not over text
8626cfa2
MK
369 (let ((previous-search-string viper-s-string)
370 click-word click-count)
a1506d29 371
8626cfa2
MK
372 (if (and
373 (viper-multiclick-p)
374 ;; This trick checks if there is a pending mouse event if so, we use
375 ;; this latter event and discard the current mouse click If the next
376 ;; pending event is not a mouse event, we execute the current mouse
377 ;; event
378 (progn
379 (viper-read-event)
380 (viper-mouse-event-p last-input-event)))
381 (progn ; interrupted wait
3af0304a
MK
382 (setq viper-global-prefix-argument (or viper-global-prefix-argument
383 arg)
384 ;; remember command that was before the multiclick
385 this-command last-command)
8626cfa2
MK
386 ;; make sure we counted this event---needed for XEmacs only
387 (viper-event-click-count click))
388 ;; uninterrupted wait
389 (setq click-count (viper-event-click-count click))
390 (setq click-word (viper-mouse-click-get-word click nil click-count))
a1506d29 391
8626cfa2
MK
392 (if (> click-count 1)
393 (setq arg viper-global-prefix-argument
394 viper-global-prefix-argument nil))
395 (setq arg (or arg 1))
a1506d29 396
8626cfa2
MK
397 (viper-deactivate-mark)
398 (if (or (not (string= click-word viper-s-string))
399 (not (markerp viper-search-start-marker))
400 (not (equal (marker-buffer viper-search-start-marker)
401 (current-buffer)))
402 (not (eq last-command 'viper-mouse-click-search-word)))
6c2e12f4 403 (progn
8626cfa2
MK
404 (setq viper-search-start-marker (point-marker)
405 viper-local-search-start-marker viper-search-start-marker
406 viper-mouse-click-search-noerror t
407 viper-mouse-click-search-limit nil)
a1506d29 408
8626cfa2
MK
409 ;; make search string known to Viper
410 (setq viper-s-string (if viper-re-search
411 (regexp-quote click-word)
412 click-word))
413 (if (not (string= viper-s-string (car viper-search-history)))
414 (setq viper-search-history
415 (cons viper-s-string viper-search-history)))
416 ))
a1506d29 417
8626cfa2
MK
418 (push-mark nil t)
419 (while (> arg 0)
420 (viper-forward-word 1)
421 (condition-case nil
422 (progn
423 (if (not (search-forward
424 click-word viper-mouse-click-search-limit
425 viper-mouse-click-search-noerror))
426 (progn
427 (setq viper-mouse-click-search-noerror nil)
428 (setq viper-mouse-click-search-limit
429 (save-excursion
430 (if (and
431 (markerp viper-local-search-start-marker)
432 (marker-buffer viper-local-search-start-marker))
433 (goto-char viper-local-search-start-marker))
434 (viper-line-pos 'end)))
a1506d29 435
8626cfa2
MK
436 (goto-char (point-min))
437 (search-forward click-word
438 viper-mouse-click-search-limit nil)))
439 (goto-char (match-beginning 0))
440 (message "Searching for: %s" viper-s-string)
441 (if (<= arg 1) ; found the right occurrence of the pattern
442 (progn
443 (viper-adjust-window)
444 (viper-flash-search-pattern)))
445 )
446 (error (beep 1)
447 (if (or (not (string= click-word previous-search-string))
448 (not (eq last-command 'viper-mouse-click-search-word)))
449 (message "`%s': String not found in %s"
450 viper-s-string (buffer-name (current-buffer)))
451 (message
3af0304a 452 "`%s': Last occurrence in %s. Back to beginning of search"
8626cfa2
MK
453 click-word (buffer-name (current-buffer)))
454 (setq arg 1) ;; to terminate the loop
455 (sit-for 2))
a1506d29 456 (setq viper-mouse-click-search-noerror t)
8626cfa2
MK
457 (setq viper-mouse-click-search-limit nil)
458 (if (and (markerp viper-local-search-start-marker)
459 (marker-buffer viper-local-search-start-marker))
460 (goto-char viper-local-search-start-marker))))
461 (setq arg (1- arg)))
462 ))))
a1506d29 463
8626cfa2 464(defun viper-mouse-catch-frame-switch (event arg)
6c2e12f4 465 "Catch the event of switching frame.
3af0304a 466Usually is bound to a `down-mouse' event to work properly. See sample
d5e52f99 467bindings in the Viper manual."
6c2e12f4 468 (interactive "e\nP")
8626cfa2
MK
469 (setq viper-frame-of-focus nil)
470 ;; pass prefix arg along to viper-mouse-click-search/insert-word
6c2e12f4
KH
471 (setq prefix-arg arg)
472 (if (eq last-command 'handle-switch-frame)
8626cfa2
MK
473 (setq viper-frame-of-focus viper-current-frame-saved))
474 ;; make Emacs forget that it executed viper-mouse-catch-frame-switch
6c2e12f4 475 (setq this-command last-command))
a1506d29 476
3af0304a 477;; Called just before switching frames. Saves the old selected frame.
6c2e12f4 478;; Sets last-command to handle-switch-frame (this is done automatically in
a1506d29 479;; Emacs.
6c2e12f4
KH
480;; The semantics of switching frames is different in Emacs and XEmacs.
481;; In Emacs, if you select-frame A while mouse is over frame B and then
482;; start typing, input goes to frame B, which becomes selected.
3af0304a 483;; In XEmacs, input will go to frame A. This may be a bug in one of the
6c2e12f4
KH
484;; Emacsen, but also may be a design decision.
485;; Also, in Emacs sending input to frame B generates handle-switch-frame
486;; event, while in XEmacs it doesn't.
487;; All this accounts for the difference in the behavior of
8626cfa2 488;; viper-mouse-click-* commands when you click in a frame other than the one
3af0304a 489;; that was the last to receive input. In Emacs, focus will be in frame A
8626cfa2 490;; until you do something other than viper-mouse-click-* command.
6c2e12f4
KH
491;; In XEmacs, you have to manually select frame B (with the mouse click) in
492;; order to shift focus to frame B.
8626cfa2 493(defsubst viper-remember-current-frame (frame)
546fe085 494 (setq last-command 'handle-switch-frame
8626cfa2
MK
495 viper-current-frame-saved (selected-frame)))
496
497
498;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
499;; Converts into a valid mouse button spec for the appropriate version of
3af0304a 500;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
8626cfa2
MK
501;; returns button-down key.
502(defun viper-parse-mouse-key (key-var event-type)
503 (let ((key (eval key-var))
504 button-spec meta-spec shift-spec control-spec key-spec)
505 (if (null key)
506 ;; just return nil
507 ()
508 (setq button-spec
509 (cond ((memq 1 key)
510 (if viper-emacs-p
511 (if (eq 'up event-type)
512 "mouse-1" "down-mouse-1")
513 (if (eq 'up event-type)
514 'button1up 'button1)))
515 ((memq 2 key)
516 (if viper-emacs-p
517 (if (eq 'up event-type)
518 "mouse-2" "down-mouse-2")
519 (if (eq 'up event-type)
520 'button2up 'button2)))
521 ((memq 3 key)
522 (if viper-emacs-p
523 (if (eq 'up event-type)
524 "mouse-3" "down-mouse-3")
525 (if (eq 'up event-type)
526 'button3up 'button3)))
527 (t (error
528 "%S: invalid button number, %S" key-var key)))
529 meta-spec
530 (if (memq 'meta key)
531 (if viper-emacs-p "M-" 'meta)
532 (if viper-emacs-p "" nil))
533 shift-spec
534 (if (memq 'shift key)
535 (if viper-emacs-p "S-" 'shift)
536 (if viper-emacs-p "" nil))
537 control-spec
538 (if (memq 'control key)
539 (if viper-emacs-p "C-" 'control)
540 (if viper-emacs-p "" nil)))
541
542 (setq key-spec (if viper-emacs-p
543 (vector
544 (intern
545 (concat
546 control-spec meta-spec shift-spec button-spec)))
547 (vector
548 (delq
549 nil
550 (list
551 control-spec meta-spec shift-spec button-spec)))))
552 )))
553
554(defun viper-unbind-mouse-search-key ()
555 (if viper-mouse-up-search-key-parsed
556 (global-unset-key viper-mouse-up-search-key-parsed))
557 (if viper-mouse-down-search-key-parsed
558 (global-unset-key viper-mouse-down-search-key-parsed))
559 (setq viper-mouse-up-search-key-parsed nil
560 viper-mouse-down-search-key-parsed nil))
561
562(defun viper-unbind-mouse-insert-key ()
563 (if viper-mouse-up-insert-key-parsed
564 (global-unset-key viper-mouse-up-insert-key-parsed))
565 (if viper-mouse-down-insert-key-parsed
566 (global-unset-key viper-mouse-down-insert-key-parsed))
567 (setq viper-mouse-up-insert-key-parsed nil
568 viper-mouse-down-insert-key-parsed nil))
569
570;; If FORCE, bind even if this mouse action is already bound to something else
571(defun viper-bind-mouse-search-key (&optional force)
572 (setq viper-mouse-up-search-key-parsed
573 (viper-parse-mouse-key 'viper-mouse-search-key 'up)
574 viper-mouse-down-search-key-parsed
575 (viper-parse-mouse-key 'viper-mouse-search-key 'down))
576 (cond ((or (null viper-mouse-up-search-key-parsed)
577 (null viper-mouse-down-search-key-parsed))
578 nil) ; just quit
a1506d29 579 ((and (null force)
8626cfa2
MK
580 (key-binding viper-mouse-up-search-key-parsed)
581 (not (eq (key-binding viper-mouse-up-search-key-parsed)
582 'viper-mouse-click-search-word)))
a1506d29 583 (message
3af0304a 584 "%S already bound to a mouse event. Viper mouse-search feature disabled"
8626cfa2 585 viper-mouse-up-search-key-parsed))
a1506d29 586 ((and (null force)
8626cfa2
MK
587 (key-binding viper-mouse-down-search-key-parsed)
588 (not (eq (key-binding viper-mouse-down-search-key-parsed)
589 'viper-mouse-catch-frame-switch)))
590 (message
3af0304a 591 "%S already bound to a mouse event. Viper mouse-search feature disabled"
8626cfa2 592 viper-mouse-down-search-key-parsed))
a1506d29 593 (t
8626cfa2
MK
594 (global-set-key viper-mouse-up-search-key-parsed
595 'viper-mouse-click-search-word)
596 (global-set-key viper-mouse-down-search-key-parsed
597 'viper-mouse-catch-frame-switch))))
598
599;; If FORCE, bind even if this mouse action is already bound to something else
600(defun viper-bind-mouse-insert-key (&optional force)
601 (setq viper-mouse-up-insert-key-parsed
602 (viper-parse-mouse-key 'viper-mouse-insert-key 'up)
603 viper-mouse-down-insert-key-parsed
604 (viper-parse-mouse-key 'viper-mouse-insert-key 'down))
605 (cond ((or (null viper-mouse-up-insert-key-parsed)
606 (null viper-mouse-down-insert-key-parsed))
607 nil) ; just quit
608 ((and (null force)
609 (key-binding viper-mouse-up-insert-key-parsed)
610 (not (eq (key-binding viper-mouse-up-insert-key-parsed)
611 'viper-mouse-click-insert-word)))
a1506d29 612 (message
3af0304a 613 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
8626cfa2
MK
614 viper-mouse-up-insert-key-parsed))
615 ((and (null force)
616 (key-binding viper-mouse-down-insert-key-parsed)
617 (not (eq (key-binding viper-mouse-down-insert-key-parsed)
618 'viper-mouse-catch-frame-switch)))
619 (message
3af0304a 620 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
8626cfa2 621 viper-mouse-down-insert-key-parsed))
a1506d29 622 (t
8626cfa2
MK
623 (global-set-key viper-mouse-up-insert-key-parsed
624 'viper-mouse-click-insert-word)
625 (global-set-key viper-mouse-down-insert-key-parsed
626 'viper-mouse-catch-frame-switch))))
627
628(defun viper-reset-mouse-search-key (symb val)
629 (viper-unbind-mouse-search-key)
630 (set symb val)
631 (viper-bind-mouse-search-key 'force))
632
633(defun viper-reset-mouse-insert-key (symb val)
634 (viper-unbind-mouse-insert-key)
635 (set symb val)
636 (viper-bind-mouse-insert-key 'force))
637
638
639(defcustom viper-mouse-search-key '(meta shift 1)
640 "*Key used to click-search in Viper.
a27f97ee
RS
641This must be a list that specifies the mouse button and modifiers.
642The supported modifiers are `meta', `shift', and `control'.
643For instance, `(meta shift 1)' means that holding the meta and shift
644keys down and clicking on a word with mouse button 1
645will search for that word in the buffer that was current before the click.
646This buffer may be different from the one where the click occurred."
f0f90cfd
RS
647 :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
648 (const :format "%v " meta)
649 (const :format "%v " shift)
650 (const control))
651 (integer :tag "Button"))
8626cfa2
MK
652 :set 'viper-reset-mouse-search-key
653 :group 'viper-mouse)
654
655(defcustom viper-mouse-insert-key '(meta shift 2)
656 "*Key used to click-insert in Viper.
a27f97ee
RS
657Must be a list that specifies the mouse button and modifiers.
658The supported modifiers are `meta', `shift', and `control'.
659For instance, `(meta shift 2)' means that holding the meta and shift keys
660down, and clicking on a word with mouse button 2, will insert that word
661at the cursor in the buffer that was current just before the click.
662This buffer may be different from the one where the click occurred."
f0f90cfd
RS
663 :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
664 (const :format "%v " meta)
665 (const :format "%v " shift)
666 (const control))
667 (integer :tag "Button"))
8626cfa2
MK
668 :set 'viper-reset-mouse-insert-key
669 :group 'viper-mouse)
a1506d29 670
6c2e12f4
KH
671
672
1e70790f 673;;; Local Variables:
8626cfa2 674;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
1e70790f
MK
675;;; End:
676
6c2e12f4 677
ab5796a9 678;;; arch-tag: e56b2390-06c4-4dd1-96f5-c7876e2d8c2f
60370d40 679;;; viper-mous.el ends here