Mercurial > emacs
comparison lisp/avoid.el @ 56730:a00d573807f9
(mouse-avoidance-ignore-p): New fun.
Also ignore switch-frame, select-window, double, and triple clicks.
(mouse-avoidance-banish-hook, mouse-avoidance-exile-hook)
(mouse-avoidance-fancy-hook): Use it.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 20 Aug 2004 21:59:42 +0000 |
parents | 0731f4f165af |
children | 6fb026ad601f d8411455de48 |
comparison
equal
deleted
inserted
replaced
56729:e6e0caa7ec87 | 56730:a00d573807f9 |
---|---|
1 ;;; avoid.el --- make mouse pointer stay out of the way of editing | 1 ;;; avoid.el --- make mouse pointer stay out of the way of editing |
2 | 2 |
3 ;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Boris Goldowsky <boris@gnu.org> | 5 ;; Author: Boris Goldowsky <boris@gnu.org> |
6 ;; Keywords: mouse | 6 ;; Keywords: mouse |
7 | 7 |
8 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
50 ;; For completely random pointer shape, replace the setq above with: | 50 ;; For completely random pointer shape, replace the setq above with: |
51 ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) | 51 ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) |
52 ;; | 52 ;; |
53 ;; Bugs / Warnings / To-Do: | 53 ;; Bugs / Warnings / To-Do: |
54 ;; | 54 ;; |
55 ;; - Using this code does slow emacs down. "banish" mode shouldn't | 55 ;; - Using this code does slow Emacs down. "banish" mode shouldn't |
56 ;; be too bad, and on my workstation even "animate" is reasonable. | 56 ;; be too bad, and on my workstation even "animate" is reasonable. |
57 ;; | 57 ;; |
58 ;; - It ought to find out where any overlapping frames are and avoid them, | 58 ;; - It ought to find out where any overlapping frames are and avoid them, |
59 ;; rather than always raising the frame. | 59 ;; rather than always raising the frame. |
60 | 60 |
94 :version "20.3") | 94 :version "20.3") |
95 | 95 |
96 | 96 |
97 (defcustom mouse-avoidance-nudge-dist 15 | 97 (defcustom mouse-avoidance-nudge-dist 15 |
98 "*Average distance that mouse will be moved when approached by cursor. | 98 "*Average distance that mouse will be moved when approached by cursor. |
99 Only applies in mouse-avoidance-mode `jump' and its derivatives. | 99 Only applies in Mouse-Avoidance mode `jump' and its derivatives. |
100 For best results make this larger than `mouse-avoidance-threshold'." | 100 For best results make this larger than `mouse-avoidance-threshold'." |
101 :type 'integer | 101 :type 'integer |
102 :group 'avoid) | 102 :group 'avoid) |
103 | 103 |
104 (defcustom mouse-avoidance-nudge-var 10 | 104 (defcustom mouse-avoidance-nudge-var 10 |
135 (setq x-pointer-shape shape) | 135 (setq x-pointer-shape shape) |
136 (set-mouse-color nil))) | 136 (set-mouse-color nil))) |
137 | 137 |
138 (defun mouse-avoidance-point-position () | 138 (defun mouse-avoidance-point-position () |
139 "Return the position of point as (FRAME X . Y). | 139 "Return the position of point as (FRAME X . Y). |
140 Analogous to mouse-position." | 140 Analogous to `mouse-position'." |
141 (let* ((w (selected-window)) | 141 (let* ((w (selected-window)) |
142 (edges (window-inside-edges w)) | 142 (edges (window-inside-edges w)) |
143 (list | 143 (list |
144 (compute-motion (max (window-start w) (point-min)) ; start pos | 144 (compute-motion (max (window-start w) (point-min)) ; start pos |
145 ;; window-start can be < point-min if the | 145 ;; window-start can be < point-min if the |
192 mouse-avoidance-threshold) | 192 mouse-avoidance-threshold) |
193 (< (abs (- mouse-y (cdr (cdr point)))) | 193 (< (abs (- mouse-y (cdr (cdr point)))) |
194 mouse-avoidance-threshold)))))) | 194 mouse-avoidance-threshold)))))) |
195 | 195 |
196 (defun mouse-avoidance-banish-destination () | 196 (defun mouse-avoidance-banish-destination () |
197 "The position to which mouse-avoidance-mode `banish' moves the mouse. | 197 "The position to which Mouse-Avoidance mode `banish' moves the mouse. |
198 You can redefine this if you want the mouse banished to a different corner." | 198 You can redefine this if you want the mouse banished to a different corner." |
199 (cons (1- (frame-width)) | 199 (let* ((pos (window-edges))) |
200 0)) | 200 (cons (- (nth 2 pos) 2) |
201 (nth 1 pos)))) | |
201 | 202 |
202 (defun mouse-avoidance-banish-mouse () | 203 (defun mouse-avoidance-banish-mouse () |
203 ;; Put the mouse pointer in the upper-right corner of the current frame. | 204 ;; Put the mouse pointer in the upper-right corner of the current frame. |
204 (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination))) | 205 (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination))) |
205 | 206 |
223 (R2) | 224 (R2) |
224 ((or R1 L2)) | 225 ((or R1 L2)) |
225 (t 0)))) | 226 (t 0)))) |
226 | 227 |
227 (defun mouse-avoidance-nudge-mouse () | 228 (defun mouse-avoidance-nudge-mouse () |
228 ;; Push the mouse a little way away, possibly animating the move | 229 ;; Push the mouse a little way away, possibly animating the move. |
229 ;; For these modes, state keeps track of the total offset that we've | 230 ;; For these modes, state keeps track of the total offset that we've |
230 ;; accumulated, and tries to keep it close to zero. | 231 ;; accumulated, and tries to keep it close to zero. |
231 (let* ((cur (mouse-position)) | 232 (let* ((cur (mouse-position)) |
232 (cur-frame (car cur)) | 233 (cur-frame (car cur)) |
233 (cur-pos (cdr cur)) | 234 (cur-pos (cdr cur)) |
235 (pos (window-edges)) | |
236 (wleft (pop pos)) | |
237 (wtop (pop pos)) | |
238 (wright (pop pos)) | |
239 (wbot (pop pos)) | |
234 (deltax (mouse-avoidance-delta | 240 (deltax (mouse-avoidance-delta |
235 (car cur-pos) (- (random mouse-avoidance-nudge-var) | 241 (car cur-pos) (- (random mouse-avoidance-nudge-var) |
236 (car mouse-avoidance-state)) | 242 (car mouse-avoidance-state)) |
237 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var | 243 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
238 0 (frame-width))) | 244 wleft (1- wright))) |
239 (deltay (mouse-avoidance-delta | 245 (deltay (mouse-avoidance-delta |
240 (cdr cur-pos) (- (random mouse-avoidance-nudge-var) | 246 (cdr cur-pos) (- (random mouse-avoidance-nudge-var) |
241 (cdr mouse-avoidance-state)) | 247 (cdr mouse-avoidance-state)) |
242 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var | 248 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
243 0 (frame-height)))) | 249 wtop (1- wbot)))) |
244 (setq mouse-avoidance-state | 250 (setq mouse-avoidance-state |
245 (cons (+ (car mouse-avoidance-state) deltax) | 251 (cons (+ (car mouse-avoidance-state) deltax) |
246 (+ (cdr mouse-avoidance-state) deltay))) | 252 (+ (cdr mouse-avoidance-state) deltay))) |
247 (if (or (eq mouse-avoidance-mode 'animate) | 253 (if (or (eq mouse-avoidance-mode 'animate) |
248 (eq mouse-avoidance-mode 'proteus)) | 254 (eq mouse-avoidance-mode 'proteus)) |
275 (setq mouse-avoidance-n-pointer-shapes | 281 (setq mouse-avoidance-n-pointer-shapes |
276 (length mouse-avoidance-pointer-shapes)))) | 282 (length mouse-avoidance-pointer-shapes)))) |
277 (nth (random mouse-avoidance-n-pointer-shapes) | 283 (nth (random mouse-avoidance-n-pointer-shapes) |
278 mouse-avoidance-pointer-shapes)) | 284 mouse-avoidance-pointer-shapes)) |
279 | 285 |
286 (defun mouse-avoidance-ignore-p () | |
287 (let ((mp (mouse-position))) | |
288 (or executing-kbd-macro ; don't check inside macro | |
289 (null (cadr mp)) ; don't move unless in an Emacs frame | |
290 (not (eq (car mp) (selected-frame))) | |
291 ;; Don't do anything if last event was a mouse event. | |
292 ;; FIXME: this code fails in the case where the mouse was moved | |
293 ;; since the last key-press but without generating any event. | |
294 (and (consp last-input-event) | |
295 (symbolp (car last-input-event)) | |
296 (let ((modifiers (event-modifiers (car last-input-event)))) | |
297 (or (memq (car last-input-event) | |
298 '(mouse-movement scroll-bar-movement | |
299 select-window switch-frame)) | |
300 (memq 'click modifiers) | |
301 (memq 'double modifiers) | |
302 (memq 'triple modifiers) | |
303 (memq 'drag modifiers) | |
304 (memq 'down modifiers))))))) | |
305 | |
280 (defun mouse-avoidance-banish-hook () | 306 (defun mouse-avoidance-banish-hook () |
281 (if (and (not executing-kbd-macro) ; don't check inside macro | 307 (if (not (mouse-avoidance-ignore-p)) |
282 (cadr (mouse-position)) ; don't move unless in an Emacs frame | |
283 ;; Don't do anything if last event was a mouse event. | |
284 (not (and (consp last-input-event) | |
285 (symbolp (car last-input-event)) | |
286 (let ((modifiers (event-modifiers (car last-input-event)))) | |
287 (or (memq (car last-input-event) | |
288 '(mouse-movement scroll-bar-movement)) | |
289 (memq 'click modifiers) | |
290 (memq 'drag modifiers) | |
291 (memq 'down modifiers)))))) | |
292 (mouse-avoidance-banish-mouse))) | 308 (mouse-avoidance-banish-mouse))) |
293 | 309 |
294 (defun mouse-avoidance-exile-hook () | 310 (defun mouse-avoidance-exile-hook () |
295 ;; For exile mode, the state is nil when the mouse is in its normal | 311 ;; For exile mode, the state is nil when the mouse is in its normal |
296 ;; position, and set to the old mouse-position when the mouse is in exile. | 312 ;; position, and set to the old mouse-position when the mouse is in exile. |
297 (if (and (not executing-kbd-macro) | 313 (if (not (mouse-avoidance-ignore-p)) |
298 ;; Don't do anything if last event was a mouse event. | |
299 (not (and (consp last-input-event) | |
300 (symbolp (car last-input-event)) | |
301 (let ((modifiers (event-modifiers (car last-input-event)))) | |
302 (or (memq (car last-input-event) | |
303 '(mouse-movement scroll-bar-movement)) | |
304 (memq 'click modifiers) | |
305 (memq 'drag modifiers) | |
306 (memq 'down modifiers)))))) | |
307 (let ((mp (mouse-position))) | 314 (let ((mp (mouse-position))) |
308 (cond ((and (not mouse-avoidance-state) | 315 (cond ((and (not mouse-avoidance-state) |
309 (mouse-avoidance-too-close-p mp)) | 316 (mouse-avoidance-too-close-p mp)) |
310 (setq mouse-avoidance-state mp) | 317 (setq mouse-avoidance-state mp) |
311 (mouse-avoidance-banish-mouse)) | 318 (mouse-avoidance-banish-mouse)) |
319 ;; but clear state anyway, to be ready for another move | 326 ;; but clear state anyway, to be ready for another move |
320 (setq mouse-avoidance-state nil)))))) | 327 (setq mouse-avoidance-state nil)))))) |
321 | 328 |
322 (defun mouse-avoidance-fancy-hook () | 329 (defun mouse-avoidance-fancy-hook () |
323 ;; Used for the "fancy" modes, ie jump et al. | 330 ;; Used for the "fancy" modes, ie jump et al. |
324 (if (and (not executing-kbd-macro) ; don't check inside macro | 331 (if (and (not (mouse-avoidance-ignore-p)) |
325 ;; Don't do anything if last event was a mouse event. | |
326 (not (and (consp last-input-event) | |
327 (symbolp (car last-input-event)) | |
328 (let ((modifiers (event-modifiers (car last-input-event)))) | |
329 (or (memq (car last-input-event) | |
330 '(mouse-movement scroll-bar-movement)) | |
331 (memq 'click modifiers) | |
332 (memq 'drag modifiers) | |
333 (memq 'down modifiers))))) | |
334 (mouse-avoidance-too-close-p (mouse-position))) | 332 (mouse-avoidance-too-close-p (mouse-position))) |
335 (let ((old-pos (mouse-position))) | 333 (let ((old-pos (mouse-position))) |
336 (mouse-avoidance-nudge-mouse) | 334 (mouse-avoidance-nudge-mouse) |
337 (if (not (eq (selected-frame) (car old-pos))) | 335 (if (not (eq (selected-frame) (car old-pos))) |
338 ;; This should never happen. | 336 ;; This should never happen. |
414 | 412 |
415 ;; Needed for custom. | 413 ;; Needed for custom. |
416 (if mouse-avoidance-mode | 414 (if mouse-avoidance-mode |
417 (mouse-avoidance-mode mouse-avoidance-mode)) | 415 (mouse-avoidance-mode mouse-avoidance-mode)) |
418 | 416 |
419 ;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 | 417 ;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 |
420 ;;; avoid.el ends here | 418 ;;; avoid.el ends here |