;;; viper-mous.el --- mouse support for Viper
-;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
+
+;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
-;; Code
+;;; Code:
(provide 'viper-mous)
(defgroup viper-mouse nil
- "Support for Viper special mouse-bound commands"
+ "Support for Viper special mouse-bound commands."
:prefix "viper-"
:group 'viper)
\f
;;; Variables
-
+
;; Variable used for catching the switch-frame event.
;; If non-nil, indicates that previous-frame should be the selected
-;; one. Used by viper-mouse-click-get-word. Not a user option.
+;; one. Used by viper-mouse-click-get-word. Not a user option.
(defvar viper-frame-of-focus nil)
-
+
;; Frame that was selected before the switch-frame event.
-(defconst viper-current-frame-saved (selected-frame))
-
+(defvar viper-current-frame-saved (selected-frame))
+
(defcustom viper-surrounding-word-function 'viper-surrounding-word
"*Function that determines what constitutes a word for clicking events.
-Takes two parameters: a COUNT, indicating how many words to return,
+Takes two parameters: a COUNT, indicating how many words to return,
and CLICK-COUNT, telling whether this is the first click, a double-click,
or a tripple-click."
- :type 'boolean
+ :type 'symbol
:group 'viper-mouse)
-
+
;; time interval in millisecond within which successive clicks are
;; considered related
(defcustom viper-multiclick-timeout (if (viper-window-display-p)
;; Local variable used to toggle wraparound search on click.
(viper-deflocalvar viper-mouse-click-search-noerror t)
-
+
;; Local variable used to delimit search after wraparound.
(viper-deflocalvar viper-mouse-click-search-limit nil)
-
+
;; remembers prefix argument to pass along to commands invoked by second
;; click.
;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
(not (viper-sit-for-short viper-multiclick-timeout t)))
;; Returns window where click occurs
-(defsubst viper-mouse-click-window (click)
- (if viper-xemacs-p
- (event-window click)
- (posn-window (event-start click))))
+(defun viper-mouse-click-window (click)
+ (let ((win (viper-cond-compile-for-xemacs-or-emacs
+ (event-window click) ; xemacs
+ (posn-window (event-start click)) ; emacs
+ )))
+ (if (window-live-p win)
+ win
+ (error "Click was not over a live window"))))
;; Returns window where click occurs
(defsubst viper-mouse-click-frame (click)
;; Returns position of a click
(defsubst viper-mouse-click-posn (click)
- (if viper-xemacs-p
- (event-point click)
- (posn-point (event-start click))))
-
+ (viper-cond-compile-for-xemacs-or-emacs
+ (event-point click) ; xemacs
+ (posn-point (event-start click)) ; emacs
+ ))
+
(defun viper-surrounding-word (count click-count)
"Returns word surrounding point according to a heuristic.
If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
If the character clicked on is a non-separator and is non-alphanumeric but
is adjacent to an alphanumeric symbol, then it is considered alphanumeric
-for the purpose of this command. If this character has a matching
+for the purpose of this command. If this character has a matching
character, such as `\(' is a match for `\)', then the matching character is
also considered alphanumeric.
For convenience, in Lisp modes, `-' is considered alphanumeric.
If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
-trailing space and tabs removed. In that case, the first argument, COUNT,
+trailing space and tabs removed. In that case, the first argument, COUNT,
is ignored."
- (let ((modifiers "")
+ (let ((modifiers "_")
beg skip-flag result
word-beg)
(if (> click-count 2)
(setq beg (point))
(end-of-line)
(setq result (buffer-substring beg (point))))
-
+
(if (and (not (viper-looking-at-alphasep))
(or (save-excursion (viper-backward-char-carefully)
(viper-looking-at-alpha))
(save-excursion (viper-forward-char-carefully)
(viper-looking-at-alpha))))
(setq modifiers
- (cond ((looking-at "\\\\") "\\\\")
- ((looking-at "-") "C-C-")
- ((looking-at "[][]") "][")
- ((looking-at "[()]") ")(")
- ((looking-at "[{}]") "{}")
- ((looking-at "[<>]") "<>")
- ((looking-at "[`']") "`'")
- ((looking-at "\\^") "\\^")
- ((viper-looking-at-separator) "")
- (t (char-to-string (following-char))))
+ (concat modifiers
+ (cond ((looking-at "\\\\") "\\\\")
+ ((looking-at "-") "C-C-")
+ ((looking-at "[][]") "][")
+ ((looking-at "[()]") ")(")
+ ((looking-at "[{}]") "{}")
+ ((looking-at "[<>]") "<>")
+ ((looking-at "[`']") "`'")
+ ((looking-at "\\^") "\\^")
+ ((viper-looking-at-separator) "")
+ (t (char-to-string (following-char))))
+ )
))
-
+
;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
(or (looking-at "-")
(not (string-match "lisp" (symbol-name major-mode)))
(setq modifiers (concat modifiers "C-C-")))
-
-
+
+
(save-excursion
(cond ((> click-count 1) (viper-skip-nonseparators 'backward))
((viper-looking-at-alpha modifiers)
(viper-skip-alpha-backward modifiers))))
(setq word-beg (point))
-
+
(setq skip-flag nil) ; don't move 1 char forw the first time
(while (> count 0)
(if skip-flag (viper-forward-char-carefully 1))
(defun viper-mouse-click-get-word (click count click-count)
"Returns word surrounding the position of a mouse click.
-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.
On single or double click, returns the word as determined by
`viper-surrounding-word-function'."
-
+
(let ((click-word "")
(click-pos (viper-mouse-click-posn click))
(click-buf (viper-mouse-click-window-buffer click)))
(or (natnump count) (setq count 1))
(or (natnump click-count) (setq click-count 1))
-
+
(save-excursion
(save-window-excursion
(if click-pos
(progn
(set-buffer click-buf)
-
+
(goto-char click-pos)
(setq click-word
(funcall viper-surrounding-word-function count click-count)))
- (error "Click must be over a window."))
+ (error "Click must be over a window"))
click-word))))
(interactive "e\nP")
(if viper-frame-of-focus ;; to handle clicks in another frame
(select-frame viper-frame-of-focus))
- (if (or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
- 'viper-mouse-catch-frame-switch))
- (not (eq (key-binding viper-mouse-up-insert-key-parsed)
- 'viper-mouse-click-insert-word))
- (and viper-xemacs-p (not (event-over-text-area-p click))))
+ (if (save-excursion
+ (or (not (eq (key-binding viper-mouse-down-insert-key-parsed)
+ 'viper-mouse-catch-frame-switch))
+ (not (eq (key-binding viper-mouse-up-insert-key-parsed)
+ 'viper-mouse-click-insert-word))
+ (and viper-xemacs-p (not (event-over-text-area-p click)))))
() ; do nothing, if binding isn't right or not over text
;; turn arg into a number
(cond ((integerp arg) nil)
((and (listp arg) (integerp (car arg)))
(setq arg (car arg)))
(t (setq arg 1)))
-
+
(if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
'viper-mouse-catch-frame-switch))
() ; do nothing
(not (viper-mouse-event-p interrupting-event)))
(viper-set-unread-command-events interrupting-event))
)))))
-
-;; arg is an event. accepts symbols and numbers, too
+
+;; Arg is an event. Accepts symbols and numbers, too
(defun viper-mouse-event-p (event)
(if (eventp event)
(string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
(prin1-to-string (viper-event-key event)))))
-
-;; XEmacs has no double-click events. So, we must simulate.
+
+;; XEmacs has no double-click events. So, we must simulate.
;; So, we have to simulate event-click-count.
(defun viper-event-click-count (click)
- (if viper-xemacs-p
- (progn
- ;; if more than 1 second
- (if (> (- (event-timestamp click) viper-last-click-event-timestamp)
- viper-multiclick-timeout)
- (setq viper-current-click-count 0))
- (setq viper-last-click-event-timestamp (event-timestamp click)
- viper-current-click-count (1+ viper-current-click-count)))
- (event-click-count click)))
-
+ (viper-cond-compile-for-xemacs-or-emacs
+ (viper-event-click-count-xemacs click) ; xemacs
+ (event-click-count click) ; emacs
+ ))
+
+;; kind of semaphore for updating viper-current-click-count
+(defvar viper-counting-clicks-p nil)
+(viper-cond-compile-for-xemacs-or-emacs
+ (defun viper-event-click-count-xemacs (click)
+ (let ((time-delta (- (event-timestamp click)
+ viper-last-click-event-timestamp))
+ inhibit-quit)
+ (while viper-counting-clicks-p
+ (ignore))
+ (setq viper-counting-clicks-p t)
+ (if (> time-delta viper-multiclick-timeout)
+ (setq viper-current-click-count 0))
+ (discard-input)
+ (setq viper-current-click-count (1+ viper-current-click-count)
+ viper-last-click-event-timestamp (event-timestamp click))
+ (setq viper-counting-clicks-p nil)
+ (if (viper-sit-for-short viper-multiclick-timeout t)
+ viper-current-click-count
+ 0)
+ ))
+ nil ; emacs
+ )
(defun viper-mouse-click-search-word (click arg)
- "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.
With prefix argument, N, search for N-th occurrence.
-This command must be bound to a mouse click. The double-click action of the
+This command must be bound to a mouse click. The double-click action of the
same button must not be bound \(or it must be bound to the same function\).
See `viper-surrounding-word' for the details on what constitutes a word for
this command."
(interactive "e\nP")
(if viper-frame-of-focus ;; to handle clicks in another frame
(select-frame viper-frame-of-focus))
- (if (or (not (eq (key-binding viper-mouse-down-search-key-parsed)
- 'viper-mouse-catch-frame-switch))
- (not (eq (key-binding viper-mouse-up-search-key-parsed)
- 'viper-mouse-click-search-word))
- (and viper-xemacs-p (not (event-over-text-area-p click))))
+ (if (save-excursion
+ (or (not (eq (key-binding viper-mouse-down-search-key-parsed)
+ 'viper-mouse-catch-frame-switch))
+ (not (eq (key-binding viper-mouse-up-search-key-parsed)
+ 'viper-mouse-click-search-word))
+ (and viper-xemacs-p (not (event-over-text-area-p click)))))
() ; do nothing, if binding isn't right or not over text
(let ((previous-search-string viper-s-string)
click-word click-count)
-
+
(if (and
(viper-multiclick-p)
;; This trick checks if there is a pending mouse event if so, we use
(viper-read-event)
(viper-mouse-event-p last-input-event)))
(progn ; interrupted wait
- (setq viper-global-prefix-argument
- (or viper-global-prefix-argument arg))
- ;; remember command that was before the multiclick
- (setq this-command last-command)
+ (setq viper-global-prefix-argument (or viper-global-prefix-argument
+ arg)
+ ;; remember command that was before the multiclick
+ this-command last-command)
;; make sure we counted this event---needed for XEmacs only
(viper-event-click-count click))
;; uninterrupted wait
(setq click-count (viper-event-click-count click))
(setq click-word (viper-mouse-click-get-word click nil click-count))
-
+
(if (> click-count 1)
(setq arg viper-global-prefix-argument
viper-global-prefix-argument nil))
(setq arg (or arg 1))
-
+
(viper-deactivate-mark)
(if (or (not (string= click-word viper-s-string))
(not (markerp viper-search-start-marker))
viper-local-search-start-marker viper-search-start-marker
viper-mouse-click-search-noerror t
viper-mouse-click-search-limit nil)
-
+
;; make search string known to Viper
(setq viper-s-string (if viper-re-search
(regexp-quote click-word)
(setq viper-search-history
(cons viper-s-string viper-search-history)))
))
-
+
(push-mark nil t)
(while (> arg 0)
(viper-forward-word 1)
(marker-buffer viper-local-search-start-marker))
(goto-char viper-local-search-start-marker))
(viper-line-pos 'end)))
-
+
(goto-char (point-min))
(search-forward click-word
viper-mouse-click-search-limit nil)))
(message "`%s': String not found in %s"
viper-s-string (buffer-name (current-buffer)))
(message
- "`%s': Last occurrence in %s. Back to beginning of search"
+ "`%s': Last occurrence in %s. Back to beginning of search"
click-word (buffer-name (current-buffer)))
(setq arg 1) ;; to terminate the loop
(sit-for 2))
- (setq viper-mouse-click-search-noerror t)
+ (setq viper-mouse-click-search-noerror t)
(setq viper-mouse-click-search-limit nil)
(if (and (markerp viper-local-search-start-marker)
(marker-buffer viper-local-search-start-marker))
(goto-char viper-local-search-start-marker))))
(setq arg (1- arg)))
))))
-
+
(defun viper-mouse-catch-frame-switch (event arg)
"Catch the event of switching frame.
-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
bindings in the Viper manual."
(interactive "e\nP")
(setq viper-frame-of-focus nil)
(setq viper-frame-of-focus viper-current-frame-saved))
;; make Emacs forget that it executed viper-mouse-catch-frame-switch
(setq this-command last-command))
-
-;; Called just before switching frames. Saves the old selected frame.
+
+;; Called just before switching frames. Saves the old selected frame.
;; Sets last-command to handle-switch-frame (this is done automatically in
-;; Emacs.
+;; Emacs.
;; The semantics of switching frames is different in Emacs and XEmacs.
;; In Emacs, if you select-frame A while mouse is over frame B and then
;; start typing, input goes to frame B, which becomes selected.
-;; In XEmacs, input will go to frame A. This may be a bug in one of the
+;; In XEmacs, input will go to frame A. This may be a bug in one of the
;; Emacsen, but also may be a design decision.
;; Also, in Emacs sending input to frame B generates handle-switch-frame
;; event, while in XEmacs it doesn't.
;; All this accounts for the difference in the behavior of
;; viper-mouse-click-* commands when you click in a frame other than the one
-;; that was the last to receive input. In Emacs, focus will be in frame A
+;; that was the last to receive input. In Emacs, focus will be in frame A
;; until you do something other than viper-mouse-click-* command.
;; In XEmacs, you have to manually select frame B (with the mouse click) in
;; order to shift focus to frame B.
;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
;; Converts into a valid mouse button spec for the appropriate version of
-;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
+;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
;; returns button-down key.
(defun viper-parse-mouse-key (key-var event-type)
(let ((key (eval key-var))
(cond ((or (null viper-mouse-up-search-key-parsed)
(null viper-mouse-down-search-key-parsed))
nil) ; just quit
- ((and (null force)
+ ((and (null force)
(key-binding viper-mouse-up-search-key-parsed)
(not (eq (key-binding viper-mouse-up-search-key-parsed)
'viper-mouse-click-search-word)))
- (message
- "%S already bound to a mouse event. Viper mouse-search feature disabled"
+ (message
+ "%S already bound to a mouse event. Viper mouse-search feature disabled"
viper-mouse-up-search-key-parsed))
- ((and (null force)
+ ((and (null force)
(key-binding viper-mouse-down-search-key-parsed)
(not (eq (key-binding viper-mouse-down-search-key-parsed)
'viper-mouse-catch-frame-switch)))
(message
- "%S already bound to a mouse event. Viper mouse-search feature disabled"
+ "%S already bound to a mouse event. Viper mouse-search feature disabled"
viper-mouse-down-search-key-parsed))
- (t
+ (t
(global-set-key viper-mouse-up-search-key-parsed
'viper-mouse-click-search-word)
(global-set-key viper-mouse-down-search-key-parsed
(key-binding viper-mouse-up-insert-key-parsed)
(not (eq (key-binding viper-mouse-up-insert-key-parsed)
'viper-mouse-click-insert-word)))
- (message
- "%S already bound to a mouse event. Viper mouse-insert feature disabled"
+ (message
+ "%S already bound to a mouse event. Viper mouse-insert feature disabled"
viper-mouse-up-insert-key-parsed))
((and (null force)
(key-binding viper-mouse-down-insert-key-parsed)
(not (eq (key-binding viper-mouse-down-insert-key-parsed)
'viper-mouse-catch-frame-switch)))
(message
- "%S already bound to a mouse event. Viper mouse-insert feature disabled"
+ "%S already bound to a mouse event. Viper mouse-insert feature disabled"
viper-mouse-down-insert-key-parsed))
- (t
+ (t
(global-set-key viper-mouse-up-insert-key-parsed
'viper-mouse-click-insert-word)
(global-set-key viper-mouse-down-insert-key-parsed
keys down and clicking on a word with mouse button 1
will search for that word in the buffer that was current before the click.
This buffer may be different from the one where the click occurred."
- ;; This does not work
- ;; :type '(list (set :inline meta shift control)
- ;; integer)
- ;; This doesn't work either.
- ;; :type '(set meta shift control 1 2 3)
- :type 'sexp
+ :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
+ (const :format "%v " meta)
+ (const :format "%v " shift)
+ (const control))
+ (integer :tag "Button"))
:set 'viper-reset-mouse-search-key
:group 'viper-mouse)
down, and clicking on a word with mouse button 2, will insert that word
at the cursor in the buffer that was current just before the click.
This buffer may be different from the one where the click occurred."
- ;; This does not work.
- ;; :type '(list (set :inline meta shift control)
- ;; integer)
- ;; This doesn't work either.
- ;; :type '(set meta shift control 1 2 3)
- :type 'sexp
+ :type '(list (set :inline t :tag "Modifiers" :format "%t: %v"
+ (const :format "%v " meta)
+ (const :format "%v " shift)
+ (const control))
+ (integer :tag "Button"))
:set 'viper-reset-mouse-insert-key
:group 'viper-mouse)
-
+
;;; Local Variables:
;;; End:
-;;; viper-mous.el ends here
+;;; arch-tag: e56b2390-06c4-4dd1-96f5-c7876e2d8c2f
+;;; viper-mous.el ends here