Initial revision

1 files changed, 254 insertions, 0 deletions

diff --git a/lisp/avoid.el b/lisp/avoid.el
new file mode 100644
index 00000000000..664c964806a
--- /dev/null
+++ b/lisp/avoid.el
@@ -0,0 +1,254 @@
+;;; avoid.el -- make mouse pointer stay out of the way of editing.
+
+;;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Boris Goldowsky <boris@cs.rochester.edu>
+;; Keywords: mouse
+;; $Revision: 1.10 $
+
+;; This file is part of GNU Emacs.
+
+;; 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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.
+
+;;; 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 'cat-and-mouse)))
+;;;
+;;; The 'animate can be 'jump or 'banish or 'protean if you prefer.
+;;;
+;;; 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:
+;;;
+;;; - THIS CODE IS FOR USE WITH FSF EMACS 19.21 or later.
+;;;   It can cause earlier versions of emacs to crash, due to a bug in the
+;;;   mouse code. 
+;;;
+;;; - 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.
+;;;
+;;; - There are some situations where it doesn't do what you expect,
+;;;   notably when there are long wrapped lines in the buffer.  Since
+;;;   there is no low-level command for finding point's position
+;;;   on the screen, it can fail to move the pointer when on such a line.
+;;;
+;;; Copyright (c) 1993 Free Software Foundation
+;;; This program 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.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author or from the Free Software Foundation, Inc., 675
+;;; Mass Ave, Cambridge, MA 02139, USA.
+
+;;; LCD Archive Entry:
+;;; avoid|Boris Goldowsky|boris@cs.rochester.edu|
+;;; Keep mouse pointer away from cursor|
+;;; $Date: 93/11/22 15:34:50 $ |$Revision: 1.10 $||
+
+;;; 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 the function 
+instead.")
+
+(defvar mouse-avoidance-nudge-dist 4
+  "*Average distance that mouse will be moved when approached by cursor.
+Only applies in mode-avoidance-modes `animate' and `jump'.")
+
+(defvar mouse-avoidance-nudge-var 3
+  "*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
+  "*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'.")
+
+;; Internal variables for mouse-avoidance-random-shape
+(defvar mouse-avoidance-pointer-shapes nil)
+(defvar mouse-avoidance-n-pointer-shapes 0)
+
+;;; Functions:
+
+(defun mouse-avoidance-too-close-p ()
+  ;;  Return t if mouse pointer and point cursor are too close.
+  ;; Acceptable distance is defined by mouse-avoidance-threshhold.
+  (let ((mouse (mouse-position)))
+    (and (car (cdr mouse))
+         (< (abs (- (car (cdr mouse)) (current-column)))
+            mouse-avoidance-threshhold)
+         (< (abs (- (cdr (cdr mouse)) 
+                    (+ (car (cdr (window-edges)))
+                       (count-lines (window-start) (point)))))
+            mouse-avoidance-threshhold))))
+
+(defun mouse-avoidance-banish-mouse ()
+  ;; Put the mouse pointer in the upper-right corner of the current frame.
+  (set-mouse-position (selected-frame) (1- (frame-width)) 0))
+
+(defun mouse-avoidance-nudge-mouse () 
+  ;; Push the mouse a little way away, possibly animating the move
+  (let* ((cur (mouse-position))
+         (deltax (* (+ mouse-avoidance-nudge-dist 
+                       (random mouse-avoidance-nudge-var))
+                    (if (zerop (random 2)) 1 -1)))
+         (deltay (* (+ mouse-avoidance-nudge-dist
+                       (random mouse-avoidance-nudge-var))
+                    (if (zerop (random 2)) 1 -1))))
+    (if (or (eq mouse-avoidance-mode 'animate) 
+            (eq mouse-avoidance-mode 'proteus))
+        (let ((i 0.0)
+              (color (cdr (assoc 'mouse-color (frame-parameters)))))
+          (while (<= i 1)
+            (set-mouse-position 
+             (car cur) 
+             (mod (+ (car (cdr cur)) (round (* i deltax))) (window-width))
+             (mod (+ (cdr (cdr cur)) (round (* i deltay))) (window-height)))
+            (setq i (+ i (/ 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)))
+            (sit-for mouse-avoidance-animation-delay)))
+      (set-mouse-position 
+       (car cur)
+       (mod (+ (car (cdr cur)) deltax) (window-width))
+       (mod (+ (cdr (cdr cur)) deltay) (window-height))))))
+
+(defun mouse-avoidance-random-shape ()
+  "Return a random cursor shape.
+This assumes that any variable whose name begins with x-pointer- and
+has an integer value is a valid cursor shape.  You might want to
+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)))
+                      (all-completions "x-pointer-" obarray
+                                       '(lambda (x) 
+                                          (and (boundp x)
+                                               (integerp (symbol-value x)))))))
+        (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-simple-hook ()
+  (if (and (mouse-avoidance-keyboard-command (this-command-keys)))
+      (mouse-avoidance-banish-mouse)))
+
+(defun mouse-avoidance-fancy-hook ()
+  (if (and (mouse-avoidance-keyboard-command (this-command-keys))
+           (mouse-avoidance-too-close-p))
+      (mouse-avoidance-nudge-mouse)))
+
+(defun mouse-avoidance-keyboard-command (key)
+  "Return t if the KEYSEQENCE is composed of keyboard events only.
+Returns 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))))
+
+(defun mouse-avoidance-mode (&optional mode)
+  "Set cursor avoidance mode to MODE.
+MODE should be one of the symbols `banish', `jump', `animate',
+`cat-and-mouse', or `none'.  `Animate' is the same as `cat-and-mouse'.
+If MODE is nil, toggle mouse avoidance.  Positive numbers and
+symbols other than the above are treated as equivalent to `banish';
+negative numbers and `-' are equivalent to `none'."
+  (interactive
+   (list (intern (completing-read
+                  "Select cursor avoidance technique (SPACE for list): "
+                  '(("banish") ("jump") ("animate") ("cat-and-mouse") 
+                    ("proteus") ("none"))
+                  nil t))))
+  (if (eq mode 'cat-and-mouse)
+      (setq mode 'animate))
+  (setq post-command-hook
+        (delete 'mouse-avoidance-simple-hook (append post-command-hook nil)))
+  (setq post-command-hook
+        (delete 'mouse-avoidance-fancy-hook (append post-command-hook nil)))
+  (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-mode mode))
+        ((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-simple-hook)
+         (setq mouse-avoidance-mode 'banish))
+        (t (setq mouse-avoidance-mode nil))))
+
+(or (assq 'mouse-avoidance-mode minor-mode-alist)
+    (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid")
+                                 minor-mode-alist)))
+
+;;; End of avoid.el
+