X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e18afed7d695edac870ddf55aabc85c0a95a4b5f..7c6317a0498b6690ea668909ac012cb45e6f809b:/lisp/avoid.el diff --git a/lisp/avoid.el b/lisp/avoid.el index bfe15de0ca..3d43539b31 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -1,6 +1,6 @@ ;;; avoid.el --- make mouse pointer stay out of the way of editing -;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. +;; Copyright (C) 1993-1994, 2000-2016 Free Software Foundation, Inc. ;; Author: Boris Goldowsky ;; Keywords: mouse @@ -41,9 +41,9 @@ ;; ;; (if (eq window-system 'x) ;; (mouse-avoidance-set-pointer-shape -;; (eval (nth (random 4) -;; '(x-pointer-man x-pointer-spider -;; x-pointer-gobbler x-pointer-gumby))))) +;; (nth (random 4) +;; (list x-pointer-man x-pointer-spider +;; x-pointer-gobbler x-pointer-gumby)))) ;; ;; For completely random pointer shape, replace the setq above with: ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) @@ -52,9 +52,6 @@ ;; ;; - 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. ;; Credits: ;; This code was helped by all those who contributed suggestions, @@ -67,7 +64,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup avoid nil "Make mouse pointer stay out of the way of editing." @@ -128,9 +125,10 @@ SIDE-POS: Distance from right or left edge of frame or window. TOP-OR-BOTTOM: banish the mouse to top or bottom of frame or window. TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window." :group 'avoid - :type '(alist :key-type symbol :value-type symbol) - :options '(frame-or-window side (side-pos integer) - top-or-bottom (top-or-bottom-pos integer))) + :version "24.3" + :type '(alist :key-type symbol :value-type (choice symbol integer)) + :options '((frame-or-window symbol) (side symbol) (side-pos integer) + (top-or-bottom symbol) (top-or-bottom-pos integer))) ;; Internal variables (defvar mouse-avoidance-state nil) @@ -153,28 +151,26 @@ TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window." (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). Analogous to `mouse-position'." - (let ((edges (window-inside-edges)) - (x-y (posn-x-y (posn-at-point)))) - (cons (selected-frame) - (cons (+ (car edges) - (/ (car x-y) (frame-char-width))) - (+ (car (cdr edges)) - (/ (cdr x-y) (frame-char-height))))))) + (let* ((edges (window-inside-edges)) + (posn-at-point (posn-at-point)) + (x-y (and posn-at-point (posn-x-y posn-at-point)))) + (when x-y + (cons (selected-frame) + (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) -; (message (format "point=%s mouse=%s" -; (cdr (mouse-avoidance-point-position)) -; (cdr (mouse-position))))) +; (message "point=%s mouse=%s" +; (cdr (mouse-avoidance-point-position)) +; (cdr (mouse-position)))) (defun mouse-avoidance-set-mouse-position (pos) ;; Carefully set mouse position to given position (X . Y) - ;; Ideally, should check if X,Y is in the current frame, and if not, - ;; leave the mouse where it was. However, this is currently - ;; difficult to do, so we just raise the frame to avoid frame switches. ;; Returns t if it moved the mouse. (let ((f (selected-frame))) - (raise-frame f) (set-mouse-position f (car pos) (cdr pos)) t)) @@ -184,19 +180,21 @@ 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))) + (tool-bar-lines (frame-parameter nil 'tool-bar-lines)) + point) (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)))) + (cond + ((and mouse-y (< mouse-y tool-bar-lines)) + nil) + ((setq point (mouse-avoidance-point-position)) + (let ((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)))))) + mouse-avoidance-threshold))))))) (defun mouse-avoidance-banish-destination () "The position to which Mouse Avoidance mode `banish' moves the mouse. @@ -206,30 +204,30 @@ If you want the mouse banished to a different corner set (let* ((fra-or-win (assoc-default 'frame-or-window mouse-avoidance-banish-position 'eq)) - (list-values (case fra-or-win - (frame (list 0 0 (frame-width) (frame-height))) - (window (window-edges)))) - (alist (loop for v in list-values - for k in '(left top right bottom) - collect (cons k v))) + (list-values (pcase fra-or-win + (`frame (list 0 0 (frame-width) (frame-height))) + (`window (window-edges)))) + (alist (cl-loop for v in list-values + for k in '(left top right bottom) + collect (cons k v))) (side (assoc-default 'side - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (side-dist (assoc-default 'side-pos - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom (assoc-default 'top-or-bottom - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom-dist (assoc-default 'top-or-bottom-pos - mouse-avoidance-banish-position 'eq)) - (side-fn (case side - (left '+) - (right '-))) - (top-or-bottom-fn (case top-or-bottom - (top '+) - (bottom '-)))) + mouse-avoidance-banish-position #'eq)) + (side-fn (pcase side + (`left '+) + (`right '-))) + (top-or-bottom-fn (pcase top-or-bottom + (`top '+) + (`bottom '-)))) (cons (funcall side-fn ; -/+ (assoc-default side alist 'eq) ; right or left side-dist) ; distance from side @@ -337,12 +335,18 @@ redefine this function to suit your own tastes." (let ((modifiers (event-modifiers (car last-input-event)))) (or (memq (car last-input-event) '(mouse-movement scroll-bar-movement - select-window switch-frame)) + select-window focus-out)) (memq 'click modifiers) (memq 'double modifiers) (memq 'triple modifiers) (memq 'drag modifiers) - (memq 'down modifiers))))))) + (memq 'down modifiers) + (memq 'meta modifiers) + (memq 'control modifiers) + (memq 'shift modifiers) + (memq 'hyper modifiers) + (memq 'super modifiers) + (memq 'alt modifiers))))))) (defun mouse-avoidance-banish () (if (not (mouse-avoidance-ignore-p)) @@ -398,8 +402,6 @@ Effects of the different modes: * cat-and-mouse: Same as `animate'. * proteus: As `animate', but changes the shape of the mouse pointer too. -Whenever the mouse is moved, the frame is also raised. - \(See `mouse-avoidance-threshold' for definition of \"too close\", and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for definition of \"random distance\".)"