lisp/emulation/viper-mous.el

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