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