X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b71f2b97d343dd5ec39b64b66de86051ee47eb3e..a9e3ff690bba45e6723e9d355517767d8b52d41a:/lisp/avoid.el diff --git a/lisp/avoid.el b/lisp/avoid.el index b5e7d1f9b6..dd74a2cd25 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -1,16 +1,17 @@ ;;; avoid.el --- make mouse pointer stay out of the way of editing -;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: mouse ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,9 +19,7 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -95,14 +94,14 @@ use either \\[customize] or the function `mouse-avoidance-mode'." (defcustom mouse-avoidance-nudge-dist 15 - "*Average distance that mouse will be moved when approached by cursor. + "Average distance that mouse will be moved when approached by cursor. 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)." + "Variability of `mouse-avoidance-nudge-dist' (which see)." :type 'integer :group 'avoid) @@ -112,7 +111,7 @@ For best results make this larger than `mouse-avoidance-threshold'." :group 'avoid) (defcustom mouse-avoidance-threshold 5 - "*Mouse-pointer's flight distance. + "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'." :type 'integer @@ -123,6 +122,7 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) (defvar mouse-avoidance-old-pointer-shape nil) +(defvar mouse-avoidance-animating-pointer nil) ;; This timer is used to run something when Emacs is idle. (defvar mouse-avoidance-timer nil) @@ -138,23 +138,13 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). Analogous to `mouse-position'." - (let* ((w (selected-window)) - (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 - 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) + (let ((edges (window-inside-edges)) + (x-y (posn-x-y (posn-at-point)))) (cons (selected-frame) - (cons (+ (car edges) (car (cdr list))) - (+ (car (cdr edges)) (car (cdr (cdr list)))))))) + (cons (+ (car edges) + (/ (car x-y) (frame-char-width))) + (+ (car (cdr edges)) + (/ (cdr x-y) (frame-char-height))))))) ;(defun mouse-avoidance-point-position-test () ; (interactive) @@ -252,16 +242,19 @@ You can redefine this if you want the mouse banished to a different corner." (+ (cdr mouse-avoidance-state) deltay))) (if (or (eq mouse-avoidance-mode 'animate) (eq mouse-avoidance-mode 'proteus)) - (let ((i 0.0)) + (let ((i 0.0) + (incr (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) + (setq mouse-avoidance-animating-pointer t) (while (<= i 1) (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)))) + (setq i (+ i incr)) (if (eq mouse-avoidance-mode 'proteus) (mouse-avoidance-set-pointer-shape (mouse-avoidance-random-shape))) - (sit-for mouse-avoidance-animation-delay))) + (sit-for mouse-avoidance-animation-delay)) + (setq mouse-avoidance-animating-pointer nil)) (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) @@ -303,11 +296,11 @@ redefine this function to suit your own tastes." (memq 'drag modifiers) (memq 'down modifiers))))))) -(defun mouse-avoidance-banish-hook () +(defun mouse-avoidance-banish () (if (not (mouse-avoidance-ignore-p)) (mouse-avoidance-banish-mouse))) -(defun mouse-avoidance-exile-hook () +(defun mouse-avoidance-exile () ;; 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 (not (mouse-avoidance-ignore-p)) @@ -326,9 +319,10 @@ redefine this function to suit your own tastes." ;; but clear state anyway, to be ready for another move (setq mouse-avoidance-state nil)))))) -(defun mouse-avoidance-fancy-hook () +(defun mouse-avoidance-fancy () ;; Used for the "fancy" modes, ie jump et al. - (if (and (not (mouse-avoidance-ignore-p)) + (if (and (not mouse-avoidance-animating-pointer) + (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) (let ((old-pos (mouse-position))) (mouse-avoidance-nudge-mouse) @@ -384,14 +378,14 @@ definition of \"random distance\".)" (eq mode 'animate) (eq mode 'proteus)) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy)) (setq mouse-avoidance-mode mode mouse-avoidance-state (cons 0 0) mouse-avoidance-old-pointer-shape (and (boundp 'x-pointer-shape) x-pointer-shape))) ((eq mode 'exile) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-exile-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-exile)) (setq mouse-avoidance-mode mode mouse-avoidance-state nil)) ((or (eq mode 'banish) @@ -399,7 +393,7 @@ definition of \"random distance\".)" (and (null mode) (null mouse-avoidance-mode)) (and mode (> (prefix-numeric-value mode) 0))) (setq mouse-avoidance-timer - (run-with-idle-timer 0.1 t 'mouse-avoidance-banish-hook)) + (run-with-idle-timer 0.1 t 'mouse-avoidance-banish)) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil))) (force-mode-line-update))