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