X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3f32656c46e560ae10199839b417450a9dfcc839..0925c80cd3d8f9a973d699fc1dbdbe79cca62988:/lisp/avoid.el diff --git a/lisp/avoid.el b/lisp/avoid.el index 46970a7a20..e99d09d675 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -1,10 +1,10 @@ -;;; avoid.el -- make mouse pointer stay out of the way of editing. +;;; avoid.el --- make mouse pointer stay out of the way of editing -;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2000, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. -;; Author: Boris Goldowsky +;; Author: Boris Goldowsky ;; Keywords: mouse -;; Version: 1.10 ;; This file is part of GNU Emacs. @@ -19,108 +19,149 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;;; -;;; For those who are annoyed by the mouse pointer obscuring text, -;;; this mode moves the mouse pointer - either just a little out of -;;; the way, or all the way to the corner of the frame. -;;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . -;;; To set up permanently, put this file on your load-path and put the -;;; following in your .emacs: -;;; -;;; (cond (window-system -;;; (require 'avoid) -;;; (mouse-avoidance-mode 'animate))) -;;; -;;; The 'animate can be 'jump or 'banish or 'exile or 'protean if you prefer. -;;; See the documentation for function `mouse-avoidance-mode' for -;;; details of the different modes. -;;; -;;; For added silliness, make the animatee animate... -;;; put something similar to the following into your .emacs: -;;; -;;; (cond (window-system -;;; (setq x-pointer-shape -;;; (eval (nth (random 4) -;;; '(x-pointer-man x-pointer-spider -;;; x-pointer-gobbler x-pointer-gumby)))) -;;; (set-mouse-color (cdr (assoc 'mouse-color (frame-parameters)))))) -;;; -;;; For completely random pointer shape, replace the setq above with: -;;; (setq x-pointer-shape (mouse-avoidance-random-shape)) -;;; -;;; Bugs / Warnings / To-Do: -;;; -;;; - Using this code does slow emacs down. "banish" mode shouldn't -;;; ever be too bad though, and on my workstation even "animate" doesn't -;;; seem to have a noticable effect during editing. -;;; -;;; - It should find out where any overlapping frames are and avoid them, -;;; rather than always raising the frame. - -;;; Credits: -;;; This code was helped by all those who contributed suggestions, -;;; fixes, and additions -;;; Joe Harrington (and his advisor), for the original inspiration. -;;; Ken Manheimer, for dreaming up the Protean mode. -;;; Richard Stallman, for the awful cat-and-mouse pun, among other things. -;;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris, -;;; Simon Marshall, and M.S. Ashton, for their feedback. -;;; + +;; For those who are annoyed by the mouse pointer obscuring text, +;; this mode moves the mouse pointer - either just a little out of +;; the way, or all the way to the corner of the frame. +;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . +;; To set up permanently, put the following in your .emacs: +;; +;; (if (display-mouse-p) (mouse-avoidance-mode 'animate)) +;; +;; Other legitimate alternatives include +;; `banish', `exile', `jump', `cat-and-mouse', and `proteus'. +;; They do somewhat different things. +;; See the documentation for function `mouse-avoidance-mode' for +;; details of the different modes. +;; +;; For added silliness, make the animatee animate... +;; put something similar to the following into your .emacs: +;; +;; (if (eq window-system 'x) +;; (mouse-avoidance-set-pointer-shape +;; (eval (nth (random 4) +;; '(x-pointer-man x-pointer-spider +;; x-pointer-gobbler x-pointer-gumby))))) +;; +;; For completely random pointer shape, replace the setq above with: +;; (setq x-pointer-shape (mouse-avoidance-random-shape)) +;; +;; Bugs / Warnings / To-Do: +;; +;; - Using this code does slow Emacs down. "banish" mode shouldn't +;; be too bad, and on my workstation even "animate" is reasonable. +;; +;; - It ought to find out where any overlapping frames are and avoid them, +;; rather than always raising the frame. + +;; Credits: +;; This code was helped by all those who contributed suggestions, +;; fixes, and additions +;; Joe Harrington (and his advisor), for the original inspiration. +;; Ken Manheimer, for dreaming up the Protean mode. +;; Richard Stallman, for the awful cat-and-mouse pun, among other things. +;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris, +;; Simon Marshall, and M.S. Ashton, for their feedback. + ;;; Code: (provide 'avoid) -(defvar mouse-avoidance-mode nil - "Value is t or a symbol if the mouse pointer should avoid the cursor. -See function `mouse-avoidance-mode' for possible values. Changing this -variable is NOT the recommended way to change modes; use that function -instead.") - -(defvar mouse-avoidance-nudge-dist 15 +(defgroup avoid nil + "Make mouse pointer stay out of the way of editing." + :prefix "mouse-avoidance-" + :group 'mouse) + +;;;###autoload +(defcustom mouse-avoidance-mode nil + "Activate mouse avoidance mode. +See function `mouse-avoidance-mode' for possible values. +Setting this variable directly does not take effect; +use either \\[customize] or the function `mouse-avoidance-mode'." + :set (lambda (symbol value) + ;; 'none below prevents toggling when value is nil. + (mouse-avoidance-mode (or value 'none))) + :initialize 'custom-initialize-default + :type '(choice (const :tag "none" nil) (const banish) (const jump) + (const animate) (const exile) (const proteus) + ) + :group 'avoid + :require 'avoid + :version "20.3") + + +(defcustom mouse-avoidance-nudge-dist 15 "*Average distance that mouse will be moved when approached by cursor. -Only applies in mode-avoidance-mode `jump' and its derivatives. -For best results make this larger than `mouse-avoidance-threshhold'.") - -(defvar mouse-avoidance-nudge-var 10 - "*Variability of `mouse-avoidance-nudge-dist' (which see).") - -(defvar mouse-avoidance-animation-delay .01 - "Delay between animation steps, in seconds.") - -(defvar mouse-avoidance-threshhold 5 +Only applies in Mouse-Avoidance mode `jump' and its derivatives. +For best results make this larger than `mouse-avoidance-threshold'." + :type 'integer + :group 'avoid) + +(defcustom mouse-avoidance-nudge-var 10 + "*Variability of `mouse-avoidance-nudge-dist' (which see)." + :type 'integer + :group 'avoid) + +(defcustom mouse-avoidance-animation-delay .01 + "Delay between animation steps, in seconds." + :type 'number + :group 'avoid) + +(defcustom mouse-avoidance-threshold 5 "*Mouse-pointer's flight distance. If the cursor gets closer than this, the mouse pointer will move away. -Only applies in mouse-avoidance-modes `animate' and `jump'.") +Only applies in mouse-avoidance-modes `animate' and `jump'." + :type 'integer + :group 'avoid) ;; Internal variables (defvar mouse-avoidance-state nil) (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) +(defvar mouse-avoidance-old-pointer-shape nil) + +;; This timer is used to run something when Emacs is idle. +(defvar mouse-avoidance-timer nil) ;;; Functions: +(defsubst mouse-avoidance-set-pointer-shape (shape) + "Set the shape of the mouse pointer to SHAPE." + (when (boundp 'x-pointer-shape) + (setq x-pointer-shape shape) + (set-mouse-color nil))) + (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). -Analogous to mouse-position." +Analogous to `mouse-position'." (let* ((w (selected-window)) - (edges (window-edges w)) - (list - (compute-motion (window-start w) ; start pos - (cons (car edges) (car (cdr edges))) ; start XY + (edges (window-inside-edges w)) + (list + (compute-motion (max (window-start w) (point-min)) ; start pos + ;; window-start can be < point-min if the + ;; latter has changed since the last redisplay + '(0 . 0) ; start XY (point) ; stop pos - (cons (nth 2 edges) (nth 3 edges)) ; stop XY: none - (1- (window-width)) ; width - (cons (window-hscroll w) 0) ; 0 may not be right? + nil ; stop XY: none + nil ; width + (cons (window-hscroll w) 0) ; 0 may not be right? (selected-window)))) ;; compute-motion returns (pos HPOS VPOS prevhpos contin) ;; we want: (frame hpos . vpos) - (setcar list (selected-frame)) - (setcdr (cdr list) (car (cdr (cdr list)))) - list)) + (cons (selected-frame) + (cons (+ (car edges) (car (cdr list))) + (+ (car (cdr edges)) (car (cdr (cdr list)))))))) + +;(defun mouse-avoidance-point-position-test () +; (interactive) +; (message (format "point=%s mouse=%s" +; (cdr (mouse-avoidance-point-position)) +; (cdr (mouse-position))))) (defun mouse-avoidance-set-mouse-position (pos) ;; Carefully set mouse position to given position (X . Y) @@ -132,23 +173,33 @@ Analogous to mouse-position." (raise-frame f) (set-mouse-position f (car pos) (cdr pos)) t)) - + (defun mouse-avoidance-too-close-p (mouse) - ;; Return t if mouse pointer and point cursor are too close. - ;; Acceptable distance is defined by mouse-avoidance-threshhold. - (let ((point (mouse-avoidance-point-position))) - (and (eq (car mouse) (car point)) - (car (cdr mouse)) - (< (abs (- (car (cdr mouse)) (car (cdr point)))) - mouse-avoidance-threshhold) - (< (abs (- (cdr (cdr mouse)) (cdr (cdr point)))) - mouse-avoidance-threshhold)))) + "Return t if mouse pointer and point cursor are too close. +MOUSE is the current mouse position as returned by `mouse-position'. +Acceptable distance is defined by `mouse-avoidance-threshold'." + (let* ((frame (car mouse)) + (mouse-y (cdr (cdr mouse))) + (tool-bar-lines (frame-parameter nil 'tool-bar-lines))) + (or tool-bar-lines + (setq tool-bar-lines 0)) + (if (and mouse-y (< mouse-y tool-bar-lines)) + nil + (let ((point (mouse-avoidance-point-position)) + (mouse-x (car (cdr mouse)))) + (and (eq frame (car point)) + (not (null mouse-x)) + (< (abs (- mouse-x (car (cdr point)))) + mouse-avoidance-threshold) + (< (abs (- mouse-y (cdr (cdr point)))) + mouse-avoidance-threshold)))))) (defun mouse-avoidance-banish-destination () - "The position to which mouse-avoidance-mode `banish' moves the mouse. + "The position to which Mouse-Avoidance mode `banish' moves the mouse. You can redefine this if you want the mouse banished to a different corner." - (cons (1- (frame-width)) - 0)) + (let* ((pos (window-edges))) + (cons (- (nth 2 pos) 2) + (nth 1 pos)))) (defun mouse-avoidance-banish-mouse () ;; Put the mouse pointer in the upper-right corner of the current frame. @@ -159,7 +210,7 @@ You can redefine this if you want the mouse banished to a different corner." ;; Args are the CURRENT location, the desired DELTA for ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY ;; in distance allowed, and the MIN and MAX possible window positions. - ;; Returns something as close to DELTA as possible withing the constraints. + ;; Returns something as close to DELTA as possible within the constraints. (let ((L1 (max (- min cur) (+ (- dist) (- var)))) (R1 (+ (- dist) var )) (L2 (+ dist (- var))) @@ -175,39 +226,42 @@ You can redefine this if you want the mouse banished to a different corner." ((or R1 L2)) (t 0)))) -(defun mouse-avoidance-nudge-mouse () - ;; Push the mouse a little way away, possibly animating the move +(defun mouse-avoidance-nudge-mouse () + ;; Push the mouse a little way away, possibly animating the move. ;; For these modes, state keeps track of the total offset that we've ;; accumulated, and tries to keep it close to zero. (let* ((cur (mouse-position)) (cur-frame (car cur)) (cur-pos (cdr cur)) - (deltax (mouse-avoidance-delta + (pos (window-edges)) + (wleft (pop pos)) + (wtop (pop pos)) + (wright (pop pos)) + (wbot (pop pos)) + (deltax (mouse-avoidance-delta (car cur-pos) (- (random mouse-avoidance-nudge-var) (car mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-width))) - (deltay (mouse-avoidance-delta + wleft (1- wright))) + (deltay (mouse-avoidance-delta (cdr cur-pos) (- (random mouse-avoidance-nudge-var) (cdr mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-height)))) + wtop (1- wbot)))) (setq mouse-avoidance-state (cons (+ (car mouse-avoidance-state) deltax) (+ (cdr mouse-avoidance-state) deltay))) - (if (or (eq mouse-avoidance-mode 'animate) + (if (or (eq mouse-avoidance-mode 'animate) (eq mouse-avoidance-mode 'proteus)) - (let ((i 0.0) - (color (cdr (assoc 'mouse-color (frame-parameters))))) + (let ((i 0.0)) (while (<= i 1) - (mouse-avoidance-set-mouse-position + (mouse-avoidance-set-mouse-position (cons (+ (car cur-pos) (round (* i deltax))) (+ (cdr cur-pos) (round (* i deltay))))) (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) (if (eq mouse-avoidance-mode 'proteus) - (progn - (setq x-pointer-shape (mouse-avoidance-random-shape)) - (set-mouse-color color))) + (mouse-avoidance-set-pointer-shape + (mouse-avoidance-random-shape))) (sit-for mouse-avoidance-animation-delay))) (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) @@ -220,26 +274,44 @@ redefine this function to suit your own tastes." (if (null mouse-avoidance-pointer-shapes) (progn (setq mouse-avoidance-pointer-shapes - (mapcar '(lambda (x) (symbol-value (intern x))) + (mapcar (lambda (x) (symbol-value (intern x))) (all-completions "x-pointer-" obarray - '(lambda (x) + (lambda (x) (and (boundp x) (integerp (symbol-value x))))))) - (setq mouse-avoidance-n-pointer-shapes + (setq mouse-avoidance-n-pointer-shapes (length mouse-avoidance-pointer-shapes)))) (nth (random mouse-avoidance-n-pointer-shapes) mouse-avoidance-pointer-shapes)) +(defun mouse-avoidance-ignore-p () + (let ((mp (mouse-position))) + (or executing-kbd-macro ; don't check inside macro + (null (cadr mp)) ; don't move unless in an Emacs frame + (not (eq (car mp) (selected-frame))) + ;; Don't do anything if last event was a mouse event. + ;; FIXME: this code fails in the case where the mouse was moved + ;; since the last key-press but without generating any event. + (and (consp last-input-event) + (symbolp (car last-input-event)) + (let ((modifiers (event-modifiers (car last-input-event)))) + (or (memq (car last-input-event) + '(mouse-movement scroll-bar-movement + select-window switch-frame)) + (memq 'click modifiers) + (memq 'double modifiers) + (memq 'triple modifiers) + (memq 'drag modifiers) + (memq 'down modifiers))))))) + (defun mouse-avoidance-banish-hook () - (if (and (not executing-kbd-macro) ; don't check inside macro - (mouse-avoidance-kbd-command (this-command-keys))) + (if (not (mouse-avoidance-ignore-p)) (mouse-avoidance-banish-mouse))) (defun mouse-avoidance-exile-hook () ;; For exile mode, the state is nil when the mouse is in its normal ;; position, and set to the old mouse-position when the mouse is in exile. - (if (and (not executing-kbd-macro) - (mouse-avoidance-kbd-command (this-command-keys))) + (if (not (mouse-avoidance-ignore-p)) (let ((mp (mouse-position))) (cond ((and (not mouse-avoidance-state) (mouse-avoidance-too-close-p mp)) @@ -257,41 +329,25 @@ redefine this function to suit your own tastes." (defun mouse-avoidance-fancy-hook () ;; Used for the "fancy" modes, ie jump et al. - (if (and (not executing-kbd-macro) ; don't check inside macro - (mouse-avoidance-kbd-command (this-command-keys)) + (if (and (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) (let ((old-pos (mouse-position))) (mouse-avoidance-nudge-mouse) - (if (not (eq (selected-frame) (car old-pos))) ; move went awry - (set-mouse-position old-pos (car old-pos) ; sigh.. - (car (cdr old-pos)) - (cdr (cdr old-pos))))))) - -(defun mouse-avoidance-kbd-command (key) - "Return t if the KEYSEQENCE is composed of keyboard events only. -Return nil if there are any lists in the key sequence." - (cond ((null key) nil) ; Null event seems to be - ; returned occasionally. - ((not (vectorp key)) t) ; Strings are keyboard events. - ((catch 'done - (let ((i 0) - (l (length key))) - (while (< i l) - (if (listp (aref key i)) - (throw 'done nil)) - (setq i (1+ i)))) - t)))) + (if (not (eq (selected-frame) (car old-pos))) + ;; This should never happen. + (apply 'set-mouse-position old-pos))))) +;;;###autoload (defun mouse-avoidance-mode (&optional mode) "Set cursor avoidance mode to MODE. MODE should be one of the symbols `banish', `exile', `jump', `animate', `cat-and-mouse', `proteus', or `none'. -If MODE is nil, toggle mouse avoidance between `none` and `banish' +If MODE is nil, toggle mouse avoidance between `none' and `banish' modes. Positive numbers and symbols other than the above are treated as equivalent to `banish'; negative numbers and `-' are equivalent to `none'. -Effects of the different modes: +Effects of the different modes: * banish: Move the mouse to the upper-right corner on any keypress. * exile: Move the mouse to the corner only if the cursor gets too close, and allow it to return once the cursor is out of the way. @@ -303,7 +359,7 @@ Effects of the different modes: Whenever the mouse is moved, the frame is also raised. -\(see `mouse-avoidance-threshhold' for definition of \"too close\", +\(see `mouse-avoidance-threshold' for definition of \"too close\", and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for definition of \"random distance\".)" (interactive @@ -314,35 +370,50 @@ definition of \"random distance\".)" nil t)))) (if (eq mode 'cat-and-mouse) (setq mode 'animate)) - (setq post-command-hook - (delete 'mouse-avoidance-banish-hook (append post-command-hook nil))) - (setq post-command-hook - (delete 'mouse-avoidance-exile-hook (append post-command-hook nil))) - (setq post-command-hook - (delete 'mouse-avoidance-fancy-hook (append post-command-hook nil))) + (if mouse-avoidance-timer + (cancel-timer mouse-avoidance-timer)) + (setq mouse-avoidance-timer nil) + + ;; Restore pointer shape if necessary + (if (eq mouse-avoidance-mode 'proteus) + (mouse-avoidance-set-pointer-shape mouse-avoidance-old-pointer-shape)) + + ;; Do additional setup depending on version of mode requested (cond ((eq mode 'none) (setq mouse-avoidance-mode nil)) ((or (eq mode 'jump) (eq mode 'animate) (eq mode 'proteus)) - (add-hook 'post-command-hook 'mouse-avoidance-fancy-hook) + (setq mouse-avoidance-timer + (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy-hook)) (setq mouse-avoidance-mode mode - mouse-avoidance-state (cons 0 0))) + mouse-avoidance-state (cons 0 0) + mouse-avoidance-old-pointer-shape + (and (boundp 'x-pointer-shape) x-pointer-shape))) ((eq mode 'exile) - (add-hook 'post-command-hook 'mouse-avoidance-exile-hook) + (setq mouse-avoidance-timer + (run-with-idle-timer 0.1 t 'mouse-avoidance-exile-hook)) (setq mouse-avoidance-mode mode mouse-avoidance-state nil)) - ((or (eq mode 'banish) + ((or (eq mode 'banish) (eq mode t) (and (null mode) (null mouse-avoidance-mode)) (and mode (> (prefix-numeric-value mode) 0))) - (add-hook 'post-command-hook 'mouse-avoidance-banish-hook) + (setq mouse-avoidance-timer + (run-with-idle-timer 0.1 t 'mouse-avoidance-banish-hook)) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil))) (force-mode-line-update)) -(or (assq 'mouse-avoidance-mode minor-mode-alist) - (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") - minor-mode-alist))) +;; Most people who use avoid mode leave it on all the time, so it's not +;; very informative to announce it in the mode line. +;;(or (assq 'mouse-avoidance-mode minor-mode-alist) +;; (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") +;; minor-mode-alist))) + +;; Needed for custom. +(if mouse-avoidance-mode + (mouse-avoidance-mode mouse-avoidance-mode)) -;;; End of avoid.el +;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 +;;; avoid.el ends here