code.delx.au - gnu-emacs/blob - lisp/emulation/viper-mous.el

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