lisp/emulation/viper-mous.el

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