lisp/emulation/viper-mous.el

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