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