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

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