diff lisp/viper/viper-mous.el @ 181:bfd6434d15b3 r20-3b17

Import from CVS: tag r20-3b17
author cvs
date Mon, 13 Aug 2007 09:53:19 +0200
parents 2d532a89d707
children 3d6bfa290dbd
line wrap: on
line diff
--- a/lisp/viper/viper-mous.el	Mon Aug 13 09:52:21 2007 +0200
+++ b/lisp/viper/viper-mous.el	Mon Aug 13 09:53:19 2007 +0200
@@ -26,11 +26,11 @@
 ;; compiler pacifier
 (defvar double-click-time)
 (defvar mouse-track-multi-click-time)
-(defvar vip-search-start-marker)
-(defvar vip-local-search-start-marker)
-(defvar vip-search-history)
-(defvar vip-s-string)
-(defvar vip-re-search)
+(defvar viper-search-start-marker)
+(defvar viper-local-search-start-marker)
+(defvar viper-search-history)
+(defvar viper-s-string)
+(defvar viper-re-search)
 
 ;; loading happens only in non-interactive compilation
 ;; in order to spare non-viperized emacs from being viperized
@@ -49,7 +49,7 @@
 
 (defgroup viper-mouse nil
   "Support for Viper special mouse-bound commands"
-  :prefix "vip-"
+  :prefix "viper-"
   :group 'viper)
 
 
@@ -57,13 +57,13 @@
   
 ;; Variable used for catching the switch-frame event.
 ;; If non-nil, indicates that previous-frame should be the selected
-;; one. Used by vip-mouse-click-get-word. Not a user option.
-(defvar vip-frame-of-focus nil)
+;; 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 vip-current-frame-saved (selected-frame))
+(defconst viper-current-frame-saved (selected-frame))
   
-(defcustom vip-surrounding-word-function 'vip-surrounding-word
+(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, 
 and CLICK-COUNT, telling whether this is the first click, a double-click,
@@ -73,8 +73,8 @@
        
 ;; time interval in millisecond within which successive clicks are
 ;; considered related
-(defcustom vip-multiclick-timeout (if (vip-window-display-p)
-				      (if vip-xemacs-p
+(defcustom viper-multiclick-timeout (if (viper-window-display-p)
+				      (if viper-xemacs-p
 					  mouse-track-multi-click-time
 					double-click-time)
 				    500)
@@ -84,55 +84,63 @@
   :group 'viper-mouse)
 
 ;; current event click count; XEmacs only
-(defvar vip-current-click-count 0)
+(defvar viper-current-click-count 0)
 ;; time stamp of the last click event; XEmacs only
-(defvar vip-last-click-event-timestamp 0)
+(defvar viper-last-click-event-timestamp 0)
 
 ;; Local variable used to toggle wraparound search on click.
-(vip-deflocalvar  vip-mouse-click-search-noerror t)
+(viper-deflocalvar  viper-mouse-click-search-noerror t)
 	
 ;; Local variable used to delimit search after wraparound.
-(vip-deflocalvar  vip-mouse-click-search-limit nil)
+(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
 ;; causes Emacs to count the second click as if it was a single click
-(defvar vip-global-prefix-argument nil)
+(defvar viper-global-prefix-argument nil)
+
+
+;; same keys, but parsed
+(defvar viper-mouse-up-search-key-parsed nil)
+(defvar viper-mouse-down-search-key-parsed nil)
+(defvar viper-mouse-up-insert-key-parsed nil)
+(defvar viper-mouse-down-insert-key-parsed nil)
+
 
 
 
 ;;; Code
 
-(defsubst vip-multiclick-p ()
-  (not (vip-sit-for-short vip-multiclick-timeout t)))
+(defsubst viper-multiclick-p ()
+  (not (viper-sit-for-short viper-multiclick-timeout t)))
 
 ;; Returns window where click occurs
-(defsubst vip-mouse-click-window (click)
-  (if vip-xemacs-p
+(defsubst viper-mouse-click-window (click)
+  (if viper-xemacs-p
       (event-window click)
     (posn-window (event-start click))))
 
 ;; Returns window where click occurs
-(defsubst vip-mouse-click-frame (click)
-  (window-frame (vip-mouse-click-window click)))
+(defsubst viper-mouse-click-frame (click)
+  (window-frame (viper-mouse-click-window click)))
 
 ;; Returns the buffer of the window where click occurs
-(defsubst vip-mouse-click-window-buffer (click)
-  (window-buffer (vip-mouse-click-window click)))
+(defsubst viper-mouse-click-window-buffer (click)
+  (window-buffer (viper-mouse-click-window click)))
 
 ;; Returns the name of the buffer in the window where click occurs
-(defsubst vip-mouse-click-window-buffer-name (click)
-  (buffer-name (vip-mouse-click-window-buffer click)))
+(defsubst viper-mouse-click-window-buffer-name (click)
+  (buffer-name (viper-mouse-click-window-buffer click)))
 
 ;; Returns position of a click
-(defsubst vip-mouse-click-posn (click)
-  (if vip-xemacs-p
+(defsubst viper-mouse-click-posn (click)
+  (if viper-xemacs-p
       (event-point click)
     (posn-point (event-start click))))
 	     
 
-(defun vip-surrounding-word (count click-count)
+(defun viper-surrounding-word (count click-count)
    "Returns word surrounding point according to a heuristic.
 COUNT indicates how many regions to return.
 If CLICK-COUNT is 1, `word' is a word in Vi sense.
@@ -153,16 +161,16 @@
      (if (> click-count 2)
 	 (save-excursion
 	   (beginning-of-line)
-	   (vip-skip-all-separators-forward 'within-line)
+	   (viper-skip-all-separators-forward 'within-line)
 	   (setq beg (point))
 	   (end-of-line)
 	   (setq result (buffer-substring beg (point))))
        
-       (if (and (not (vip-looking-at-alphasep))
-		(or (save-excursion (vip-backward-char-carefully)
-				    (vip-looking-at-alpha))
-		    (save-excursion (vip-forward-char-carefully)
-				    (vip-looking-at-alpha))))
+       (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-")
@@ -172,7 +180,7 @@
 		       ((looking-at "[<>]") "<>")
 		       ((looking-at "[`']") "`'")
 		       ((looking-at "\\^") "\\^")
-		       ((vip-looking-at-separator) "")
+		       ((viper-looking-at-separator) "")
 		       (t (char-to-string (following-char))))
 		 ))
        
@@ -183,45 +191,45 @@
        
        
        (save-excursion
-	 (cond ((> click-count 1) (vip-skip-nonseparators 'backward))
-	       ((vip-looking-at-alpha modifiers)
-		(vip-skip-alpha-backward modifiers))
-	       ((not (vip-looking-at-alphasep modifiers))
-		(vip-skip-nonalphasep-backward))
+	 (cond ((> click-count 1) (viper-skip-nonseparators 'backward))
+	       ((viper-looking-at-alpha modifiers)
+		(viper-skip-alpha-backward modifiers))
+	       ((not (viper-looking-at-alphasep modifiers))
+		(viper-skip-nonalphasep-backward))
 	       (t (if (> click-count 1)
-		      (vip-skip-nonseparators 'backward)
-		    (vip-skip-alpha-backward modifiers))))
+		      (viper-skip-nonseparators 'backward)
+		    (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 (vip-forward-char-carefully 1))
+	   (if skip-flag (viper-forward-char-carefully 1))
 	   (setq skip-flag t) ; now always move 1 char forward
 	   (if (> click-count 1)
-	       (vip-skip-nonseparators 'forward)
-	     (vip-skip-alpha-forward modifiers))
+	       (viper-skip-nonseparators 'forward)
+	     (viper-skip-alpha-forward modifiers))
 	   (setq count (1- count)))
 
 	 (setq result (buffer-substring word-beg (point))))
        ) ; if
      ;; XEmacs doesn't have set-text-properties, but there buffer-substring
      ;; doesn't return properties together with the string, so it's not needed.
-     (if vip-emacs-p
+     (if viper-emacs-p
 	 (set-text-properties 0 (length result) nil result))
      result
      ))
 
 
-(defun vip-mouse-click-get-word (click count click-count)
+(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.
 On single or double click, returns the word as determined by
-`vip-surrounding-word-function'."
+`viper-surrounding-word-function'."
      
   (let ((click-word "")
-	(click-pos (vip-mouse-click-posn click))
-	(click-buf (vip-mouse-click-window-buffer click)))
+	(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))
      
@@ -233,21 +241,21 @@
 	
 	      (goto-char click-pos)
 	      (setq click-word
-		    (funcall vip-surrounding-word-function count click-count)))
+		    (funcall viper-surrounding-word-function count click-count)))
 	  (error "Click must be over a window."))
 	click-word))))
 
 
-(defun vip-mouse-click-insert-word (click arg)
+(defun viper-mouse-click-insert-word (click arg)
   "Insert word clicked or double-clicked on.
 With prefix argument, N, insert that many words.
 This command must be bound to a mouse click.
 The double-click action of the same mouse button must not be bound
 \(or it must be bound to the same function\).
-See `vip-surrounding-word' for the definition of a word in this case."
+See `viper-surrounding-word' for the definition of a word in this case."
   (interactive "e\nP")
-  (if vip-frame-of-focus	;; to handle clicks in another frame
-      (select-frame vip-frame-of-focus))
+  (if viper-frame-of-focus	;; to handle clicks in another frame
+      (select-frame viper-frame-of-focus))
       
   ;; turn arg into a number
   (cond ((integerp arg) nil)
@@ -256,168 +264,175 @@
 	 (setq arg (car arg)))
 	(t (setq arg 1)))
       
-  (let (click-count interrupting-event)
-    (if (and
-	 (vip-multiclick-p)
-	 ;; This trick checks if there is a pending mouse event
-	 ;; if so, we use this latter event and discard the current mouse click
-	 ;; If the next pending event is not a mouse event, we execute
-	 ;; the current mouse event
-	 (progn
-	   (setq interrupting-event (vip-read-event))
-	   (vip-mouse-event-p last-input-event)))
-	(progn ;; interrupted wait
-	  (setq vip-global-prefix-argument arg)
-	  ;; count this click for XEmacs
-	  (vip-event-click-count click))
-      ;; uninterrupted wait or the interrupting event wasn't a mouse event
-      (setq click-count (vip-event-click-count click))
-      (if (> click-count 1)
-	  (setq arg vip-global-prefix-argument
-		vip-global-prefix-argument nil))
-      (insert (vip-mouse-click-get-word click arg click-count))
-      (if (and interrupting-event
-	       (eventp interrupting-event)
-	       (not (vip-mouse-event-p interrupting-event)))
-	  (vip-set-unread-command-events interrupting-event))
-      )))
+  (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
+	       'viper-mouse-catch-frame-switch))
+      () ; do nothing
+    (let (click-count interrupting-event)
+      (if (and
+	   (viper-multiclick-p)
+	   ;; This trick checks if there is a pending mouse event if so, we use
+	   ;; this latter event and discard the current mouse click If the next
+	   ;; pending event is not a mouse event, we execute the current mouse
+	   ;; event
+	   (progn
+	     (setq interrupting-event (viper-read-event))
+	     (viper-mouse-event-p last-input-event)))
+	  (progn ; interrupted wait
+	    (setq viper-global-prefix-argument arg)
+	    ;; count this click for XEmacs
+	    (viper-event-click-count click))
+	;; uninterrupted wait or the interrupting event wasn't a mouse event
+	(setq click-count (viper-event-click-count click))
+	(if (> click-count 1)
+	    (setq arg viper-global-prefix-argument
+		  viper-global-prefix-argument nil))
+	(insert (viper-mouse-click-get-word click arg click-count))
+	(if (and interrupting-event
+		 (eventp interrupting-event)
+		 (not (viper-mouse-event-p interrupting-event)))
+	    (viper-set-unread-command-events interrupting-event))
+	))))
   
 ;; arg is an event. accepts symbols and numbers, too
-(defun vip-mouse-event-p (event)
+(defun viper-mouse-event-p (event)
   (if (eventp event)
       (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
-		    (prin1-to-string (vip-event-key event)))))
+		    (prin1-to-string (viper-event-key event)))))
   
 ;; XEmacs has no double-click events. So, we must simulate.
 ;; So, we have to simulate event-click-count.
-(defun vip-event-click-count (click)
-  (if vip-xemacs-p
+(defun viper-event-click-count (click)
+  (if viper-xemacs-p
       (progn
 	;; if more than 1 second
-	(if (> (- (event-timestamp click) vip-last-click-event-timestamp)
-	       vip-multiclick-timeout)
-	    (setq vip-current-click-count 0))
-	(setq vip-last-click-event-timestamp (event-timestamp click)
-	      vip-current-click-count (1+ vip-current-click-count)))
+	(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)))
     
 
 
-(defun vip-mouse-click-search-word (click arg)
+(defun viper-mouse-click-search-word (click arg)
    "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
 same button must not be bound \(or it must be bound to the same function\).
-See `vip-surrounding-word' for the details on what constitutes a word for
+See `viper-surrounding-word' for the details on what constitutes a word for
 this command."
   (interactive "e\nP")
-  (if vip-frame-of-focus	;; to handle clicks in another frame
-      (select-frame vip-frame-of-focus))
-  (let (click-word click-count
-	(previous-search-string vip-s-string))
-    
-    (if (and
-	 (vip-multiclick-p)
-	 ;; This trick checks if there is a pending mouse event
-	 ;; if so, we use this latter event and discard the current mouse click
-	 ;; If the next pending event is not a mouse event, we execute
-	 ;; the current mouse event
-	 (progn
-	   (vip-read-event)
-	   (vip-mouse-event-p last-input-event)))
-	(progn ;; interrupted wait
-	  (setq vip-global-prefix-argument 
-		(or vip-global-prefix-argument arg))
-	  ;; remember command that was before the multiclick
-	  (setq this-command last-command)
-	  ;; make sure we counted this event---needed for XEmacs only
-	  (vip-event-click-count click))
-      ;; uninterrupted wait
-      (setq click-count (vip-event-click-count click))
-      (setq click-word (vip-mouse-click-get-word click nil click-count))
-    
-      (if (> click-count 1)
-	  (setq arg vip-global-prefix-argument
-		vip-global-prefix-argument nil))
-      (setq arg (or arg 1))
+  (if viper-frame-of-focus	;; to handle clicks in another frame
+      (select-frame viper-frame-of-focus))
+  (if (not (eq (key-binding viper-mouse-down-search-key-parsed)
+	       'viper-mouse-catch-frame-switch))
+      () ; do nothing
+    (let ((previous-search-string viper-s-string)
+	  click-word click-count)
     
-      (vip-deactivate-mark)
-      (if (or (not (string= click-word vip-s-string))
-	      (not (markerp vip-search-start-marker))
-	      (not (equal (marker-buffer vip-search-start-marker)
-			  (current-buffer)))
-	      (not (eq last-command 'vip-mouse-click-search-word)))
-	  (progn
-	    (setq  vip-search-start-marker (point-marker)
-		   vip-local-search-start-marker vip-search-start-marker
-		   vip-mouse-click-search-noerror t
-		   vip-mouse-click-search-limit nil)
-	    
-	    ;; make search string known to Viper
-	    (setq vip-s-string (if vip-re-search
-				   (regexp-quote click-word)
-				 click-word))
-	    (if (not (string= vip-s-string (car vip-search-history)))
-		(setq vip-search-history
-		      (cons vip-s-string vip-search-history)))
-	    ))
-      
-      (push-mark nil t)
-      (while (> arg 0)
-	(vip-forward-word 1)
-	(condition-case nil
+      (if (and
+	   (viper-multiclick-p)
+	   ;; This trick checks if there is a pending mouse event if so, we use
+	   ;; this latter event and discard the current mouse click If the next
+	   ;; pending event is not a mouse event, we execute the current mouse
+	   ;; event
+	   (progn
+	     (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)
+	    ;; 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))
+		(not (equal (marker-buffer viper-search-start-marker)
+			    (current-buffer)))
+		(not (eq last-command 'viper-mouse-click-search-word)))
 	    (progn
-	      (if (not (search-forward click-word vip-mouse-click-search-limit
-				       vip-mouse-click-search-noerror))
-		  (progn
-		    (setq vip-mouse-click-search-noerror nil)
-		    (setq vip-mouse-click-search-limit
-			  (save-excursion
-			    (if (and
-				 (markerp vip-local-search-start-marker)
-				 (marker-buffer vip-local-search-start-marker))
-				(goto-char vip-local-search-start-marker))
-			    (vip-line-pos 'end)))
-			    
-		    (goto-char (point-min))
-		    (search-forward click-word
-				    vip-mouse-click-search-limit nil)))
-	      (goto-char (match-beginning 0))
-	      (message "Searching for: %s" vip-s-string)
-	      (if (<= arg 1) ; found the right occurrence of the pattern
-		  (progn
-		    (vip-adjust-window)
-		    (vip-flash-search-pattern)))
-	      )
-	  (error (beep 1)
-		 (if (or (not (string= click-word previous-search-string))
-			 (not (eq  last-command 'vip-mouse-click-search-word)))
-		     (message "`%s': String not found in %s"
-			      vip-s-string (buffer-name (current-buffer)))
-		   (message
-		    "`%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  vip-mouse-click-search-noerror t) 
-		 (setq  vip-mouse-click-search-limit nil)
-		 (if (and (markerp vip-local-search-start-marker)
-			  (marker-buffer vip-local-search-start-marker))
-		     (goto-char vip-local-search-start-marker))))
-	(setq arg (1- arg)))
-      )))
+	      (setq  viper-search-start-marker (point-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)
+				   click-word))
+	      (if (not (string= viper-s-string (car viper-search-history)))
+		  (setq viper-search-history
+			(cons viper-s-string viper-search-history)))
+	      ))
+	
+	(push-mark nil t)
+	(while (> arg 0)
+	  (viper-forward-word 1)
+	  (condition-case nil
+	      (progn
+		(if (not (search-forward
+			  click-word viper-mouse-click-search-limit
+			  viper-mouse-click-search-noerror))
+		    (progn
+		      (setq viper-mouse-click-search-noerror nil)
+		      (setq viper-mouse-click-search-limit
+			    (save-excursion
+			      (if (and
+				   (markerp viper-local-search-start-marker)
+				   (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)))
+		(goto-char (match-beginning 0))
+		(message "Searching for: %s" viper-s-string)
+		(if (<= arg 1) ; found the right occurrence of the pattern
+		    (progn
+		      (viper-adjust-window)
+		      (viper-flash-search-pattern)))
+		)
+	    (error (beep 1)
+		   (if (or (not (string= click-word previous-search-string))
+			   (not (eq  last-command 'viper-mouse-click-search-word)))
+		       (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"
+		      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-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 vip-mouse-catch-frame-switch (event 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 vip-frame-of-focus nil)
-  ;; pass prefix arg along to vip-mouse-click-search/insert-word
+  (setq viper-frame-of-focus nil)
+  ;; pass prefix arg along to viper-mouse-click-search/insert-word
   (setq prefix-arg arg)
   (if (eq last-command 'handle-switch-frame)
-      (setq vip-frame-of-focus vip-current-frame-saved))
-  ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
+      (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.
@@ -431,18 +446,185 @@
 ;; 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
-;; vip-mouse-click-* commands when you click in a frame other than the one
+;; 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
-;; until you do something other than vip-mouse-click-* command.
+;; 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.
-(defsubst vip-remember-current-frame (frame)
+(defsubst viper-remember-current-frame (frame)
   (setq last-command 'handle-switch-frame
-	vip-current-frame-saved (selected-frame)))
+	viper-current-frame-saved (selected-frame)))
+
+
+;; 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
+;; returns button-down key.
+(defun viper-parse-mouse-key (key-var event-type)
+  (let ((key (eval key-var))
+	button-spec meta-spec shift-spec control-spec key-spec)
+    (if (null key)
+	;; just return nil
+	()
+      (setq button-spec
+	    (cond ((memq 1 key)
+		   (if viper-emacs-p
+		       (if (eq 'up event-type)
+			   "mouse-1" "down-mouse-1")
+		     (if (eq 'up event-type)
+			 'button1up 'button1)))
+		  ((memq 2 key)
+		   (if viper-emacs-p
+		       (if (eq 'up event-type)
+			   "mouse-2" "down-mouse-2")
+		     (if (eq 'up event-type)
+			 'button2up 'button2)))
+		  ((memq 3 key)
+		   (if viper-emacs-p
+		       (if (eq 'up event-type)
+			   "mouse-3" "down-mouse-3")
+		     (if (eq 'up event-type)
+			 'button3up 'button3)))
+		  (t (error
+		      "%S: invalid button number, %S" key-var key)))
+	    meta-spec
+	    (if (memq 'meta key)
+		(if viper-emacs-p "M-" 'meta)
+	      (if viper-emacs-p "" nil))
+	    shift-spec
+	    (if (memq 'shift key)
+		(if viper-emacs-p "S-" 'shift)
+	      (if viper-emacs-p "" nil))
+	    control-spec
+	    (if (memq 'control key)
+		(if viper-emacs-p "C-" 'control)
+	      (if viper-emacs-p "" nil)))
+
+      (setq key-spec (if viper-emacs-p
+			 (vector
+			  (intern
+			   (concat
+			    control-spec meta-spec shift-spec button-spec)))
+		       (vector
+			(delq
+			 nil
+			 (list
+			  control-spec meta-spec shift-spec button-spec)))))
+      )))
+
+(defun viper-unbind-mouse-search-key ()
+  (if viper-mouse-up-search-key-parsed
+      (global-unset-key viper-mouse-up-search-key-parsed))
+  (if viper-mouse-down-search-key-parsed
+      (global-unset-key viper-mouse-down-search-key-parsed))
+  (setq viper-mouse-up-search-key-parsed nil
+	viper-mouse-down-search-key-parsed nil))
+
+(defun viper-unbind-mouse-insert-key ()
+  (if viper-mouse-up-insert-key-parsed
+      (global-unset-key viper-mouse-up-insert-key-parsed))
+  (if viper-mouse-down-insert-key-parsed
+      (global-unset-key viper-mouse-down-insert-key-parsed))
+  (setq viper-mouse-up-insert-key-parsed nil
+	viper-mouse-down-insert-key-parsed nil))
+
+;; If FORCE, bind even if this mouse action is already bound to something else
+(defun viper-bind-mouse-search-key (&optional force)
+  (setq viper-mouse-up-search-key-parsed
+	(viper-parse-mouse-key 'viper-mouse-search-key 'up)
+	viper-mouse-down-search-key-parsed
+	(viper-parse-mouse-key 'viper-mouse-search-key 'down))
+  (cond ((or (null viper-mouse-up-search-key-parsed)
+	     (null viper-mouse-down-search-key-parsed))
+	 nil) ; just quit
+	((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"
+	  viper-mouse-up-search-key-parsed))
+	((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"
+	  viper-mouse-down-search-key-parsed))
+	(t 
+	 (global-set-key viper-mouse-up-search-key-parsed
+			 'viper-mouse-click-search-word)
+	 (global-set-key viper-mouse-down-search-key-parsed
+			 'viper-mouse-catch-frame-switch))))
+
+;; If FORCE, bind even if this mouse action is already bound to something else
+(defun viper-bind-mouse-insert-key (&optional force)
+  (setq viper-mouse-up-insert-key-parsed
+	(viper-parse-mouse-key 'viper-mouse-insert-key 'up)
+	viper-mouse-down-insert-key-parsed
+	(viper-parse-mouse-key 'viper-mouse-insert-key 'down))
+  (cond ((or (null viper-mouse-up-insert-key-parsed)
+	     (null viper-mouse-down-insert-key-parsed))
+	 nil) ; just quit
+	((and (null force)
+	      (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"
+	  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"
+	  viper-mouse-down-insert-key-parsed))
+	(t 
+	 (global-set-key viper-mouse-up-insert-key-parsed
+			 'viper-mouse-click-insert-word)
+	 (global-set-key viper-mouse-down-insert-key-parsed
+			 'viper-mouse-catch-frame-switch))))
+
+(defun viper-reset-mouse-search-key (symb val)
+  (viper-unbind-mouse-search-key)
+  (set symb val)
+  (viper-bind-mouse-search-key 'force))
+
+(defun viper-reset-mouse-insert-key (symb val)
+  (viper-unbind-mouse-insert-key)
+  (set symb val)
+  (viper-bind-mouse-insert-key 'force))
+
+
+(defcustom viper-mouse-search-key '(meta shift 1)
+  "*Key used to click-search in Viper.
+Must be a list that specifies the mouse button and modifiers. The supported
+modifiers are `meta', `shift', and `control'. For instance, `(meta shift 1)'
+means that holding the meta and shift keys down and clicking on a word with
+mouse button 1 will initiate search for that word in the buffer that was
+current just before the click. This buffer may be different from the one where
+the click occurred."
+  :type 'list
+  :set 'viper-reset-mouse-search-key
+  :group 'viper-mouse)
+
+(defcustom viper-mouse-insert-key '(meta shift 2)
+  "*Key used to click-insert in Viper.
+Must be a list that specifies the mouse button and modifiers. The supported
+modifiers are `meta', `shift', and `control'. For instance, `(meta shift 2)'
+means that holding the meta and shift keys 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."
+  :type 'list
+  :set 'viper-reset-mouse-insert-key
+  :group 'viper-mouse)
+	   
 
 
 ;;; Local Variables:
-;;; eval: (put 'vip-deflocalvar 'lisp-indent-hook 'defun)
+;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
 ;;; End: