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