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