58 |
|
|
59 |
|
|
60 |
;;; Variables |
;;; Variables |
61 |
|
|
62 |
;; Variable used for catching the switch-frame event. |
;; Variable used for catching the switch-frame event. |
63 |
;; If non-nil, indicates that previous-frame should be the selected |
;; If non-nil, indicates that previous-frame should be the selected |
64 |
;; one. Used by viper-mouse-click-get-word. Not a user option. |
;; one. Used by viper-mouse-click-get-word. Not a user option. |
65 |
(defvar viper-frame-of-focus nil) |
(defvar viper-frame-of-focus nil) |
66 |
|
|
67 |
;; Frame that was selected before the switch-frame event. |
;; Frame that was selected before the switch-frame event. |
68 |
(defconst viper-current-frame-saved (selected-frame)) |
(defconst viper-current-frame-saved (selected-frame)) |
69 |
|
|
70 |
(defcustom viper-surrounding-word-function 'viper-surrounding-word |
(defcustom viper-surrounding-word-function 'viper-surrounding-word |
71 |
"*Function that determines what constitutes a word for clicking events. |
"*Function that determines what constitutes a word for clicking events. |
72 |
Takes two parameters: a COUNT, indicating how many words to return, |
Takes two parameters: a COUNT, indicating how many words to return, |
73 |
and CLICK-COUNT, telling whether this is the first click, a double-click, |
and CLICK-COUNT, telling whether this is the first click, a double-click, |
74 |
or a tripple-click." |
or a tripple-click." |
75 |
:type 'symbol |
:type 'symbol |
76 |
:group 'viper-mouse) |
:group 'viper-mouse) |
77 |
|
|
78 |
;; time interval in millisecond within which successive clicks are |
;; time interval in millisecond within which successive clicks are |
79 |
;; considered related |
;; considered related |
80 |
(defcustom viper-multiclick-timeout (if (viper-window-display-p) |
(defcustom viper-multiclick-timeout (if (viper-window-display-p) |
94 |
|
|
95 |
;; Local variable used to toggle wraparound search on click. |
;; Local variable used to toggle wraparound search on click. |
96 |
(viper-deflocalvar viper-mouse-click-search-noerror t) |
(viper-deflocalvar viper-mouse-click-search-noerror t) |
97 |
|
|
98 |
;; Local variable used to delimit search after wraparound. |
;; Local variable used to delimit search after wraparound. |
99 |
(viper-deflocalvar viper-mouse-click-search-limit nil) |
(viper-deflocalvar viper-mouse-click-search-limit nil) |
100 |
|
|
101 |
;; remembers prefix argument to pass along to commands invoked by second |
;; remembers prefix argument to pass along to commands invoked by second |
102 |
;; click. |
;; click. |
103 |
;; This is needed because in Emacs (not XEmacs), assigning to preix-arg |
;; This is needed because in Emacs (not XEmacs), assigning to preix-arg |
147 |
(event-point click) ; xemacs |
(event-point click) ; xemacs |
148 |
(posn-point (event-start click)) ; emacs |
(posn-point (event-start click)) ; emacs |
149 |
)) |
)) |
150 |
|
|
151 |
|
|
152 |
(defun viper-surrounding-word (count click-count) |
(defun viper-surrounding-word (count click-count) |
153 |
"Returns word surrounding point according to a heuristic. |
"Returns word surrounding point according to a heuristic. |
174 |
(setq beg (point)) |
(setq beg (point)) |
175 |
(end-of-line) |
(end-of-line) |
176 |
(setq result (buffer-substring beg (point)))) |
(setq result (buffer-substring beg (point)))) |
177 |
|
|
178 |
(if (and (not (viper-looking-at-alphasep)) |
(if (and (not (viper-looking-at-alphasep)) |
179 |
(or (save-excursion (viper-backward-char-carefully) |
(or (save-excursion (viper-backward-char-carefully) |
180 |
(viper-looking-at-alpha)) |
(viper-looking-at-alpha)) |
194 |
(t (char-to-string (following-char)))) |
(t (char-to-string (following-char)))) |
195 |
) |
) |
196 |
)) |
)) |
197 |
|
|
198 |
;; Add `-' to alphanum, if it wasn't added and if we are in Lisp |
;; Add `-' to alphanum, if it wasn't added and if we are in Lisp |
199 |
(or (looking-at "-") |
(or (looking-at "-") |
200 |
(not (string-match "lisp" (symbol-name major-mode))) |
(not (string-match "lisp" (symbol-name major-mode))) |
201 |
(setq modifiers (concat modifiers "C-C-"))) |
(setq modifiers (concat modifiers "C-C-"))) |
202 |
|
|
203 |
|
|
204 |
(save-excursion |
(save-excursion |
205 |
(cond ((> click-count 1) (viper-skip-nonseparators 'backward)) |
(cond ((> click-count 1) (viper-skip-nonseparators 'backward)) |
206 |
((viper-looking-at-alpha modifiers) |
((viper-looking-at-alpha modifiers) |
212 |
(viper-skip-alpha-backward modifiers)))) |
(viper-skip-alpha-backward modifiers)))) |
213 |
|
|
214 |
(setq word-beg (point)) |
(setq word-beg (point)) |
215 |
|
|
216 |
(setq skip-flag nil) ; don't move 1 char forw the first time |
(setq skip-flag nil) ; don't move 1 char forw the first time |
217 |
(while (> count 0) |
(while (> count 0) |
218 |
(if skip-flag (viper-forward-char-carefully 1)) |
(if skip-flag (viper-forward-char-carefully 1)) |
237 |
Click may be in another window. Current window and buffer isn't changed. |
Click may be in another window. Current window and buffer isn't changed. |
238 |
On single or double click, returns the word as determined by |
On single or double click, returns the word as determined by |
239 |
`viper-surrounding-word-function'." |
`viper-surrounding-word-function'." |
240 |
|
|
241 |
(let ((click-word "") |
(let ((click-word "") |
242 |
(click-pos (viper-mouse-click-posn click)) |
(click-pos (viper-mouse-click-posn click)) |
243 |
(click-buf (viper-mouse-click-window-buffer click))) |
(click-buf (viper-mouse-click-window-buffer click))) |
244 |
(or (natnump count) (setq count 1)) |
(or (natnump count) (setq count 1)) |
245 |
(or (natnump click-count) (setq click-count 1)) |
(or (natnump click-count) (setq click-count 1)) |
246 |
|
|
247 |
(save-excursion |
(save-excursion |
248 |
(save-window-excursion |
(save-window-excursion |
249 |
(if click-pos |
(if click-pos |
250 |
(progn |
(progn |
251 |
(set-buffer click-buf) |
(set-buffer click-buf) |
252 |
|
|
253 |
(goto-char click-pos) |
(goto-char click-pos) |
254 |
(setq click-word |
(setq click-word |
255 |
(funcall viper-surrounding-word-function count click-count))) |
(funcall viper-surrounding-word-function count click-count))) |
280 |
((and (listp arg) (integerp (car arg))) |
((and (listp arg) (integerp (car arg))) |
281 |
(setq arg (car arg))) |
(setq arg (car arg))) |
282 |
(t (setq arg 1))) |
(t (setq arg 1))) |
283 |
|
|
284 |
(if (not (eq (key-binding viper-mouse-down-insert-key-parsed) |
(if (not (eq (key-binding viper-mouse-down-insert-key-parsed) |
285 |
'viper-mouse-catch-frame-switch)) |
'viper-mouse-catch-frame-switch)) |
286 |
() ; do nothing |
() ; do nothing |
309 |
(not (viper-mouse-event-p interrupting-event))) |
(not (viper-mouse-event-p interrupting-event))) |
310 |
(viper-set-unread-command-events interrupting-event)) |
(viper-set-unread-command-events interrupting-event)) |
311 |
))))) |
))))) |
312 |
|
|
313 |
;; Arg is an event. Accepts symbols and numbers, too |
;; Arg is an event. Accepts symbols and numbers, too |
314 |
(defun viper-mouse-event-p (event) |
(defun viper-mouse-event-p (event) |
315 |
(if (eventp event) |
(if (eventp event) |
316 |
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)" |
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)" |
317 |
(prin1-to-string (viper-event-key event))))) |
(prin1-to-string (viper-event-key event))))) |
318 |
|
|
319 |
;; XEmacs has no double-click events. So, we must simulate. |
;; XEmacs has no double-click events. So, we must simulate. |
320 |
;; So, we have to simulate event-click-count. |
;; So, we have to simulate event-click-count. |
321 |
(defun viper-event-click-count (click) |
(defun viper-event-click-count (click) |
323 |
(viper-event-click-count-xemacs click) ; xemacs |
(viper-event-click-count-xemacs click) ; xemacs |
324 |
(event-click-count click) ; emacs |
(event-click-count click) ; emacs |
325 |
)) |
)) |
326 |
|
|
327 |
;; kind of semaphore for updating viper-current-click-count |
;; kind of semaphore for updating viper-current-click-count |
328 |
(defvar viper-counting-clicks-p nil) |
(defvar viper-counting-clicks-p nil) |
329 |
(viper-cond-compile-for-xemacs-or-emacs |
(viper-cond-compile-for-xemacs-or-emacs |
346 |
)) |
)) |
347 |
nil ; emacs |
nil ; emacs |
348 |
) |
) |
349 |
|
|
350 |
|
|
351 |
(defun viper-mouse-click-search-word (click arg) |
(defun viper-mouse-click-search-word (click arg) |
352 |
"Find the word clicked or double-clicked on. Word may be in another window. |
"Find the word clicked or double-clicked on. Word may be in another window. |
367 |
() ; do nothing, if binding isn't right or not over text |
() ; do nothing, if binding isn't right or not over text |
368 |
(let ((previous-search-string viper-s-string) |
(let ((previous-search-string viper-s-string) |
369 |
click-word click-count) |
click-word click-count) |
370 |
|
|
371 |
(if (and |
(if (and |
372 |
(viper-multiclick-p) |
(viper-multiclick-p) |
373 |
;; This trick checks if there is a pending mouse event if so, we use |
;; This trick checks if there is a pending mouse event if so, we use |
387 |
;; uninterrupted wait |
;; uninterrupted wait |
388 |
(setq click-count (viper-event-click-count click)) |
(setq click-count (viper-event-click-count click)) |
389 |
(setq click-word (viper-mouse-click-get-word click nil click-count)) |
(setq click-word (viper-mouse-click-get-word click nil click-count)) |
390 |
|
|
391 |
(if (> click-count 1) |
(if (> click-count 1) |
392 |
(setq arg viper-global-prefix-argument |
(setq arg viper-global-prefix-argument |
393 |
viper-global-prefix-argument nil)) |
viper-global-prefix-argument nil)) |
394 |
(setq arg (or arg 1)) |
(setq arg (or arg 1)) |
395 |
|
|
396 |
(viper-deactivate-mark) |
(viper-deactivate-mark) |
397 |
(if (or (not (string= click-word viper-s-string)) |
(if (or (not (string= click-word viper-s-string)) |
398 |
(not (markerp viper-search-start-marker)) |
(not (markerp viper-search-start-marker)) |
404 |
viper-local-search-start-marker viper-search-start-marker |
viper-local-search-start-marker viper-search-start-marker |
405 |
viper-mouse-click-search-noerror t |
viper-mouse-click-search-noerror t |
406 |
viper-mouse-click-search-limit nil) |
viper-mouse-click-search-limit nil) |
407 |
|
|
408 |
;; make search string known to Viper |
;; make search string known to Viper |
409 |
(setq viper-s-string (if viper-re-search |
(setq viper-s-string (if viper-re-search |
410 |
(regexp-quote click-word) |
(regexp-quote click-word) |
413 |
(setq viper-search-history |
(setq viper-search-history |
414 |
(cons viper-s-string viper-search-history))) |
(cons viper-s-string viper-search-history))) |
415 |
)) |
)) |
416 |
|
|
417 |
(push-mark nil t) |
(push-mark nil t) |
418 |
(while (> arg 0) |
(while (> arg 0) |
419 |
(viper-forward-word 1) |
(viper-forward-word 1) |
431 |
(marker-buffer viper-local-search-start-marker)) |
(marker-buffer viper-local-search-start-marker)) |
432 |
(goto-char viper-local-search-start-marker)) |
(goto-char viper-local-search-start-marker)) |
433 |
(viper-line-pos 'end))) |
(viper-line-pos 'end))) |
434 |
|
|
435 |
(goto-char (point-min)) |
(goto-char (point-min)) |
436 |
(search-forward click-word |
(search-forward click-word |
437 |
viper-mouse-click-search-limit nil))) |
viper-mouse-click-search-limit nil))) |
452 |
click-word (buffer-name (current-buffer))) |
click-word (buffer-name (current-buffer))) |
453 |
(setq arg 1) ;; to terminate the loop |
(setq arg 1) ;; to terminate the loop |
454 |
(sit-for 2)) |
(sit-for 2)) |
455 |
(setq viper-mouse-click-search-noerror t) |
(setq viper-mouse-click-search-noerror t) |
456 |
(setq viper-mouse-click-search-limit nil) |
(setq viper-mouse-click-search-limit nil) |
457 |
(if (and (markerp viper-local-search-start-marker) |
(if (and (markerp viper-local-search-start-marker) |
458 |
(marker-buffer viper-local-search-start-marker)) |
(marker-buffer viper-local-search-start-marker)) |
459 |
(goto-char viper-local-search-start-marker)))) |
(goto-char viper-local-search-start-marker)))) |
460 |
(setq arg (1- arg))) |
(setq arg (1- arg))) |
461 |
)))) |
)))) |
462 |
|
|
463 |
(defun viper-mouse-catch-frame-switch (event arg) |
(defun viper-mouse-catch-frame-switch (event arg) |
464 |
"Catch the event of switching frame. |
"Catch the event of switching frame. |
465 |
Usually is bound to a `down-mouse' event to work properly. See sample |
Usually is bound to a `down-mouse' event to work properly. See sample |
472 |
(setq viper-frame-of-focus viper-current-frame-saved)) |
(setq viper-frame-of-focus viper-current-frame-saved)) |
473 |
;; make Emacs forget that it executed viper-mouse-catch-frame-switch |
;; make Emacs forget that it executed viper-mouse-catch-frame-switch |
474 |
(setq this-command last-command)) |
(setq this-command last-command)) |
475 |
|
|
476 |
;; Called just before switching frames. Saves the old selected frame. |
;; Called just before switching frames. Saves the old selected frame. |
477 |
;; Sets last-command to handle-switch-frame (this is done automatically in |
;; Sets last-command to handle-switch-frame (this is done automatically in |
478 |
;; Emacs. |
;; Emacs. |
479 |
;; The semantics of switching frames is different in Emacs and XEmacs. |
;; The semantics of switching frames is different in Emacs and XEmacs. |
480 |
;; In Emacs, if you select-frame A while mouse is over frame B and then |
;; In Emacs, if you select-frame A while mouse is over frame B and then |
481 |
;; start typing, input goes to frame B, which becomes selected. |
;; start typing, input goes to frame B, which becomes selected. |
575 |
(cond ((or (null viper-mouse-up-search-key-parsed) |
(cond ((or (null viper-mouse-up-search-key-parsed) |
576 |
(null viper-mouse-down-search-key-parsed)) |
(null viper-mouse-down-search-key-parsed)) |
577 |
nil) ; just quit |
nil) ; just quit |
578 |
((and (null force) |
((and (null force) |
579 |
(key-binding viper-mouse-up-search-key-parsed) |
(key-binding viper-mouse-up-search-key-parsed) |
580 |
(not (eq (key-binding viper-mouse-up-search-key-parsed) |
(not (eq (key-binding viper-mouse-up-search-key-parsed) |
581 |
'viper-mouse-click-search-word))) |
'viper-mouse-click-search-word))) |
582 |
(message |
(message |
583 |
"%S already bound to a mouse event. Viper mouse-search feature disabled" |
"%S already bound to a mouse event. Viper mouse-search feature disabled" |
584 |
viper-mouse-up-search-key-parsed)) |
viper-mouse-up-search-key-parsed)) |
585 |
((and (null force) |
((and (null force) |
586 |
(key-binding viper-mouse-down-search-key-parsed) |
(key-binding viper-mouse-down-search-key-parsed) |
587 |
(not (eq (key-binding viper-mouse-down-search-key-parsed) |
(not (eq (key-binding viper-mouse-down-search-key-parsed) |
588 |
'viper-mouse-catch-frame-switch))) |
'viper-mouse-catch-frame-switch))) |
589 |
(message |
(message |
590 |
"%S already bound to a mouse event. Viper mouse-search feature disabled" |
"%S already bound to a mouse event. Viper mouse-search feature disabled" |
591 |
viper-mouse-down-search-key-parsed)) |
viper-mouse-down-search-key-parsed)) |
592 |
(t |
(t |
593 |
(global-set-key viper-mouse-up-search-key-parsed |
(global-set-key viper-mouse-up-search-key-parsed |
594 |
'viper-mouse-click-search-word) |
'viper-mouse-click-search-word) |
595 |
(global-set-key viper-mouse-down-search-key-parsed |
(global-set-key viper-mouse-down-search-key-parsed |
608 |
(key-binding viper-mouse-up-insert-key-parsed) |
(key-binding viper-mouse-up-insert-key-parsed) |
609 |
(not (eq (key-binding viper-mouse-up-insert-key-parsed) |
(not (eq (key-binding viper-mouse-up-insert-key-parsed) |
610 |
'viper-mouse-click-insert-word))) |
'viper-mouse-click-insert-word))) |
611 |
(message |
(message |
612 |
"%S already bound to a mouse event. Viper mouse-insert feature disabled" |
"%S already bound to a mouse event. Viper mouse-insert feature disabled" |
613 |
viper-mouse-up-insert-key-parsed)) |
viper-mouse-up-insert-key-parsed)) |
614 |
((and (null force) |
((and (null force) |
618 |
(message |
(message |
619 |
"%S already bound to a mouse event. Viper mouse-insert feature disabled" |
"%S already bound to a mouse event. Viper mouse-insert feature disabled" |
620 |
viper-mouse-down-insert-key-parsed)) |
viper-mouse-down-insert-key-parsed)) |
621 |
(t |
(t |
622 |
(global-set-key viper-mouse-up-insert-key-parsed |
(global-set-key viper-mouse-up-insert-key-parsed |
623 |
'viper-mouse-click-insert-word) |
'viper-mouse-click-insert-word) |
624 |
(global-set-key viper-mouse-down-insert-key-parsed |
(global-set-key viper-mouse-down-insert-key-parsed |
666 |
(integer :tag "Button")) |
(integer :tag "Button")) |
667 |
:set 'viper-reset-mouse-insert-key |
:set 'viper-reset-mouse-insert-key |
668 |
:group 'viper-mouse) |
:group 'viper-mouse) |
669 |
|
|
670 |
|
|
671 |
|
|
672 |
;;; Local Variables: |
;;; Local Variables: |