1;;; avoid.el -- make mouse pointer stay out of the way of editing. 2 3;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 4 5;; Author: Boris Goldowsky <boris@cs.rochester.edu> 6;; Keywords: mouse 7;; Version: 1.10 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to 23;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 25;;; Commentary: 26;;; 27;;; For those who are annoyed by the mouse pointer obscuring text, 28;;; this mode moves the mouse pointer - either just a little out of 29;;; the way, or all the way to the corner of the frame. 30;;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . 31;;; To set up permanently, put this file on your load-path and put the 32;;; following in your .emacs: 33;;; 34;;; (cond (window-system 35;;; (require 'avoid) 36;;; (mouse-avoidance-mode 'animate))) 37;;; 38;;; The 'animate can be 'jump or 'banish or 'exile or 'protean if you prefer. 39;;; See the documentation for function `mouse-avoidance-mode' for 40;;; details of the different modes. 41;;; 42;;; For added silliness, make the animatee animate... 43;;; put something similar to the following into your .emacs: 44;;; 45;;; (cond (window-system 46;;; (setq x-pointer-shape 47;;; (eval (nth (random 4) 48;;; '(x-pointer-man x-pointer-spider 49;;; x-pointer-gobbler x-pointer-gumby)))) 50;;; (set-mouse-color (cdr (assoc 'mouse-color (frame-parameters)))))) 51;;; 52;;; For completely random pointer shape, replace the setq above with: 53;;; (setq x-pointer-shape (mouse-avoidance-random-shape)) 54;;; 55;;; Bugs / Warnings / To-Do: 56;;; 57;;; - Using this code does slow emacs down. "banish" mode shouldn't 58;;; ever be too bad though, and on my workstation even "animate" doesn't 59;;; seem to have a noticable effect during editing. 60;;; 61;;; - It should find out where any overlapping frames are and avoid them, 62;;; rather than always raising the frame. 63 64;;; Credits: 65;;; This code was helped by all those who contributed suggestions, 66;;; fixes, and additions 67;;; Joe Harrington (and his advisor), for the original inspiration. 68;;; Ken Manheimer, for dreaming up the Protean mode. 69;;; Richard Stallman, for the awful cat-and-mouse pun, among other things. 70;;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris, 71;;; Simon Marshall, and M.S. Ashton, for their feedback. 72;;; 73;;; Code: 74 75(provide 'avoid) 76 77(defvar mouse-avoidance-mode nil 78 "Value is t or a symbol if the mouse pointer should avoid the cursor. 79See function `mouse-avoidance-mode' for possible values. Changing this 80variable is NOT the recommended way to change modes; use that function 81instead.") 82 83(defvar mouse-avoidance-nudge-dist 15 84 "*Average distance that mouse will be moved when approached by cursor. 85Only applies in mouse-avoidance-mode `jump' and its derivatives. 86For best results make this larger than `mouse-avoidance-threshhold'.") 87 88(defvar mouse-avoidance-nudge-var 10 89 "*Variability of `mouse-avoidance-nudge-dist' (which see).") 90 91(defvar mouse-avoidance-animation-delay .01 92 "Delay between animation steps, in seconds.") 93 94(defvar mouse-avoidance-threshhold 5 95 "*Mouse-pointer's flight distance. 96If the cursor gets closer than this, the mouse pointer will move away. 97Only applies in mouse-avoidance-modes `animate' and `jump'.") 98 99;; Internal variables 100(defvar mouse-avoidance-state nil) 101(defvar mouse-avoidance-pointer-shapes nil) 102(defvar mouse-avoidance-n-pointer-shapes 0) 103 104;;; Functions: 105 106(defun mouse-avoidance-point-position () 107 "Return the position of point as (FRAME X . Y). 108Analogous to mouse-position." 109 (let* ((w (selected-window)) 110 (edges (window-edges w)) 111 (list 112 (compute-motion (window-start w) ; start pos 113 (cons (car edges) (car (cdr edges))) ; start XY 114 (point) ; stop pos 115 (cons (nth 2 edges) (nth 3 edges)) ; stop XY: none 116 (1- (window-width)) ; width 117 (cons (window-hscroll w) 0) ; 0 may not be right? 118 (selected-window)))) 119 ;; compute-motion returns (pos HPOS VPOS prevhpos contin) 120 ;; we want: (frame hpos . vpos) 121 (setcar list (selected-frame)) 122 (setcdr (cdr list) (car (cdr (cdr list)))) 123 list)) 124 125(defun mouse-avoidance-set-mouse-position (pos) 126 ;; Carefully set mouse position to given position (X . Y) 127 ;; Ideally, should check if X,Y is in the current frame, and if not, 128 ;; leave the mouse where it was. However, this is currently 129 ;; difficult to do, so we just raise the frame to avoid frame switches. 130 ;; Returns t if it moved the mouse. 131 (let ((f (selected-frame))) 132 (raise-frame f) 133 (set-mouse-position f (car pos) (cdr pos)) 134 t)) 135 136(defun mouse-avoidance-too-close-p (mouse) 137 ;; Return t if mouse pointer and point cursor are too close. 138 ;; Acceptable distance is defined by mouse-avoidance-threshhold. 139 (let ((point (mouse-avoidance-point-position))) 140 (and (eq (car mouse) (car point)) 141 (car (cdr mouse)) 142 (< (abs (- (car (cdr mouse)) (car (cdr point)))) 143 mouse-avoidance-threshhold) 144 (< (abs (- (cdr (cdr mouse)) (cdr (cdr point)))) 145 mouse-avoidance-threshhold)))) 146 147(defun mouse-avoidance-banish-destination () 148 "The position to which mouse-avoidance-mode `banish' moves the mouse. 149You can redefine this if you want the mouse banished to a different corner." 150 (cons (1- (frame-width)) 151 0)) 152 153(defun mouse-avoidance-banish-mouse () 154 ;; Put the mouse pointer in the upper-right corner of the current frame. 155 (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination))) 156 157(defsubst mouse-avoidance-delta (cur delta dist var min max) 158 ;; Decide how far to move in either dimension. 159 ;; Args are the CURRENT location, the desired DELTA for 160 ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY 161 ;; in distance allowed, and the MIN and MAX possible window positions. 162 ;; Returns something as close to DELTA as possible withing the constraints. 163 (let ((L1 (max (- min cur) (+ (- dist) (- var)))) 164 (R1 (+ (- dist) var )) 165 (L2 (+ dist (- var))) 166 (R2 (min (- max cur) (+ dist var)))) 167 (if (< R1 (- min cur)) (setq L1 nil R1 nil)) 168 (if (> L2 (- max cur)) (setq L2 nil R2 nil)) 169 (cond ((and L1 (< delta L1)) L1) 170 ((and R1 (< delta R1)) delta) 171 ((and R1 (< delta 0)) R1) 172 ((and L2 (< delta L2)) L2) 173 ((and R2 (< delta R2)) delta) 174 (R2) 175 ((or R1 L2)) 176 (t 0)))) 177 178(defun mouse-avoidance-nudge-mouse () 179 ;; Push the mouse a little way away, possibly animating the move 180 ;; For these modes, state keeps track of the total offset that we've 181 ;; accumulated, and tries to keep it close to zero. 182 (let* ((cur (mouse-position)) 183 (cur-frame (car cur)) 184 (cur-pos (cdr cur)) 185 (deltax (mouse-avoidance-delta 186 (car cur-pos) (- (random mouse-avoidance-nudge-var) 187 (car mouse-avoidance-state)) 188 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 189 0 (frame-width))) 190 (deltay (mouse-avoidance-delta 191 (cdr cur-pos) (- (random mouse-avoidance-nudge-var) 192 (cdr mouse-avoidance-state)) 193 mouse-avoidance-nudge-dist mouse-avoidance-nudge-var 194 0 (frame-height)))) 195 (setq mouse-avoidance-state 196 (cons (+ (car mouse-avoidance-state) deltax) 197 (+ (cdr mouse-avoidance-state) deltay))) 198 (if (or (eq mouse-avoidance-mode 'animate) 199 (eq mouse-avoidance-mode 'proteus)) 200 (let ((i 0.0) 201 (color (cdr (assoc 'mouse-color (frame-parameters))))) 202 (while (<= i 1) 203 (mouse-avoidance-set-mouse-position 204 (cons (+ (car cur-pos) (round (* i deltax))) 205 (+ (cdr cur-pos) (round (* i deltay))))) 206 (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) 207 (if (eq mouse-avoidance-mode 'proteus) 208 (progn 209 (setq x-pointer-shape (mouse-avoidance-random-shape)) 210 (set-mouse-color color))) 211 (sit-for mouse-avoidance-animation-delay))) 212 (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) 213 (+ (cdr (cdr cur)) deltay)))))) 214 215(defun mouse-avoidance-random-shape () 216 "Return a random cursor shape. 217This assumes that any variable whose name begins with x-pointer- and 218has an integer value is a valid cursor shape. You might want to 219redefine this function to suit your own tastes." 220 (if (null mouse-avoidance-pointer-shapes) 221 (progn 222 (setq mouse-avoidance-pointer-shapes 223 (mapcar '(lambda (x) (symbol-value (intern x))) 224 (all-completions "x-pointer-" obarray 225 '(lambda (x) 226 (and (boundp x) 227 (integerp (symbol-value x))))))) 228 (setq mouse-avoidance-n-pointer-shapes 229 (length mouse-avoidance-pointer-shapes)))) 230 (nth (random mouse-avoidance-n-pointer-shapes) 231 mouse-avoidance-pointer-shapes)) 232 233(defun mouse-avoidance-banish-hook () 234 (if (and (not executing-kbd-macro) ; don't check inside macro 235 (mouse-avoidance-kbd-command (this-command-keys))) 236 (mouse-avoidance-banish-mouse))) 237 238(defun mouse-avoidance-exile-hook () 239 ;; For exile mode, the state is nil when the mouse is in its normal 240 ;; position, and set to the old mouse-position when the mouse is in exile. 241 (if (and (not executing-kbd-macro) 242 (mouse-avoidance-kbd-command (this-command-keys))) 243 (let ((mp (mouse-position))) 244 (cond ((and (not mouse-avoidance-state) 245 (mouse-avoidance-too-close-p mp)) 246 (setq mouse-avoidance-state mp) 247 (mouse-avoidance-banish-mouse)) 248 ((and mouse-avoidance-state 249 (not (mouse-avoidance-too-close-p mouse-avoidance-state))) 250 (if (and (eq (car mp) (selected-frame)) 251 (equal (cdr mp) (mouse-avoidance-banish-destination))) 252 (mouse-avoidance-set-mouse-position 253 ;; move back only if user has not moved mouse 254 (cdr mouse-avoidance-state))) 255 ;; but clear state anyway, to be ready for another move 256 (setq mouse-avoidance-state nil)))))) 257 258(defun mouse-avoidance-fancy-hook () 259 ;; Used for the "fancy" modes, ie jump et al. 260 (if (and (not executing-kbd-macro) ; don't check inside macro 261 (mouse-avoidance-kbd-command (this-command-keys)) 262 (mouse-avoidance-too-close-p (mouse-position))) 263 (let ((old-pos (mouse-position))) 264 (mouse-avoidance-nudge-mouse) 265 (if (not (eq (selected-frame) (car old-pos))) ; move went awry 266 (set-mouse-position old-pos (car old-pos) ; sigh.. 267 (car (cdr old-pos)) 268 (cdr (cdr old-pos))))))) 269 270(defun mouse-avoidance-kbd-command (key) 271 "Return t if the KEYSEQENCE is composed of keyboard events only. 272Return nil if there are any lists in the key sequence." 273 (cond ((null key) nil) ; Null event seems to be 274 ; returned occasionally. 275 ((not (vectorp key)) t) ; Strings are keyboard events. 276 ((catch 'done 277 (let ((i 0) 278 (l (length key))) 279 (while (< i l) 280 (if (listp (aref key i)) 281 (throw 'done nil)) 282 (setq i (1+ i)))) 283 t)))) 284 285(defun mouse-avoidance-mode (&optional mode) 286 "Set cursor avoidance mode to MODE. 287MODE should be one of the symbols `banish', `exile', `jump', `animate', 288`cat-and-mouse', `proteus', or `none'. 289 290If MODE is nil, toggle mouse avoidance between `none` and `banish' 291modes. Positive numbers and symbols other than the above are treated 292as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. 293 294Effects of the different modes: 295 * banish: Move the mouse to the upper-right corner on any keypress. 296 * exile: Move the mouse to the corner only if the cursor gets too close, 297 and allow it to return once the cursor is out of the way. 298 * jump: If the cursor gets too close to the mouse, displace the mouse 299 a random distance & direction. 300 * animate: As `jump', but shows steps along the way for illusion of motion. 301 * cat-and-mouse: Same as `animate'. 302 * proteus: As `animate', but changes the shape of the mouse pointer too. 303 304Whenever the mouse is moved, the frame is also raised. 305 306\(see `mouse-avoidance-threshhold' for definition of \"too close\", 307and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for 308definition of \"random distance\".)" 309 (interactive 310 (list (intern (completing-read 311 "Select cursor avoidance technique (SPACE for list): " 312 '(("banish") ("exile") ("jump") ("animate") 313 ("cat-and-mouse") ("proteus") ("none")) 314 nil t)))) 315 (if (eq mode 'cat-and-mouse) 316 (setq mode 'animate)) 317 (setq post-command-hook 318 (delete 'mouse-avoidance-banish-hook (append post-command-hook nil))) 319 (setq post-command-hook 320 (delete 'mouse-avoidance-exile-hook (append post-command-hook nil))) 321 (setq post-command-hook 322 (delete 'mouse-avoidance-fancy-hook (append post-command-hook nil))) 323 (cond ((eq mode 'none) 324 (setq mouse-avoidance-mode nil)) 325 ((or (eq mode 'jump) 326 (eq mode 'animate) 327 (eq mode 'proteus)) 328 (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook) 329 (setq mouse-avoidance-mode mode 330 mouse-avoidance-state (cons 0 0))) 331 ((eq mode 'exile) 332 (add-hook 'post-command-hook 'mouse-avoidance-exile-hook) 333 (setq mouse-avoidance-mode mode 334 mouse-avoidance-state nil)) 335 ((or (eq mode 'banish) 336 (eq mode t) 337 (and (null mode) (null mouse-avoidance-mode)) 338 (and mode (> (prefix-numeric-value mode) 0))) 339 (add-hook 'post-command-hook 'mouse-avoidance-banish-hook) 340 (setq mouse-avoidance-mode 'banish)) 341 (t (setq mouse-avoidance-mode nil))) 342 (force-mode-line-update)) 343 344(or (assq 'mouse-avoidance-mode minor-mode-alist) 345 (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") 346 minor-mode-alist))) 347 348;;; End of avoid.el 349