X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7421db29d7c90bbc46e3e4f93fc1c9284161827e..a53692379f6caed5e6d1686a1933914751dd64fe:/lisp/avoid.el diff --git a/lisp/avoid.el b/lisp/avoid.el index 60cc97aa3b..5a5a09622c 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -1,8 +1,8 @@ ;;; 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 Free Software Foundation, Inc. -;; Author: Boris Goldowsky +;; Author: Boris Goldowsky ;; Keywords: mouse ;; This file is part of GNU Emacs. @@ -26,11 +26,11 @@ ;; 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. +;; 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: +;; To set up permanently, put the following in your .emacs: ;; -;; (if window-system (mouse-avoidance-mode 'animate)) +;; (if (display-mouse-p) (mouse-avoidance-mode 'animate)) ;; ;; Other legitimate alternatives include ;; `banish', `exile', `jump', `cat-and-mouse', and `proteus'. @@ -41,7 +41,7 @@ ;; For added silliness, make the animatee animate... ;; put something similar to the following into your .emacs: ;; -;; (if window-system +;; (if (eq window-system 'x) ;; (mouse-avoidance-set-pointer-shape ;; (eval (nth (random 4) ;; '(x-pointer-man x-pointer-spider @@ -49,7 +49,7 @@ ;; ;; 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 @@ -59,7 +59,7 @@ ;; rather than always raising the frame. ;; Credits: -;; This code was helped by all those who contributed suggestions, +;; 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. @@ -76,17 +76,17 @@ :prefix "mouse-avoidance-" :group 'mouse) - +;;;###autoload (defcustom mouse-avoidance-mode nil - "Activate mouse avoidance mode. + "Activate mouse avoidance mode. See function `mouse-avoidance-mode' for possible values. -This variable should be set only with \\[customize], which is equivalent -to using the function `mouse-avoidance-mode'. +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))) + (mouse-avoidance-mode (or value 'none))) :initialize 'custom-initialize-default - :type '(choice (const :tag "none" nil) (const banish) (const jump) + :type '(choice (const :tag "none" nil) (const banish) (const jump) (const animate) (const exile) (const proteus) ) :group 'avoid @@ -131,18 +131,19 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defsubst mouse-avoidance-set-pointer-shape (shape) "Set the shape of the mouse pointer to SHAPE." - (setq x-pointer-shape shape) - (set-mouse-color nil)) + (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." (let* ((w (selected-window)) (edges (window-edges w)) - (list + (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 + ;; latter has changed since the last redisplay '(0 . 0) ; start XY (point) ; stop pos (cons (window-width) (window-height)); stop XY: none @@ -157,7 +158,7 @@ Analogous to mouse-position." ;(defun mouse-avoidance-point-position-test () ; (interactive) -; (message (format "point=%s mouse=%s" +; (message (format "point=%s mouse=%s" ; (cdr (mouse-avoidance-point-position)) ; (cdr (mouse-position))))) @@ -171,17 +172,26 @@ 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-threshold. - (let ((point (mouse-avoidance-point-position))) - (and (eq (car mouse) (car point)) - (car (cdr mouse)) - (< (abs (- (car (cdr mouse)) (car (cdr point)))) - mouse-avoidance-threshold) - (< (abs (- (cdr (cdr mouse)) (cdr (cdr point)))) - mouse-avoidance-threshold)))) + "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. @@ -214,19 +224,19 @@ You can redefine this if you want the mouse banished to a different corner." ((or R1 L2)) (t 0)))) -(defun mouse-avoidance-nudge-mouse () +(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 + (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 + (deltay (mouse-avoidance-delta (cdr cur-pos) (- (random mouse-avoidance-nudge-var) (cdr mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var @@ -234,16 +244,16 @@ You can redefine this if you want the mouse banished to a different corner." (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)) (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) - (mouse-avoidance-set-pointer-shape + (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) @@ -257,12 +267,12 @@ 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)) @@ -334,11 +344,11 @@ redefine this function to suit your own tastes." 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. @@ -379,13 +389,14 @@ definition of \"random distance\".)" (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy-hook)) (setq mouse-avoidance-mode mode mouse-avoidance-state (cons 0 0) - mouse-avoidance-old-pointer-shape x-pointer-shape)) + 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)) (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))) @@ -402,7 +413,8 @@ definition of \"random distance\".)" ;; minor-mode-alist))) ;; Needed for custom. -(if mouse-avoidance-mode +(if mouse-avoidance-mode (mouse-avoidance-mode mouse-avoidance-mode)) +;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 ;;; avoid.el ends here