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

   1 ;;; viper-mous.el -- Mouse support for Viper
   2 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
   3
   4 ;; This file is part of GNU Emacs.
   5
   6 ;; GNU Emacs is free software; you can redistribute it and/or modify
   7 ;; it under the terms of the GNU General Public License as published by
   8 ;; the Free Software Foundation; either version 2, or (at your option)
   9 ;; any later version.
  10
  11 ;; GNU Emacs is distributed in the hope that it will be useful,
  12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;; GNU General Public License for more details.
  15
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20
  21 (require 'viper-util)
  22
  23 \f
  24 ;;; Variables
  25
  26 ;; Variable used for catching the switch-frame event.
  27 ;; If non-nil, indicates that previous-frame should be the selected
  28 ;; one. Used by vip-mouse-click-get-word. Not a user option.
  29 (defvar vip-frame-of-focus nil)
  30
  31 ;; Frame that was selected before the switch-frame event.
  32 (defconst vip-current-frame-saved (selected-frame))
  33
  34 (defvar vip-surrounding-word-function 'vip-surrounding-word
  35   "*Function that determines what constitutes a word for clicking events.
  36 Takes two parameters: a COUNT, indicating how many words to return,
  37 and CLICK-COUNT, telling whether this is the first click, a double-click,
  38 or a tripple-click.")
  39
  40 ;; time interval in millisecond within which successive clicks are
  41 ;; considered related
  42 (defconst vip-multiclick-timeout (if vip-xemacs-p
  43                                    500
  44                                  double-click-time)
  45   "*Time interval in millisecond within which successive clicks are
  46 considered related.")
  47
  48 ;; current event click count; XEmacs only
  49 (defvar vip-current-click-count 0)
  50 ;; time stamp of the last click event; XEmacs only
  51 (defvar vip-last-click-event-timestamp 0)
  52
  53 ;; Local variable used to toggle wraparound search on click.
  54 (vip-deflocalvar  vip-mouse-click-search-noerror t)
  55
  56 ;; Local variable used to delimit search after wraparound.
  57 (vip-deflocalvar  vip-mouse-click-search-limit nil)
  58
  59 ;; remembers prefix argument to pass along to commands invoked by second
  60 ;; click.
  61 ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
  62 ;; causes Emacs to count the second click as if it was a single click
  63 (defvar vip-global-prefix-argument nil)
  64
  65
  66 \f
  67 ;;; Code
  68
  69 (defsubst vip-multiclick-p ()
  70   (not (vip-sit-for-short vip-multiclick-timeout t)))
  71
  72 (defun vip-surrounding-word (count click-count)
  73    "Returns word surrounding point according to a heuristic.
  74 COUNT indicates how many regions to return.
  75 If CLICK-COUNT is 1, `word' is a word in Vi sense. If it is > 1,
  76 then `word' is a Word in Vi sense.
  77 If the character clicked on is a non-separator and is non-alphanumeric but
  78 is adjacent to an alphanumeric symbol, then it is considered alphanumeric
  79 for the purpose of this command. If this character has a matching
  80 character, such as `\(' is a match for `\)', then the matching character is
  81 also considered alphanumeric.
  82 For convenience, in Lisp modes, `-' is considered alphanumeric."
  83    (let* ((basic-alpha "_a-zA-Z0-9") ;; it is important for `_' to come first
  84           (basic-alpha-B "[_a-zA-Z0-9]")
  85           (basic-nonalphasep-B vip-NONALPHASEP-B)
  86           (end-modifiers "")
  87           (start-modifiers "")
  88           vip-ALPHA vip-ALPHA-B
  89           vip-NONALPHA vip-NONALPHA-B
  90           vip-ALPHASEP vip-ALPHASEP-B
  91           vip-NONALPHASEP vip-NONALPHASEP-B
  92           skip-flag
  93           one-char-word-func word-function-forw word-function-back word-beg)
  94
  95      (if (and (looking-at basic-nonalphasep-B)
  96               (or (save-excursion (vip-backward-char-carefully)
  97                                   (looking-at basic-alpha-B))
  98                   (save-excursion (vip-forward-char-carefully)
  99                                   (looking-at basic-alpha-B))))
 100          (setq start-modifiers
 101                (cond ((looking-at "\\\\") "\\\\")
 102                      ((looking-at "-") "")
 103                      ((looking-at "[][]") "][")
 104                      ((looking-at "[()]") ")(")
 105                      ((looking-at "[{}]") "{}")
 106                      ((looking-at "[<>]") "<>")
 107                      ((looking-at "[`']") "`'")
 108                      ((looking-at "\\^") "")
 109                      ((looking-at vip-SEP-B) "")
 110                      (t (char-to-string (following-char))))
 111                end-modifiers
 112                (cond ((looking-at "-") "C-C-") ;; note the C-C trick
 113                      ((looking-at "\\^") "^")
 114                      (t ""))))
 115
 116      ;; Add `-' to alphanum, if it wasn't added and in we are in Lisp
 117      (or (looking-at "-")
 118          (not (string-match "lisp" (symbol-name major-mode)))
 119          (setq end-modifiers (concat end-modifiers "C-C-")))
 120
 121      (setq vip-ALPHA
 122            (format "%s%s%s" start-modifiers basic-alpha end-modifiers)
 123            vip-ALPHA-B
 124            (format "[%s%s%s]" start-modifiers basic-alpha end-modifiers)
 125            vip-NONALPHA (concat "^" vip-ALPHA)
 126            vip-NONALPHA-B (concat "[" vip-NONALPHA "]")
 127            vip-ALPHASEP (concat vip-ALPHA vip-SEP)
 128            vip-ALPHASEP-B
 129            (format "[%s%s%s%s]"
 130                    start-modifiers basic-alpha vip-SEP end-modifiers)
 131            vip-NONALPHASEP (format "^%s%s" vip-SEP vip-ALPHA)
 132            vip-NONALPHASEP-B (format "[^%s%s]" vip-SEP vip-ALPHA)
 133            )
 134
 135      (if (> click-count 1)
 136          (setq one-char-word-func 'vip-one-char-Word-p
 137                word-function-forw 'vip-end-of-Word
 138                word-function-back 'vip-backward-Word)
 139        (setq one-char-word-func 'vip-one-char-word-p
 140              word-function-forw 'vip-end-of-word
 141              word-function-back 'vip-backward-word))
 142
 143      (save-excursion
 144        (cond ((> click-count 1) (skip-chars-backward vip-NONSEP))
 145              ((looking-at vip-ALPHA-B) (skip-chars-backward vip-ALPHA))
 146              ((looking-at vip-NONALPHASEP-B)
 147               (skip-chars-backward vip-NONALPHASEP))
 148              (t (funcall word-function-back 1)))
 149
 150        (setq word-beg (point))
 151
 152        (setq skip-flag t)
 153        (while (> count 0)
 154          ;; skip-flag and the test for 1-char word takes care of the
 155          ;; special treatment that vip-end-of-word gives to 1-character
 156          ;; words. Otherwise, clicking once on such a word will insert two
 157          ;; words.
 158          (if (and skip-flag (funcall one-char-word-func))
 159              (setq skip-flag (not skip-flag))
 160            (funcall word-function-forw 1))
 161          (setq count (1- count)))
 162
 163        (vip-forward-char-carefully)
 164        (buffer-substring word-beg (point)))
 165        ))
 166
 167
 168 (defun vip-mouse-click-get-word (click &optional count click-count)
 169   "Returns word surrounding the position of a mouse click.
 170 Click may be in another window. Current window and buffer isn't changed."
 171
 172   (let ((click-word "")
 173         (click-pos (vip-mouse-click-posn click))
 174         (click-buf (vip-mouse-click-window-buffer click)))
 175     (or (numberp count) (setq count 1))
 176     (or (numberp click-count) (setq click-count 1))
 177
 178     (save-excursion
 179       (save-window-excursion
 180         (if click-pos
 181             (progn
 182               (set-buffer click-buf)
 183
 184               (goto-char click-pos)
 185               (setq click-word
 186                     (funcall vip-surrounding-word-function count click-count)))
 187           (error "Click must be over a window."))
 188         click-word))))
 189
 190 ;; Returns window where click occurs
 191 (defsubst vip-mouse-click-frame (click)
 192   (window-frame (vip-mouse-click-window click)))
 193
 194 ;; Returns window where click occurs
 195 (defsubst vip-mouse-click-window (click)
 196   (if vip-xemacs-p
 197       (event-window click)
 198     (posn-window (event-start click))))
 199
 200 ;; Returns the buffer of the window where click occurs
 201 (defsubst vip-mouse-click-window-buffer (click)
 202   (window-buffer (vip-mouse-click-window click)))
 203
 204 ;; Returns the name of the buffer in the window where click occurs
 205 (defsubst vip-mouse-click-window-buffer-name (click)
 206   (buffer-name (vip-mouse-click-window-buffer click)))
 207
 208 ;; Returns position of a click
 209 (defsubst vip-mouse-click-posn (click)
 210   (if vip-xemacs-p
 211       (event-point click)
 212     (posn-point (event-start click))))
 213
 214 (defun vip-mouse-click-insert-word (click arg)
 215   "Insert word clicked or double-clicked on.
 216 With prefix argument, N, insert that many words.
 217 This command must be bound to a mouse click.
 218 The double-click action of the same mouse button must not be bound
 219 \(or it must be bound to the same function\).
 220 See `vip-surrounding-word' for the definition of a word in this case."
 221   (interactive "e\nP")
 222   (if vip-frame-of-focus        ;; to handle clicks in another frame
 223       (select-frame vip-frame-of-focus))
 224
 225   ;; turn arg into a number
 226   (cond ((numberp arg) nil)
 227         ;; prefix arg is a list when one hits C-u then command
 228         ((and (listp arg) (numberp (car arg)))
 229          (setq arg (car arg)))
 230         (t (setq arg 1)))
 231
 232   (let (click-count interrupting-event)
 233     (if (and
 234          (vip-multiclick-p)
 235          ;; This trick checks if there is a pending mouse event
 236          ;; if so, we use this latter event and discard the current mouse click
 237          ;; If the next panding event is not a mouse event, we execute
 238          ;; the current mouse event
 239          (progn
 240            (setq interrupting-event (vip-read-event))
 241            (vip-mouse-event-p last-input-event)))
 242         (progn ;; interrupted wait
 243           (setq vip-global-prefix-argument arg)
 244           ;; count this click for XEmacs
 245           (vip-event-click-count click))
 246       ;; uninterrupted wait or the interrupting event wasn't a mouse event
 247       (setq click-count (vip-event-click-count click))
 248       (if (> click-count 1)
 249           (setq arg vip-global-prefix-argument
 250                 vip-global-prefix-argument nil))
 251       (insert (vip-mouse-click-get-word click arg click-count))
 252       (if (and interrupting-event
 253                (eventp interrupting-event)
 254                (not (vip-mouse-event-p interrupting-event)))
 255           (vip-set-unread-command-events interrupting-event))
 256       )))
 257
 258 ;; arg is an event. accepts symbols and numbers, too
 259 (defun vip-mouse-event-p (event)
 260   (if (eventp event)
 261       (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
 262                     (prin1-to-string (vip-event-key event)))))
 263
 264 ;; XEmacs has no double-click events. So, we must simulate.
 265 ;; So, we have to simulate event-click-count.
 266 (defun vip-event-click-count (click)
 267   (if vip-xemacs-p
 268       (progn
 269         ;; if more than 1 second
 270         (if (> (- (event-timestamp click) vip-last-click-event-timestamp)
 271                vip-multiclick-timeout)
 272             (setq vip-current-click-count 0))
 273         (setq vip-last-click-event-timestamp (event-timestamp click)
 274               vip-current-click-count (1+ vip-current-click-count)))
 275     (event-click-count click)))
 276
 277
 278
 279 (defun vip-mouse-click-search-word (click arg)
 280    "Find the word clicked or double-clicked on. Word may be in another window.
 281 With prefix argument, N, search for N-th occurrence.
 282 This command must be bound to a mouse click. The double-click action of the
 283 same button must not be bound \(or it must be bound to the same function\).
 284 See `vip-surrounding-word' for the details on what constitutes a word for
 285 this command."
 286   (interactive "e\nP")
 287   (if vip-frame-of-focus        ;; to handle clicks in another frame
 288       (select-frame vip-frame-of-focus))
 289   (let (click-word click-count
 290         (previous-search-string vip-s-string))
 291
 292     (if (and
 293          (vip-multiclick-p)
 294          ;; This trick checks if there is a pending mouse event
 295          ;; if so, we use this latter event and discard the current mouse click
 296          ;; If the next panding event is not a mouse event, we execute
 297          ;; the current mouse event
 298          (progn
 299            (vip-read-event)
 300            (vip-mouse-event-p last-input-event)))
 301         (progn ;; interrupted wait
 302           (setq vip-global-prefix-argument arg)
 303           ;; remember command that was before the multiclick
 304           (setq this-command last-command)
 305           ;; make sure we counted this event---needed for XEmacs only
 306           (vip-event-click-count click))
 307       ;; uninterrupted wait
 308       (setq click-count (vip-event-click-count click))
 309       (setq click-word (vip-mouse-click-get-word click nil click-count))
 310
 311       (if (> click-count 1)
 312           (setq arg vip-global-prefix-argument
 313                 vip-global-prefix-argument nil))
 314       (setq arg (or arg 1))
 315
 316       (vip-deactivate-mark)
 317       (if (or (not (string= click-word vip-s-string))
 318               (not (markerp vip-search-start-marker))
 319               (not (equal (marker-buffer vip-search-start-marker)
 320                           (current-buffer)))
 321               (not (eq last-command 'vip-mouse-click-search-word)))
 322           (progn
 323             (setq  vip-search-start-marker (point-marker)
 324                    vip-local-search-start-marker vip-search-start-marker
 325                    vip-mouse-click-search-noerror t
 326                    vip-mouse-click-search-limit nil)
 327
 328             ;; make search string known to Viper
 329             (setq vip-s-string (if vip-re-search
 330                                    (regexp-quote click-word)
 331                                  click-word))
 332             (if (not (string= vip-s-string (car vip-search-history)))
 333                 (setq vip-search-history
 334                       (cons vip-s-string vip-search-history)))
 335             ))
 336
 337       (push-mark nil t)
 338       (while (> arg 0)
 339         (vip-forward-word 1)
 340         (condition-case nil
 341             (progn
 342               (if (not (search-forward click-word vip-mouse-click-search-limit
 343                                        vip-mouse-click-search-noerror))
 344                   (progn
 345                     (setq vip-mouse-click-search-noerror nil)
 346                     (setq vip-mouse-click-search-limit
 347                           (save-excursion
 348                             (if (and
 349                                  (markerp vip-local-search-start-marker)
 350                                  (marker-buffer vip-local-search-start-marker))
 351                                 (goto-char vip-local-search-start-marker))
 352                             (vip-line-pos 'end)))
 353
 354                     (goto-char (point-min))
 355                     (search-forward click-word
 356                                     vip-mouse-click-search-limit nil)))
 357               (goto-char (match-beginning 0))
 358               (message "Searching for: %s" vip-s-string)
 359               (if (<= arg 1)
 360                   (vip-flash-search-pattern))
 361               )
 362           (error (beep 1)
 363                  (if (or (not (string= click-word previous-search-string))
 364                          (not (eq  last-command 'vip-mouse-click-search-word)))
 365                      (message "`%s': String not found in %s"
 366                               vip-s-string (buffer-name (current-buffer)))
 367                    (message
 368                     "`%s': Last occurrence in %s. Back to beginning of search"
 369                     click-word (buffer-name (current-buffer)))
 370                    (setq arg 1) ;; to terminate the loop
 371                    (sit-for 2))
 372                  (setq  vip-mouse-click-search-noerror t)
 373                  (setq  vip-mouse-click-search-limit nil)
 374                  (if (and (markerp vip-local-search-start-marker)
 375                           (marker-buffer vip-local-search-start-marker))
 376                      (goto-char vip-local-search-start-marker))))
 377         (setq arg (1- arg)))
 378       )))
 379
 380 (defun vip-mouse-catch-frame-switch (event arg)
 381   "Catch the event of switching frame.
 382 Usually is bound to a 'down-mouse' event to work properly. See sample
 383 bindings in viper.el and in the Viper manual."
 384   (interactive "e\nP")
 385   (setq vip-frame-of-focus nil)
 386   ;; pass prefix arg along to vip-mouse-click-search/insert-word
 387   (setq prefix-arg arg)
 388   (if (eq last-command 'handle-switch-frame)
 389       (setq vip-frame-of-focus vip-current-frame-saved))
 390   ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
 391   (setq this-command last-command))
 392
 393 ;; Called just before switching frames. Saves the old selected frame.
 394 ;; Sets last-command to handle-switch-frame (this is done automatically in
 395 ;; Emacs.
 396 ;; The semantics of switching frames is different in Emacs and XEmacs.
 397 ;; In Emacs, if you select-frame A while mouse is over frame B and then
 398 ;; start typing, input goes to frame B, which becomes selected.
 399 ;; In XEmacs, input will go to frame A. This may be a bug in one of the
 400 ;; Emacsen, but also may be a design decision.
 401 ;; Also, in Emacs sending input to frame B generates handle-switch-frame
 402 ;; event, while in XEmacs it doesn't.
 403 ;; All this accounts for the difference in the behavior of
 404 ;; vip-mouse-click-* commands when you click in a frame other than the one
 405 ;; that was the last to receive input. In Emacs, focus will be in frame A
 406 ;; until you do something other than vip-mouse-click-* command.
 407 ;; In XEmacs, you have to manually select frame B (with the mouse click) in
 408 ;; order to shift focus to frame B.
 409 (defsubst vip-remember-current-frame (frame)
 410   (setq last-command 'handle-switch-frame
 411         vip-current-frame-saved (selected-frame)))
 412
 413
 414 (cond ((vip-window-display-p)
 415        (let* ((search-key (if vip-xemacs-p [(meta button1up)] [S-mouse-1]))
 416               (search-key-catch (if vip-xemacs-p
 417                                     [(meta button1)] [S-down-mouse-1]))
 418               (insert-key (if vip-xemacs-p [(meta button2up)] [S-mouse-2]))
 419               (insert-key-catch (if vip-xemacs-p
 420                                     [(meta button2)] [S-down-mouse-2]))
 421               (search-key-unbound (and (not (key-binding search-key))
 422                                        (not (key-binding search-key-catch))))
 423               (insert-key-unbound (and (not (key-binding insert-key))
 424                                        (not (key-binding insert-key-catch))))
 425               )
 426
 427          (if search-key-unbound
 428              (global-set-key search-key 'vip-mouse-click-search-word))
 429          (if insert-key-unbound
 430              (global-set-key insert-key 'vip-mouse-click-insert-word))
 431
 432          ;; The following would be needed if you want to use the above two
 433          ;; while clicking in another frame. If you only want to use them
 434          ;; by clicking in another window, not frame, the bindings below
 435          ;; aren't necessary.
 436
 437          ;; These must be bound to mouse-down event for the same mouse
 438          ;; buttons as 'vip-mouse-click-search-word and
 439          ;; 'vip-mouse-click-insert-word
 440          (if search-key-unbound
 441              (global-set-key search-key-catch   'vip-mouse-catch-frame-switch))
 442          (if insert-key-unbound
 443              (global-set-key insert-key-catch   'vip-mouse-catch-frame-switch))
 444
 445          (if vip-xemacs-p
 446              (add-hook 'mouse-leave-frame-hook
 447                        'vip-remember-current-frame)
 448            (defadvice handle-switch-frame (before vip-frame-advice activate)
 449              "Remember the selected frame before the switch-frame event."
 450              (vip-remember-current-frame (selected-frame))))
 451        )))
 452
 453
 454
 455 (provide 'viper-mous)
 456
 457 ;;;  viper-mous.el ends here