comparison lisp/avoid.el @ 89966:d8411455de48

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-32 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-488 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-491 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-496 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-500 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS

89965:5e9097d1ad99

;;; avoid.el --- make mouse pointer stay out of the way of editing

;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.

;; Author: Boris Goldowsky <[e-mail]>
;; Keywords: mouse

;; This file is part of GNU Emacs.

;; 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.

  :version "20.3")


(defcustom mouse-avoidance-nudge-dist 15
  "*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

    (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-inside-edges w))
	 (list
	  (compute-motion (max (window-start w) (point-min))   ; start pos
			  ;; window-start can be < point-min if the

		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.
You can redefine this if you want the mouse banished to a different corner."
 (cons (1- (frame-width))
       0))

(defun mouse-avoidance-banish-mouse ()
  ;; Put the mouse pointer in the upper-right corner of the current frame.
  (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))

	  (R2)
	  ((or R1 L2))
	  (t 0))))

(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
		  (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
		  (cdr cur-pos) (- (random mouse-avoidance-nudge-var)
				   (cdr mouse-avoidance-state))
		  mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
		  0 (frame-height))))
    (setq mouse-avoidance-state
	  (cons (+ (car mouse-avoidance-state) deltax)
		(+ (cdr mouse-avoidance-state) deltay)))
    (if (or (eq mouse-avoidance-mode 'animate)
	    (eq mouse-avoidance-mode 'proteus))

	(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-banish-hook ()
  (if (and (not executing-kbd-macro)	; don't check inside macro
	   (cadr (mouse-position))      ; don't move unless in an Emacs frame
	   ;; Don't do anything if last event was a mouse event.
	   (not (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))
			   (memq 'click modifiers)
			   (memq 'drag modifiers)
			   (memq 'down modifiers))))))
      (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)
	   ;; Don't do anything if last event was a mouse event.
	   (not (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))
			   (memq 'click modifiers)
			   (memq 'drag modifiers)
			   (memq 'down modifiers))))))
      (let ((mp (mouse-position)))
	(cond ((and (not mouse-avoidance-state)
		    (mouse-avoidance-too-close-p mp))
	       (setq mouse-avoidance-state mp)
	       (mouse-avoidance-banish-mouse))

	       ;; but clear state anyway, to be ready for another move
	       (setq mouse-avoidance-state nil))))))

(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
	   ;; Don't do anything if last event was a mouse event.
	   (not (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))
			   (memq 'click modifiers)
			   (memq 'drag modifiers)
			   (memq 'down modifiers)))))
	   (mouse-avoidance-too-close-p (mouse-position)))
      (let ((old-pos (mouse-position)))
	(mouse-avoidance-nudge-mouse)
	(if (not (eq (selected-frame) (car old-pos)))
	    ;; This should never happen.

;; Needed for custom.
(if mouse-avoidance-mode
    (mouse-avoidance-mode mouse-avoidance-mode))

;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800
;;; avoid.el ends here

89966:d8411455de48

;;; avoid.el --- make mouse pointer stay out of the way of editing

;; Copyright (C) 1993, 1994, 2000, 2004 Free  Software Foundation, Inc.

;; Author: Boris Goldowsky <[e-mail]>
;; Keywords: mouse

;; This file is part of GNU Emacs.

;; 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.

  :version "20.3")


(defcustom mouse-avoidance-nudge-dist 15
  "*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

    (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-inside-edges w))
	 (list
	  (compute-motion (max (window-start w) (point-min))   ; start pos
			  ;; window-start can be < point-min if the

		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.
You can redefine this if you want the mouse banished to a different corner."
  (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.
  (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))

	  (R2)
	  ((or R1 L2))
	  (t 0))))

(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))
 	 (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
		  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
		  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)
	    (eq mouse-avoidance-mode 'proteus))

	(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 (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 (not (mouse-avoidance-ignore-p))
      (let ((mp (mouse-position)))
	(cond ((and (not mouse-avoidance-state)
		    (mouse-avoidance-too-close-p mp))
	       (setq mouse-avoidance-state mp)
	       (mouse-avoidance-banish-mouse))

	       ;; but clear state anyway, to be ready for another move
	       (setq mouse-avoidance-state nil))))))

(defun mouse-avoidance-fancy-hook ()
  ;; Used for the "fancy" modes, ie jump et al.
  (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)))
	    ;; This should never happen.

;; Needed for custom.
(if mouse-avoidance-mode
    (mouse-avoidance-mode mouse-avoidance-mode))

;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800
;;; avoid.el ends here