Auto-commit of generated files.
[emacs.git] / lisp / avoid.el
blobc92d456ef0c8589990c81fa8a180b11b6e3f7375
1 ;;; avoid.el --- make mouse pointer stay out of the way of editing
3 ;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc.
5 ;; Author: Boris Goldowsky <boris@gnu.org>
6 ;; Keywords: mouse
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
23 ;;; Commentary:
25 ;; For those who are annoyed by the mouse pointer obscuring text,
26 ;; this mode moves the mouse pointer - either just a little out of
27 ;; the way, or all the way to the corner of the frame.
28 ;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
29 ;; To set up permanently, put the following in your .emacs:
31 ;; (if (display-mouse-p) (mouse-avoidance-mode 'animate))
33 ;; Other legitimate alternatives include
34 ;; `banish', `exile', `jump', `cat-and-mouse', and `proteus'.
35 ;; They do somewhat different things.
36 ;; See the documentation for function `mouse-avoidance-mode' for
37 ;; details of the different modes.
39 ;; For added silliness, make the animatee animate...
40 ;; put something similar to the following into your .emacs:
42 ;; (if (eq window-system 'x)
43 ;; (mouse-avoidance-set-pointer-shape
44 ;; (eval (nth (random 4)
45 ;; '(x-pointer-man x-pointer-spider
46 ;; x-pointer-gobbler x-pointer-gumby)))))
48 ;; For completely random pointer shape, replace the setq above with:
49 ;; (setq x-pointer-shape (mouse-avoidance-random-shape))
51 ;; Bugs / Warnings / To-Do:
53 ;; - Using this code does slow Emacs down. "banish" mode shouldn't
54 ;; be too bad, and on my workstation even "animate" is reasonable.
56 ;; - It ought to find out where any overlapping frames are and avoid them,
57 ;; rather than always raising the frame.
59 ;; Credits:
60 ;; This code was helped by all those who contributed suggestions,
61 ;; fixes, and additions
62 ;; Joe Harrington (and his advisor), for the original inspiration.
63 ;; Ken Manheimer, for dreaming up the Protean mode.
64 ;; Richard Stallman, for the awful cat-and-mouse pun, among other things.
65 ;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris,
66 ;; Simon Marshall, and M.S. Ashton, for their feedback.
68 ;;; Code:
70 (eval-when-compile (require 'cl-lib))
72 (defgroup avoid nil
73 "Make mouse pointer stay out of the way of editing."
74 :prefix "mouse-avoidance-"
75 :group 'mouse)
77 ;;;###autoload
78 (defcustom mouse-avoidance-mode nil
79 "Activate Mouse Avoidance mode.
80 See function `mouse-avoidance-mode' for possible values.
81 Setting this variable directly does not take effect;
82 use either \\[customize] or the function `mouse-avoidance-mode'."
83 :set (lambda (_symbol value)
84 ;; 'none below prevents toggling when value is nil.
85 (mouse-avoidance-mode (or value 'none)))
86 :initialize 'custom-initialize-default
87 :type '(choice (const :tag "none" nil) (const banish) (const jump)
88 (const animate) (const exile) (const proteus))
89 :group 'avoid
90 :require 'avoid
91 :version "20.3")
94 (defcustom mouse-avoidance-nudge-dist 15
95 "Average distance that mouse will be moved when approached by cursor.
96 Only applies in Mouse Avoidance mode `jump' and its derivatives.
97 For best results make this larger than `mouse-avoidance-threshold'."
98 :type 'integer
99 :group 'avoid)
101 (defcustom mouse-avoidance-nudge-var 10
102 "Variability of `mouse-avoidance-nudge-dist' (which see)."
103 :type 'integer
104 :group 'avoid)
106 (defcustom mouse-avoidance-animation-delay .01
107 "Delay between animation steps, in seconds."
108 :type 'number
109 :group 'avoid)
111 (defcustom mouse-avoidance-threshold 5
112 "Mouse-pointer's flight distance.
113 If the cursor gets closer than this, the mouse pointer will move away.
114 Only applies in Mouse Avoidance modes `animate' and `jump'."
115 :type 'integer
116 :group 'avoid)
118 (defcustom mouse-avoidance-banish-position '((frame-or-window . frame)
119 (side . right)
120 (side-pos . 3)
121 (top-or-bottom . top)
122 (top-or-bottom-pos . 0))
123 "Position to which Mouse Avoidance mode `banish' moves the mouse.
124 An alist where keywords mean:
125 FRAME-OR-WINDOW: banish the mouse to corner of frame or window.
126 SIDE: banish the mouse on right or left corner of frame or window.
127 SIDE-POS: Distance from right or left edge of frame or window.
128 TOP-OR-BOTTOM: banish the mouse to top or bottom of frame or window.
129 TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
130 :group 'avoid
131 :version "24.3"
132 :type '(alist :key-type symbol :value-type symbol)
133 :options '(frame-or-window side (side-pos integer)
134 top-or-bottom (top-or-bottom-pos integer)))
136 ;; Internal variables
137 (defvar mouse-avoidance-state nil)
138 (defvar mouse-avoidance-pointer-shapes nil)
139 (defvar mouse-avoidance-n-pointer-shapes 0)
140 (defvar mouse-avoidance-old-pointer-shape nil)
141 (defvar mouse-avoidance-animating-pointer nil)
143 ;; This timer is used to run something when Emacs is idle.
144 (defvar mouse-avoidance-timer nil)
146 ;;; Functions:
148 (defsubst mouse-avoidance-set-pointer-shape (shape)
149 "Set the shape of the mouse pointer to SHAPE."
150 (when (boundp 'x-pointer-shape)
151 (setq x-pointer-shape shape)
152 (set-mouse-color nil)))
154 (defun mouse-avoidance-point-position ()
155 "Return the position of point as (FRAME X . Y).
156 Analogous to `mouse-position'."
157 (let ((edges (window-inside-edges))
158 (x-y (posn-x-y (posn-at-point))))
159 (cons (selected-frame)
160 (cons (+ (car edges)
161 (/ (car x-y) (frame-char-width)))
162 (+ (car (cdr edges))
163 (/ (cdr x-y) (frame-char-height)))))))
165 ;(defun mouse-avoidance-point-position-test ()
166 ; (interactive)
167 ; (message (format "point=%s mouse=%s"
168 ; (cdr (mouse-avoidance-point-position))
169 ; (cdr (mouse-position)))))
171 (defun mouse-avoidance-set-mouse-position (pos)
172 ;; Carefully set mouse position to given position (X . Y)
173 ;; Ideally, should check if X,Y is in the current frame, and if not,
174 ;; leave the mouse where it was. However, this is currently
175 ;; difficult to do, so we just raise the frame to avoid frame switches.
176 ;; Returns t if it moved the mouse.
177 (let ((f (selected-frame)))
178 (raise-frame f)
179 (set-mouse-position f (car pos) (cdr pos))
182 (defun mouse-avoidance-too-close-p (mouse)
183 "Return t if mouse pointer and point cursor are too close.
184 MOUSE is the current mouse position as returned by `mouse-position'.
185 Acceptable distance is defined by `mouse-avoidance-threshold'."
186 (let* ((frame (car mouse))
187 (mouse-y (cdr (cdr mouse)))
188 (tool-bar-lines (frame-parameter nil 'tool-bar-lines)))
189 (or tool-bar-lines
190 (setq tool-bar-lines 0))
191 (if (and mouse-y (< mouse-y tool-bar-lines))
193 (let ((point (mouse-avoidance-point-position))
194 (mouse-x (car (cdr mouse))))
195 (and (eq frame (car point))
196 (not (null mouse-x))
197 (< (abs (- mouse-x (car (cdr point))))
198 mouse-avoidance-threshold)
199 (< (abs (- mouse-y (cdr (cdr point))))
200 mouse-avoidance-threshold))))))
202 (defun mouse-avoidance-banish-destination ()
203 "The position to which Mouse Avoidance mode `banish' moves the mouse.
205 If you want the mouse banished to a different corner set
206 `mouse-avoidance-banish-position' as you need."
207 (let* ((fra-or-win (assoc-default
208 'frame-or-window
209 mouse-avoidance-banish-position 'eq))
210 (list-values (pcase fra-or-win
211 (`frame (list 0 0 (frame-width) (frame-height)))
212 (`window (window-edges))))
213 (alist (cl-loop for v in list-values
214 for k in '(left top right bottom)
215 collect (cons k v)))
216 (side (assoc-default
217 'side
218 mouse-avoidance-banish-position #'eq))
219 (side-dist (assoc-default
220 'side-pos
221 mouse-avoidance-banish-position #'eq))
222 (top-or-bottom (assoc-default
223 'top-or-bottom
224 mouse-avoidance-banish-position #'eq))
225 (top-or-bottom-dist (assoc-default
226 'top-or-bottom-pos
227 mouse-avoidance-banish-position #'eq))
228 (side-fn (pcase side
229 (`left '+)
230 (`right '-)))
231 (top-or-bottom-fn (pcase top-or-bottom
232 (`top '+)
233 (`bottom '-))))
234 (cons (funcall side-fn ; -/+
235 (assoc-default side alist 'eq) ; right or left
236 side-dist) ; distance from side
237 (funcall top-or-bottom-fn ; -/+
238 (assoc-default top-or-bottom alist 'eq) ; top/bottom
239 top-or-bottom-dist)))) ; distance from top/bottom
241 (defun mouse-avoidance-banish-mouse ()
242 "Put the mouse pointer to `mouse-avoidance-banish-position'."
243 (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))
245 (defsubst mouse-avoidance-delta (cur delta dist var min max)
246 ;; Decide how far to move in either dimension.
247 ;; Args are the CURRENT location, the desired DELTA for
248 ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY
249 ;; in distance allowed, and the MIN and MAX possible window positions.
250 ;; Returns something as close to DELTA as possible within the constraints.
251 (let ((L1 (max (- min cur) (+ (- dist) (- var))))
252 (R1 (+ (- dist) var ))
253 (L2 (+ dist (- var)))
254 (R2 (min (- max cur) (+ dist var))))
255 (if (< R1 (- min cur)) (setq L1 nil R1 nil))
256 (if (> L2 (- max cur)) (setq L2 nil R2 nil))
257 (cond ((and L1 (< delta L1)) L1)
258 ((and R1 (< delta R1)) delta)
259 ((and R1 (< delta 0)) R1)
260 ((and L2 (< delta L2)) L2)
261 ((and R2 (< delta R2)) delta)
262 (R2)
263 ((or R1 L2))
264 (t 0))))
266 (defun mouse-avoidance-nudge-mouse ()
267 ;; Push the mouse a little way away, possibly animating the move.
268 ;; For these modes, state keeps track of the total offset that we've
269 ;; accumulated, and tries to keep it close to zero.
270 (let* ((cur (mouse-position))
271 (cur-pos (cdr cur))
272 (pos (window-edges))
273 (wleft (pop pos))
274 (wtop (pop pos))
275 (wright (pop pos))
276 (wbot (pop pos))
277 (deltax (mouse-avoidance-delta
278 (car cur-pos) (- (random mouse-avoidance-nudge-var)
279 (car mouse-avoidance-state))
280 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
281 wleft (1- wright)))
282 (deltay (mouse-avoidance-delta
283 (cdr cur-pos) (- (random mouse-avoidance-nudge-var)
284 (cdr mouse-avoidance-state))
285 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
286 wtop (1- wbot))))
287 (setq mouse-avoidance-state
288 (cons (+ (car mouse-avoidance-state) deltax)
289 (+ (cdr mouse-avoidance-state) deltay)))
290 (if (or (eq mouse-avoidance-mode 'animate)
291 (eq mouse-avoidance-mode 'proteus))
292 (let ((i 0.0)
293 (incr (max .1 (/ 1.0 mouse-avoidance-nudge-dist))))
294 (setq mouse-avoidance-animating-pointer t)
295 (while (<= i 1)
296 (mouse-avoidance-set-mouse-position
297 (cons (+ (car cur-pos) (round (* i deltax)))
298 (+ (cdr cur-pos) (round (* i deltay)))))
299 (setq i (+ i incr))
300 (if (eq mouse-avoidance-mode 'proteus)
301 (mouse-avoidance-set-pointer-shape
302 (mouse-avoidance-random-shape)))
303 (sit-for mouse-avoidance-animation-delay))
304 (setq mouse-avoidance-animating-pointer nil))
305 (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax)
306 (+ (cdr (cdr cur)) deltay))))))
308 (defun mouse-avoidance-random-shape ()
309 "Return a random cursor shape.
310 This assumes that any variable whose name begins with x-pointer- and
311 has an integer value is a valid cursor shape. You might want to
312 redefine this function to suit your own tastes."
313 (if (null mouse-avoidance-pointer-shapes)
314 (progn
315 (setq mouse-avoidance-pointer-shapes
316 (mapcar (lambda (x) (symbol-value (intern x)))
317 (all-completions "x-pointer-" obarray
318 (lambda (x)
319 (and (boundp x)
320 (integerp (symbol-value x)))))))
321 (setq mouse-avoidance-n-pointer-shapes
322 (length mouse-avoidance-pointer-shapes))))
323 (nth (random mouse-avoidance-n-pointer-shapes)
324 mouse-avoidance-pointer-shapes))
326 (defun mouse-avoidance-ignore-p ()
327 (let ((mp (mouse-position)))
328 (or (not (frame-pointer-visible-p)) ; The pointer is hidden
329 (not cursor-type) ; There's no cursor
330 executing-kbd-macro ; don't check inside macro
331 (null (cadr mp)) ; don't move unless in an Emacs frame
332 (not (eq (car mp) (selected-frame)))
333 ;; Don't do anything if last event was a mouse event.
334 ;; FIXME: this code fails in the case where the mouse was moved
335 ;; since the last key-press but without generating any event.
336 (and (consp last-input-event)
337 (symbolp (car last-input-event))
338 (let ((modifiers (event-modifiers (car last-input-event))))
339 (or (memq (car last-input-event)
340 '(mouse-movement scroll-bar-movement
341 select-window switch-frame))
342 (memq 'click modifiers)
343 (memq 'double modifiers)
344 (memq 'triple modifiers)
345 (memq 'drag modifiers)
346 (memq 'down modifiers)))))))
348 (defun mouse-avoidance-banish ()
349 (if (not (mouse-avoidance-ignore-p))
350 (mouse-avoidance-banish-mouse)))
352 (defun mouse-avoidance-exile ()
353 ;; For exile mode, the state is nil when the mouse is in its normal
354 ;; position, and set to the old mouse-position when the mouse is in exile.
355 (if (not (mouse-avoidance-ignore-p))
356 (let ((mp (mouse-position)))
357 (cond ((and (not mouse-avoidance-state)
358 (mouse-avoidance-too-close-p mp))
359 (setq mouse-avoidance-state mp)
360 (mouse-avoidance-banish-mouse))
361 ((and mouse-avoidance-state
362 (not (mouse-avoidance-too-close-p mouse-avoidance-state)))
363 (if (and (eq (car mp) (selected-frame))
364 (equal (cdr mp) (mouse-avoidance-banish-destination)))
365 (mouse-avoidance-set-mouse-position
366 ;; move back only if user has not moved mouse
367 (cdr mouse-avoidance-state)))
368 ;; but clear state anyway, to be ready for another move
369 (setq mouse-avoidance-state nil))))))
371 (defun mouse-avoidance-fancy ()
372 ;; Used for the "fancy" modes, ie jump et al.
373 (if (and (not mouse-avoidance-animating-pointer)
374 (not (mouse-avoidance-ignore-p))
375 (mouse-avoidance-too-close-p (mouse-position)))
376 (let ((old-pos (mouse-position)))
377 (mouse-avoidance-nudge-mouse)
378 (if (not (eq (selected-frame) (car old-pos)))
379 ;; This should never happen.
380 (apply 'set-mouse-position old-pos)))))
382 ;;;###autoload
383 (defun mouse-avoidance-mode (&optional mode)
384 "Set Mouse Avoidance mode to MODE.
385 MODE should be one of the symbols `banish', `exile', `jump', `animate',
386 `cat-and-mouse', `proteus', or `none'.
388 If MODE is nil, toggle mouse avoidance between `none' and `banish'
389 modes. Positive numbers and symbols other than the above are treated
390 as equivalent to `banish'; negative numbers and `-' are equivalent to `none'.
392 Effects of the different modes:
393 * banish: Move the mouse to the upper-right corner on any keypress.
394 * exile: Move the mouse to the corner only if the cursor gets too close,
395 and allow it to return once the cursor is out of the way.
396 * jump: If the cursor gets too close to the mouse, displace the mouse
397 a random distance & direction.
398 * animate: As `jump', but shows steps along the way for illusion of motion.
399 * cat-and-mouse: Same as `animate'.
400 * proteus: As `animate', but changes the shape of the mouse pointer too.
402 Whenever the mouse is moved, the frame is also raised.
404 \(See `mouse-avoidance-threshold' for definition of \"too close\",
405 and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
406 definition of \"random distance\".)"
407 (interactive
408 (list (intern (completing-read
409 "Select cursor avoidance technique (SPACE for list): "
410 '(("banish") ("exile") ("jump") ("animate")
411 ("cat-and-mouse") ("proteus") ("none"))
412 nil t))))
413 (if (eq mode 'cat-and-mouse)
414 (setq mode 'animate))
415 (if mouse-avoidance-timer
416 (cancel-timer mouse-avoidance-timer))
417 (setq mouse-avoidance-timer nil)
419 ;; Restore pointer shape if necessary
420 (if (eq mouse-avoidance-mode 'proteus)
421 (mouse-avoidance-set-pointer-shape mouse-avoidance-old-pointer-shape))
423 ;; Do additional setup depending on version of mode requested
424 (cond ((eq mode 'none)
425 (setq mouse-avoidance-mode nil))
426 ((or (eq mode 'jump)
427 (eq mode 'animate)
428 (eq mode 'proteus))
429 (setq mouse-avoidance-timer
430 (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy))
431 (setq mouse-avoidance-mode mode
432 mouse-avoidance-state (cons 0 0)
433 mouse-avoidance-old-pointer-shape
434 (and (boundp 'x-pointer-shape) x-pointer-shape)))
435 ((eq mode 'exile)
436 (setq mouse-avoidance-timer
437 (run-with-idle-timer 0.1 t 'mouse-avoidance-exile))
438 (setq mouse-avoidance-mode mode
439 mouse-avoidance-state nil))
440 ((or (eq mode 'banish)
441 (eq mode t)
442 (and (null mode) (null mouse-avoidance-mode))
443 (and mode (> (prefix-numeric-value mode) 0)))
444 (setq mouse-avoidance-timer
445 (run-with-idle-timer 0.1 t 'mouse-avoidance-banish))
446 (setq mouse-avoidance-mode 'banish))
447 (t (setq mouse-avoidance-mode nil)))
448 (force-mode-line-update))
450 ;; Most people who use avoid mode leave it on all the time, so it's not
451 ;; very informative to announce it in the mode line.
452 ;;(or (assq 'mouse-avoidance-mode minor-mode-alist)
453 ;; (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid")
454 ;; minor-mode-alist)))
456 ;; Needed for custom.
457 (if mouse-avoidance-mode
458 (mouse-avoidance-mode mouse-avoidance-mode))
460 (provide 'avoid)
462 ;;; avoid.el ends here