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