Mercurial > emacs
view lisp/avoid.el @ 94414:d86cb59eea9f
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org.el (org-html-level-start): Always have id's in HTML
(org-export-as-html): Use `org-link-protocols' to
retrieve the export form of the link.
(org-add-link-type): Final parameter renamed from PUBLISH. Better
documentation of how it is to be used. Avoid double entries for
the same link type.
(org-add-link-props): New function.
(org-modules-loaded): New variable.
(org-load-modules-maybe, org-set-modules): New function.
(org-modules): New option.
(org-mode, org-cycle, orgstruct-mode, org-run-like-in-org-mode)
(orgtbl-mode, org-store-link, org-insert-link-global)
(org-open-at-point): Call `org-load-modules-maybe'.
(org-search-view): Add more text properties.
(org-agenda-schedule, org-agenda-deadline): Allow also in
search-type agendas.
(org-search-view): Order of arguments has been changed.
Interpret prefix-arg as TODO-ONLY.
(org-agenda, org-run-agenda-series, org-agenda-manipulate-query):
Take new argument order of `org-search-view' into account.
(org-todo-only): New variable.
(org-search-syntax-table): New variable and function.
(org-search-view): Do the search with the special syntax table.
(define-obsolete-function-alias): Make work with XEmacs.
(org-add-planning-info): Use old date as default when modifying an
existing deadline or scheduled item.
(org-agenda-compute-time-span): Make argument N optional.
(org-agenda-format-date-aligned): Require `cal-iso'.
(org-agenda-list): Include week into into agenda heading, don't
list it at each date (only on Mondays).
(org-read-date-analyze): Define local variable `iso-date'.
(org-agenda-format-date-aligned): Remove dependency on
`calendar-time-from-absolute'.
(org-remember-apply-template, org-go-to-remember-target):
Interpret filenames relative to `org-directory'.
(org-complete): Silently fail when trying to complete
keywords that don't have a default value.
(org-get-current-options): Added a #+DATE: option.
(org-additional-option-like-keywords): Removed "DATE:" from the
list of additional keywords.
(org-export-as-html): Removed (current-time) as unnecessary second
argument of `format-time-string'.
(org-clock-find-position): Handle special case at end of
buffer.
(org-agenda-day-view): New argument DAY-OF-YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-week-view): New argument ISO-WEEK, pass it on to
`org-agenda-change-time-span'.
(org-agenda-month-view): New argument MONTH, pass it on to
`org-agenda-change-time-span'.
(org-agenda-year-view): New argument YEAR, pass it on to
`org-agenda-change-time-span'.
(org-agenda-change-time-span): New optional argument N, pass it on
to `org-agenda-compute-time-span'.
(org-agenda-compute-time-span): New argument N, interpret it by
changing the starting day.
(org-small-year-to-year): New function.
(org-scheduled-past-days): Respect
`org-scheduled-past-days'.
(org-auto-repeat-maybe): Make sure that repeating
dates are pushed into the future, and that the shift is at least
one interval, never 0.
(org-update-checkbox-count): Fix bug with checkbox
counting.
(org-add-note): New command.
(org-add-log-setup): Renamed from `org-add-log-maybe'.
(org-log-note-headings): New entry for plain notes (i.e. notes not
related to state changes or clocking).
(org-get-org-file): Check for availability of
`remember-data-file'.
(org-cached-entry-get): Allow a regexp value for
`org-use-property-inheritance'.
(org-use-property-inheritance): Allow regexp value. Fix bug in
customization type.
(org-use-tag-inheritance): Allow a list and a regexp value for
this variable.
(org-scan-tags, org-get-tags-at): Implement selective tag
inheritance.
(org-entry-get): Respect value `selective' for the INHERIT
argument.
(org-tag-inherit-p, org-property-inherit-p): New functions.
(org-agenda-format-date-aligned): Allow 10 characters for
weekday, to acomodate German locale.
(org-add-archive-files): New function.
(org-agenda-files): New argument `ext', to
get archive files as well.
(org-tbl-menu): Protect the use of variables that
are only available when org-table.el gets loaded.
(org-read-agenda-file-list): Error if `org-agenda-files' is a
single directory.
(org-open-file): Allow a batch process to trigger
waiting after executing a system command.
(org-store-link): Link to headline when there is not
target and no region in an org-mode buffer when creating a link.
(org-link-types-re): New variable.
(org-make-link-regexps): Compute `org-link-types-re'.
(org-make-link-description-function): New option.
(org-agenda-date, org-agenda-date-weekend): New faces.
(org-archive-sibling-heading): New option.
(org-archive-to-archive-sibling): New function.
(org-iswitchb): New command.
(org-buffer-list): New function.
(org-agenda-columns): Also try the #+COLUMNS line in
the buffer associated with the entry at point (or with the first
entry in the agenda view).
(org-modules): Add entry for org-bibtex.el.
(org-completion-fallback-command): Moved into `org-completion'
group.
(org-clock-heading-function): Moved to `org-progress' group.
(org-auto-repeat-maybe): Make sure that a note can
be enforces if `org-log-repeat' is `note'.
(org-modules): Allow additional symbols for external
packages.
(org-ctrl-c-ctrl-c): Allow for `org-clock-overlays' to be
undefined.
(org-clock-goto): Hide drawers after showing an
entry with `org-clock-goto.'
(org-shiftup, org-shiftdown, org-shiftright, org-shiftleft): Try
also a clocktable block shift.
(org-clocktable-try-shift): New function.
(org-columns-hscoll-title): New function.
(org-columns-previous-hscroll): New variable.
(org-columns-full-header-line-format): New variable.
(org-columns-display-here-title, org-columns-remove-overlays):
Install `org-columns-hscoll-title' in post-command-hook.
* org/org.el: Split into many small files.
* org/org-agenda.el: New file, split off from org.el.
* org/org-archive.el: New file, split off from org.el.
* org/org-bbdb.el: New file.
* org/org-bibtex.el: New file, split off from org.el.
* org/org-clock.el: New file, split off from org.el.
* org/org-colview.el: New file, split off from org.el.
* org/org-compat.el: New file, split off from org.el.
* org/org-exp.el: New file, split off from org.el.
* org/org-faces.el: New file, split off from org.el.
* org/org-gnus.el: New file, split off from org.el.
* org/org-info.el: New file, split off from org.el.
* org/org-infojs.el: New file.
* org/org-irc.el: New file.
* org/org-macs.el: New file, split off from org.el.
* org/org-mew.el: New file.
* org/org-mhe.el: New file, split off from org.el.
* org/org-publish.el: New file, split off from org.el.
* org/org-remember.el: New file, split off from org.el.
* org/org-rmail.el: New file, split off from org.el.
* org/org-table.el: New file, split off from org.el.
* org/org-vm.el: New file, split off from org.el.
* org/org-wl.el: New file, split off from org.el.
2008-04-27 Jason Riedy <jason@acm.org>
* lisp/org-table.el (orgtbl-to-generic): Add a :remove-nil-lines
parameter that supresses lines that evaluate to NIL.
(orgtbl-get-fmt): New inline function for
picking apart formats that may be lists.
(orgtbl-apply-fmt): New inline function for applying formats that
may be functions.
(orgtbl-eval-str): New inline function for strings that may be
functions.
(orgtbl-format-line, orgtbl-to-generic): Use and document.
(orgtbl-to-latex, orgtbl-to-texinfo): Document.
(*orgtbl-llfmt*, *orgtbl-llstart*)
(*orgtbl-llend*): Dynamic variables for last-line formatting.
(orgtbl-format-section): Shift formatting to support detecting the
last line and formatting it specially.
(orgtbl-to-generic): Document :ll* formats. Set to the non-ll
formats unless overridden.
(orgtbl-to-latex): Suggest using :llend to suppress the final \\.
(*orgtbl-table*, *orgtbl-rtn*): Dynamically
bound variables to hold the input collection of lines and output
formatted text.
(*orgtbl-hline*, *orgtbl-sep*, *orgtbl-fmt*, *orgtbl-efmt*,
(*orgtbl-lfmt*, *orgtbl-lstart*, *orgtbl-lend*): Dynamically bound
format parameters.
(orgtbl-format-line): New function encapsulating formatting for a
single line.
(orgtbl-format-section): Similar for each section. Rebinding the
dynamic vars customizes the formatting for each section.
(orgtbl-to-generic): Use orgtbl-format-line and
orgtbl-format-section.
(org-get-param): Now unused, so delete.
(orgtbl-gather-send-defs): New function to
gather all the SEND definitions before a table.
(orgtbl-send-replace-tbl): New function to find the RECEIVE
corresponding to the current name.
(orgtbl-send-table): Use the previous two functions and implement
multiple destinations for each table.
* doc/org.texi (A LaTeX example): Note that fmt may be a
one-argument function, and efmt may be a two-argument function.
(Radio tables): Document multiple destinations.
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org-agenda.el (org-add-to-diary-list): New function.
(org-prefix-has-effort): New variable.
(org-sort-agenda-noeffort-is-high): New option.
(org-agenda-columns-show-summaries)
(org-agenda-columns-compute-summary-properties): New options.
(org-format-agenda-item): Compute the duration of the item.
(org-agenda-weekend-days): New variable.
(org-agenda-list, org-timeline): Use the proper faces for dates in
the agenda and timeline buffers.
(org-agenda-archive-to-archive-sibling): New command.
(org-agenda-start-with-clockreport-mode): New option.
(org-agenda-clockreport-parameter-plist): New option.
(org-agenda-clocktable-mode): New variable.
(org-agenda-deadline-leaders): Allow a function value for the
deadline leader.
(org-agenda-get-deadlines): Deal with new function value.
* lisp/org-clock.el (org-clock): New customization group.
(org-clock-into-drawer, org-clock-out-when-done)
(org-clock-in-switch-to-state, org-clock-heading-function): Moved
into the new group.
(org-clock-out-remove-zero-time-clocks): New option.
(org-clock-out): Use `org-clock-out-remove-zero-time-clocks'.
(org-dblock-write:clocktable): Allow a Lisp form for the scope
parameter.
(org-dblock-write:clocktable): Fixed bug with total time
calculation.
(org-dblock-write:clocktable): Request the unrestricted list of
files.
(org-get-clocktable): New function.
(org-dblock-write:clocktable): Make sure :tstart and :tend can not
only be strings but also integers (an absolute day number) and
lists (m d y).
* org/org-colview.el (org-columns-next-allowed-value)
(org-columns-edit-value): Limit the effort for updatig in the
agenda to recomputing a single file.
(org-columns-compute): Only write property value if it has
changed. This avoids raising the buffer-change-flag
unnecessarily.
(org-agenda-colview-summarize)
(org-agenda-colview-compute): New functions.
(org-agenda-columns): Call `org-agenda-colview-summarize'.
* org/org-exp.el (org-export-run-in-background): New option.
(org-export-icalendar): Allow a batch process to trigger waiting
after executing a system command.
(org-export-preprocess-string): Renamed-from
`org-cleaned-string-for-export'.
(org-export-html-style): Made target class look like normal text.
(org-export-as-html): Make use of the better proprocessing in
`org-cleaned-string-for-export'.
(org-cleaned-string-for-export): Better treatment of heuristic
targets, many more internal links will now work in HTML export.
(org-get-current-options): Incorporate LINK_UP, LINK_HOME, and
INFOJS.
(org-export-inbuffer-options-extra): New variable.
(org-export-options-filters): New hook.
(org-infile-export-plist): Find also the settings keywords in
`org-export-inbuffer-options-extra'.
(org-infile-export-plist): Allow multiple #+OPTIONS lines and
multiple #+INFOJS_OPT lines.
(org-export-html-handle-js-options): New function.
(org-export-html-infojs-setup): New option.
(org-export-as-html): Call `org-export-html-handle-js-options'.
Add autoload to all entry points.
(org-skip-comments): Function removed.
* org/org-table.el (org-table-make-reference): Extra parenthesis
around single fields, to make sure that algebraic formulas get
correctly interpreted by calc.
(org-table-current-column): No longer interactive.
* org/org-export-latex.el (org-export-latex-preprocess): Renamed
from `org-export-latex-cleaned-string'.
2008-04-27 Bastien Guerry <bzg@altern.org>
* org/org-publish.el (org-publish-get-base-files-1): New function.
(org-publish-get-base-files): Use it.
(org-publish-temp-files): New variable.
Don't require 'dired-aux anymore.
(org-publish-initial-buffer): New variable.
(org-publish-org-to, org-publish): Use it.
(org-publish-get-base-files-1): Bug fix: get
the proper list of files when recursing thru a directory.
(org-publish-get-base-files): Use the :exclude property to skip
both files and directories.
author | Carsten Dominik <dominik@science.uva.nl> |
---|---|
date | Sun, 27 Apr 2008 18:33:39 +0000 |
parents | 73661ddc7ac7 |
children | 606f2d163a64 ee5932bf781d |
line wrap: on
line source
;;; avoid.el --- make mouse pointer stay out of the way of editing ;; Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: mouse ;; 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 3, 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, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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 the following in your .emacs: ;; ;; (if (display-mouse-p) (mouse-avoidance-mode 'animate)) ;; ;; Other legitimate alternatives include ;; `banish', `exile', `jump', `cat-and-mouse', and `proteus'. ;; They do somewhat different things. ;; See the documentation for function `mouse-avoidance-mode' for ;; details of the different modes. ;; ;; For added silliness, make the animatee animate... ;; put something similar to the following into your .emacs: ;; ;; (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))))) ;; ;; 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. ;; 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) (defgroup avoid nil "Make mouse pointer stay out of the way of editing." :prefix "mouse-avoidance-" :group 'mouse) ;;;###autoload (defcustom mouse-avoidance-mode nil "Activate mouse avoidance mode. See function `mouse-avoidance-mode' for possible values. 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))) :initialize 'custom-initialize-default :type '(choice (const :tag "none" nil) (const banish) (const jump) (const animate) (const exile) (const proteus) ) :group 'avoid :require 'avoid :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 "*Variability of `mouse-avoidance-nudge-dist' (which see)." :type 'integer :group 'avoid) (defcustom mouse-avoidance-animation-delay .01 "Delay between animation steps, in seconds." :type 'number :group 'avoid) (defcustom mouse-avoidance-threshold 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'." :type 'integer :group 'avoid) ;; Internal variables (defvar mouse-avoidance-state nil) (defvar mouse-avoidance-pointer-shapes nil) (defvar mouse-avoidance-n-pointer-shapes 0) (defvar mouse-avoidance-old-pointer-shape nil) (defvar mouse-avoidance-animating-pointer nil) ;; This timer is used to run something when Emacs is idle. (defvar mouse-avoidance-timer nil) ;;; Functions: (defsubst mouse-avoidance-set-pointer-shape (shape) "Set the shape of the mouse pointer to SHAPE." (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 ((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))))))) ;(defun mouse-avoidance-point-position-test () ; (interactive) ; (message (format "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)) (defun mouse-avoidance-too-close-p (mouse) "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. 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))) (defsubst mouse-avoidance-delta (cur delta dist var min max) ;; Decide how far to move in either dimension. ;; Args are the CURRENT location, the desired DELTA for ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY ;; in distance allowed, and the MIN and MAX possible window positions. ;; Returns something as close to DELTA as possible within the constraints. (let ((L1 (max (- min cur) (+ (- dist) (- var)))) (R1 (+ (- dist) var )) (L2 (+ dist (- var))) (R2 (min (- max cur) (+ dist var)))) (if (< R1 (- min cur)) (setq L1 nil R1 nil)) (if (> L2 (- max cur)) (setq L2 nil R2 nil)) (cond ((and L1 (< delta L1)) L1) ((and R1 (< delta R1)) delta) ((and R1 (< delta 0)) R1) ((and L2 (< delta L2)) L2) ((and R2 (< delta R2)) delta) (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)) (let ((i 0.0) (incr (max .1 (/ 1.0 mouse-avoidance-nudge-dist)))) (setq mouse-avoidance-animating-pointer t) (while (<= i 1) (mouse-avoidance-set-mouse-position (cons (+ (car cur-pos) (round (* i deltax))) (+ (cdr cur-pos) (round (* i deltay))))) (setq i (+ i incr)) (if (eq mouse-avoidance-mode 'proteus) (mouse-avoidance-set-pointer-shape (mouse-avoidance-random-shape))) (sit-for mouse-avoidance-animation-delay)) (setq mouse-avoidance-animating-pointer nil)) (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax) (+ (cdr (cdr cur)) deltay)))))) (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-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 () (if (not (mouse-avoidance-ignore-p)) (mouse-avoidance-banish-mouse))) (defun mouse-avoidance-exile () ;; 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)) ((and mouse-avoidance-state (not (mouse-avoidance-too-close-p mouse-avoidance-state))) (if (and (eq (car mp) (selected-frame)) (equal (cdr mp) (mouse-avoidance-banish-destination))) (mouse-avoidance-set-mouse-position ;; move back only if user has not moved mouse (cdr mouse-avoidance-state))) ;; but clear state anyway, to be ready for another move (setq mouse-avoidance-state nil)))))) (defun mouse-avoidance-fancy () ;; Used for the "fancy" modes, ie jump et al. (if (and (not mouse-avoidance-animating-pointer) (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. (apply 'set-mouse-position old-pos))))) ;;;###autoload (defun mouse-avoidance-mode (&optional mode) "Set cursor avoidance mode to MODE. 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' 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: * 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. * jump: If the cursor gets too close to the mouse, displace the mouse a random distance & direction. * animate: As `jump', but shows steps along the way for illusion of motion. * 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\".)" (interactive (list (intern (completing-read "Select cursor avoidance technique (SPACE for list): " '(("banish") ("exile") ("jump") ("animate") ("cat-and-mouse") ("proteus") ("none")) nil t)))) (if (eq mode 'cat-and-mouse) (setq mode 'animate)) (if mouse-avoidance-timer (cancel-timer mouse-avoidance-timer)) (setq mouse-avoidance-timer nil) ;; Restore pointer shape if necessary (if (eq mouse-avoidance-mode 'proteus) (mouse-avoidance-set-pointer-shape mouse-avoidance-old-pointer-shape)) ;; Do additional setup depending on version of mode requested (cond ((eq mode 'none) (setq mouse-avoidance-mode nil)) ((or (eq mode 'jump) (eq mode 'animate) (eq mode 'proteus)) (setq mouse-avoidance-timer (run-with-idle-timer 0.1 t 'mouse-avoidance-fancy)) (setq mouse-avoidance-mode mode mouse-avoidance-state (cons 0 0) 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)) (setq mouse-avoidance-mode mode mouse-avoidance-state nil)) ((or (eq mode 'banish) (eq mode t) (and (null mode) (null mouse-avoidance-mode)) (and mode (> (prefix-numeric-value mode) 0))) (setq mouse-avoidance-timer (run-with-idle-timer 0.1 t 'mouse-avoidance-banish)) (setq mouse-avoidance-mode 'banish)) (t (setq mouse-avoidance-mode nil))) (force-mode-line-update)) ;; Most people who use avoid mode leave it on all the time, so it's not ;; very informative to announce it in the mode line. ;;(or (assq 'mouse-avoidance-mode minor-mode-alist) ;; (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid") ;; minor-mode-alist))) ;; Needed for custom. (if mouse-avoidance-mode (mouse-avoidance-mode mouse-avoidance-mode)) ;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 ;;; avoid.el ends here