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