1 |
;;; avoid.el --- make mouse pointer stay out of the way of editing |
;;; avoid.el --- make mouse pointer stay out of the way of editing |
2 |
|
|
3 |
;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Boris Goldowsky <boris@gnu.org> |
;; Author: Boris Goldowsky <boris@gnu.org> |
6 |
;; Keywords: mouse |
;; Keywords: mouse |
52 |
;; |
;; |
53 |
;; Bugs / Warnings / To-Do: |
;; Bugs / Warnings / To-Do: |
54 |
;; |
;; |
55 |
;; - Using this code does slow emacs down. "banish" mode shouldn't |
;; - Using this code does slow Emacs down. "banish" mode shouldn't |
56 |
;; be too bad, and on my workstation even "animate" is reasonable. |
;; be too bad, and on my workstation even "animate" is reasonable. |
57 |
;; |
;; |
58 |
;; - It ought to find out where any overlapping frames are and avoid them, |
;; - It ought to find out where any overlapping frames are and avoid them, |
96 |
|
|
97 |
(defcustom mouse-avoidance-nudge-dist 15 |
(defcustom mouse-avoidance-nudge-dist 15 |
98 |
"*Average distance that mouse will be moved when approached by cursor. |
"*Average distance that mouse will be moved when approached by cursor. |
99 |
Only applies in mouse-avoidance-mode `jump' and its derivatives. |
Only applies in Mouse-Avoidance mode `jump' and its derivatives. |
100 |
For best results make this larger than `mouse-avoidance-threshold'." |
For best results make this larger than `mouse-avoidance-threshold'." |
101 |
:type 'integer |
:type 'integer |
102 |
:group 'avoid) |
:group 'avoid) |
137 |
|
|
138 |
(defun mouse-avoidance-point-position () |
(defun mouse-avoidance-point-position () |
139 |
"Return the position of point as (FRAME X . Y). |
"Return the position of point as (FRAME X . Y). |
140 |
Analogous to mouse-position." |
Analogous to `mouse-position'." |
141 |
(let* ((w (selected-window)) |
(let* ((w (selected-window)) |
142 |
(edges (window-inside-edges w)) |
(edges (window-inside-edges w)) |
143 |
(list |
(list |
194 |
mouse-avoidance-threshold)))))) |
mouse-avoidance-threshold)))))) |
195 |
|
|
196 |
(defun mouse-avoidance-banish-destination () |
(defun mouse-avoidance-banish-destination () |
197 |
"The position to which mouse-avoidance-mode `banish' moves the mouse. |
"The position to which Mouse-Avoidance mode `banish' moves the mouse. |
198 |
You can redefine this if you want the mouse banished to a different corner." |
You can redefine this if you want the mouse banished to a different corner." |
199 |
(cons (1- (frame-width)) |
(let* ((pos (window-edges))) |
200 |
0)) |
(cons (- (nth 2 pos) 2) |
201 |
|
(nth 1 pos)))) |
202 |
|
|
203 |
(defun mouse-avoidance-banish-mouse () |
(defun mouse-avoidance-banish-mouse () |
204 |
;; Put the mouse pointer in the upper-right corner of the current frame. |
;; Put the mouse pointer in the upper-right corner of the current frame. |
226 |
(t 0)))) |
(t 0)))) |
227 |
|
|
228 |
(defun mouse-avoidance-nudge-mouse () |
(defun mouse-avoidance-nudge-mouse () |
229 |
;; Push the mouse a little way away, possibly animating the move |
;; Push the mouse a little way away, possibly animating the move. |
230 |
;; For these modes, state keeps track of the total offset that we've |
;; For these modes, state keeps track of the total offset that we've |
231 |
;; accumulated, and tries to keep it close to zero. |
;; accumulated, and tries to keep it close to zero. |
232 |
(let* ((cur (mouse-position)) |
(let* ((cur (mouse-position)) |
233 |
(cur-frame (car cur)) |
(cur-frame (car cur)) |
234 |
(cur-pos (cdr cur)) |
(cur-pos (cdr cur)) |
235 |
|
(pos (window-edges)) |
236 |
|
(wleft (pop pos)) |
237 |
|
(wtop (pop pos)) |
238 |
|
(wright (pop pos)) |
239 |
|
(wbot (pop pos)) |
240 |
(deltax (mouse-avoidance-delta |
(deltax (mouse-avoidance-delta |
241 |
(car cur-pos) (- (random mouse-avoidance-nudge-var) |
(car cur-pos) (- (random mouse-avoidance-nudge-var) |
242 |
(car mouse-avoidance-state)) |
(car mouse-avoidance-state)) |
243 |
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
244 |
0 (frame-width))) |
wleft (1- wright))) |
245 |
(deltay (mouse-avoidance-delta |
(deltay (mouse-avoidance-delta |
246 |
(cdr cur-pos) (- (random mouse-avoidance-nudge-var) |
(cdr cur-pos) (- (random mouse-avoidance-nudge-var) |
247 |
(cdr mouse-avoidance-state)) |
(cdr mouse-avoidance-state)) |
248 |
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
mouse-avoidance-nudge-dist mouse-avoidance-nudge-var |
249 |
0 (frame-height)))) |
wtop (1- wbot)))) |
250 |
(setq mouse-avoidance-state |
(setq mouse-avoidance-state |
251 |
(cons (+ (car mouse-avoidance-state) deltax) |
(cons (+ (car mouse-avoidance-state) deltax) |
252 |
(+ (cdr mouse-avoidance-state) deltay))) |
(+ (cdr mouse-avoidance-state) deltay))) |
283 |
(nth (random mouse-avoidance-n-pointer-shapes) |
(nth (random mouse-avoidance-n-pointer-shapes) |
284 |
mouse-avoidance-pointer-shapes)) |
mouse-avoidance-pointer-shapes)) |
285 |
|
|
286 |
|
(defun mouse-avoidance-ignore-p () |
287 |
|
(let ((mp (mouse-position))) |
288 |
|
(or executing-kbd-macro ; don't check inside macro |
289 |
|
(null (cadr mp)) ; don't move unless in an Emacs frame |
290 |
|
(not (eq (car mp) (selected-frame))) |
291 |
|
;; Don't do anything if last event was a mouse event. |
292 |
|
;; FIXME: this code fails in the case where the mouse was moved |
293 |
|
;; since the last key-press but without generating any event. |
294 |
|
(and (consp last-input-event) |
295 |
|
(symbolp (car last-input-event)) |
296 |
|
(let ((modifiers (event-modifiers (car last-input-event)))) |
297 |
|
(or (memq (car last-input-event) |
298 |
|
'(mouse-movement scroll-bar-movement |
299 |
|
select-window switch-frame)) |
300 |
|
(memq 'click modifiers) |
301 |
|
(memq 'double modifiers) |
302 |
|
(memq 'triple modifiers) |
303 |
|
(memq 'drag modifiers) |
304 |
|
(memq 'down modifiers))))))) |
305 |
|
|
306 |
(defun mouse-avoidance-banish-hook () |
(defun mouse-avoidance-banish-hook () |
307 |
(if (and (not executing-kbd-macro) ; don't check inside macro |
(if (not (mouse-avoidance-ignore-p)) |
|
(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)))))) |
|
308 |
(mouse-avoidance-banish-mouse))) |
(mouse-avoidance-banish-mouse))) |
309 |
|
|
310 |
(defun mouse-avoidance-exile-hook () |
(defun mouse-avoidance-exile-hook () |
311 |
;; For exile mode, the state is nil when the mouse is in its normal |
;; For exile mode, the state is nil when the mouse is in its normal |
312 |
;; position, and set to the old mouse-position when the mouse is in exile. |
;; position, and set to the old mouse-position when the mouse is in exile. |
313 |
(if (and (not executing-kbd-macro) |
(if (not (mouse-avoidance-ignore-p)) |
|
;; 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)))))) |
|
314 |
(let ((mp (mouse-position))) |
(let ((mp (mouse-position))) |
315 |
(cond ((and (not mouse-avoidance-state) |
(cond ((and (not mouse-avoidance-state) |
316 |
(mouse-avoidance-too-close-p mp)) |
(mouse-avoidance-too-close-p mp)) |
328 |
|
|
329 |
(defun mouse-avoidance-fancy-hook () |
(defun mouse-avoidance-fancy-hook () |
330 |
;; Used for the "fancy" modes, ie jump et al. |
;; Used for the "fancy" modes, ie jump et al. |
331 |
(if (and (not executing-kbd-macro) ; don't check inside macro |
(if (and (not (mouse-avoidance-ignore-p)) |
|
;; 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))))) |
|
332 |
(mouse-avoidance-too-close-p (mouse-position))) |
(mouse-avoidance-too-close-p (mouse-position))) |
333 |
(let ((old-pos (mouse-position))) |
(let ((old-pos (mouse-position))) |
334 |
(mouse-avoidance-nudge-mouse) |
(mouse-avoidance-nudge-mouse) |
414 |
(if mouse-avoidance-mode |
(if mouse-avoidance-mode |
415 |
(mouse-avoidance-mode mouse-avoidance-mode)) |
(mouse-avoidance-mode mouse-avoidance-mode)) |
416 |
|
|
417 |
;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 |
;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 |
418 |
;;; avoid.el ends here |
;;; avoid.el ends here |