X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/3e1defba2d847bec0f67570c3f8d9148823b1703..aaeb619f1ff57e666925bcef22bb3195c22d589e:/beacon.el diff --git a/beacon.el b/beacon.el index 290054eb0..9a3edacb1 100644 --- a/beacon.el +++ b/beacon.el @@ -5,8 +5,8 @@ ;; Author: Artur Malabarba ;; URL: https://github.com/Malabarba/beacon ;; Keywords: convenience -;; Version: 0.1 -;; Package-Requires: ((seq "1.9")) +;; Version: 1.3.1 +;; Package-Requires: ((seq "2.14")) ;; 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 @@ -33,32 +33,29 @@ ;; ;; That’s it. ;; -;; -;; 1 Customizations -;; ════════════════ -;; -;; • The appearance of the beacon is configured by `beacon-size' and -;; `beacon-color'. -;; -;; • The duration is configured by `beacon-blink-duration' and -;; `beacon-blink-delay'. -;; -;; • To customize /when/ the beacon should blink at all, configure -;; `beacon-blink-when-window-scrolls', -;; `beacon-blink-when-window-changes', and -;; `beacon-blink-when-point-moves'. -;; -;; • To prevent the beacon from blinking only on some major-modes, -;; configure `beacon-dont-blink-major-modes'. For specific buffers, you -;; can do `(setq-local beacon-mode nil)'. For even more refined -;; control, configure `beacon-dont-blink-predicates' -;; -;; • Beacon can also push the mark for you whenever point moves a long -;; distance. For this, configure `beacon-push-mark'. +;; See the accompanying Readme.org for configuration details. ;;; Code: (require 'seq) +(require 'faces) +(unless (fboundp 'seq-mapn) + ;; This is for people who are on outdated Emacs snapshots. Will be + ;; deleted in a couple of weeks. + (defun seq-mapn (function sequence &rest sequences) + "Like `seq-map' but FUNCTION is mapped over all SEQUENCES. +The arity of FUNCTION must match the number of SEQUENCES, and the +mapping stops on the shortest sequence. +Return a list of the results. + +\(fn FUNCTION SEQUENCES...)" + (let ((result nil) + (sequences (seq-map (lambda (s) (seq-into s 'list)) + (cons sequence sequences)))) + (while (not (memq nil sequences)) + (push (apply function (seq-map #'car sequences)) result) + (setq sequences (seq-map #'cdr sequences))) + (nreverse result)))) (defgroup beacon nil "Customization group for beacon." @@ -67,20 +64,27 @@ (defvar beacon--timer nil) -(defcustom beacon-push-mark nil +(defcustom beacon-push-mark 35 "Should the mark be pushed before long movements? If nil, `beacon' will not push the mark. Otherwise this should be a number, and `beacon' will push the mark whenever point moves more than that many lines." :type '(choice integer (const nil))) -(defcustom beacon-blink-when-point-moves nil - "Should the beacon blink when moving a long distance? -If nil, don't blink due to plain movement. +(defcustom beacon-blink-when-point-moves-vertically nil + "Should the beacon blink when moving a long distance vertically? +If nil, don't blink due to vertical movement. If non-nil, this should be an integer, which is the minimum movement distance (in lines) that triggers a beacon blink." :type '(choice integer (const nil))) +(defcustom beacon-blink-when-point-moves-horizontally nil + "Should the beacon blink when moving a long distance horizontally? +If nil, don't blink due to horizontal movement. +If non-nil, this should be an integer, which is the minimum +movement distance (in columns) that triggers a beacon blink." + :type '(choice integer (const nil))) + (defcustom beacon-blink-when-buffer-changes t "Should the beacon blink when changing buffer?" :type 'boolean) @@ -93,6 +97,13 @@ movement distance (in lines) that triggers a beacon blink." "Should the beacon blink when the window changes?" :type 'boolean) +(defcustom beacon-blink-when-focused nil + "Should the beacon blink when Emacs gains focus? +Note that, due to a limitation of `focus-in-hook', this might +trigger false positives on some systems." + :type 'boolean + :package-version '(beacon . "0.2")) + (defcustom beacon-blink-duration 0.3 "Time, in seconds, that the blink should last." :type 'number) @@ -117,23 +128,63 @@ If it is a string, it is a color name or specification, e.g. \"#666600\"." :type '(choice number color)) -(defcustom beacon-dont-blink-predicates nil +(defface beacon-fallback-background + '((((class color) (background light)) (:background "black")) + (((class color) (background dark)) (:background "white"))) + "Fallback beacon background color. +Used in cases where the color can't be determined by Emacs. +Only the background of this face is used.") + +(defvar beacon-dont-blink-predicates nil "A list of predicates that prevent the beacon blink. These predicate functions are called in order, with no arguments, before blinking the beacon. If any returns -non-nil, the beacon will not blink." - :type 'hook) +non-nil, the beacon will not blink. + +For instance, if you want to disable beacon on buffers where +`hl-line-mode' is on, you can do: + + (add-hook \\='beacon-dont-blink-predicates + (lambda () (bound-and-true-p hl-line-mode)))") -(add-hook 'beacon-dont-blink-predicates (lambda () (bound-and-true-p hl-line-mode))) (add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p) -(defcustom beacon-dont-blink-major-modes '(magit-status-mode) +(defcustom beacon-dont-blink-major-modes '(t magit-status-mode magit-popup-mode + inf-ruby-mode + gnus-summary-mode gnus-group-mode) "A list of major-modes where the beacon won't blink. Whenever the current buffer satisfies `derived-mode-p' for one of the major-modes on this list, the beacon will not blink." :type '(repeat symbol)) +(defcustom beacon-dont-blink-commands '(next-line previous-line + forward-line) + "A list of commands that should not make the beacon blink. +Use this for commands that scroll the window in very +predictable ways, when the blink would be more distracting +than helpful.." + :type '(repeat symbol)) + +(defcustom beacon-before-blink-hook nil + "Hook run immediately before blinking the beacon." + :type 'hook) + + +;;; Internal variables +(defvar beacon--window-scrolled nil) +(defvar beacon--previous-place nil) +(defvar beacon--previous-mark-head nil) +(defvar beacon--previous-window nil) +(defvar beacon--previous-window-start 0) + +(defun beacon--record-vars () + (unless (window-minibuffer-p) + (setq beacon--previous-mark-head (car mark-ring)) + (setq beacon--previous-place (point-marker)) + (setq beacon--previous-window (selected-window)) + (setq beacon--previous-window-start (window-start)))) + ;;; Overlays (defvar beacon--ovs nil) @@ -185,16 +236,18 @@ COLORS applied to each one." (defun beacon--ov-at-point () (car (or (seq-filter (lambda (o) (overlay-get o 'beacon)) - (overlays-in (point) (point))) + (overlays-in (point) (point))) (seq-filter (lambda (o) (overlay-get o 'beacon)) - (overlays-at (point)))))) + (overlays-at (point)))))) -(defun beacon--vanish () +(defun beacon--vanish (&rest _) "Turn off the beacon." - (when (timerp beacon--timer) - (cancel-timer beacon--timer)) - (mapc #'delete-overlay beacon--ovs) - (setq beacon--ovs nil)) + (unless (string-match "\\` \\*\\(temp-buffer\\|Echo Area.*\\)\\*" + (buffer-name)) + (when (timerp beacon--timer) + (cancel-timer beacon--timer)) + (mapc #'delete-overlay beacon--ovs) + (setq beacon--ovs nil))) ;;; Colors @@ -209,14 +262,25 @@ Only returns `beacon-size' elements." (defun beacon--color-range () "Return a list of background colors for the beacon." - (let* ((bg (color-values (face-attribute 'default :background))) + (let* ((default-bg (or (save-excursion + (unless (eobp) + (forward-line 1) + (unless (or (bobp) (not (bolp))) + (forward-char -1))) + (background-color-at-point)) + (face-background 'default))) + (bg (color-values (if (or (not (stringp default-bg)) + (string-match "\\`unspecified-" default-bg)) + (face-attribute 'beacon-fallback-background :background) + default-bg))) (fg (cond ((stringp beacon-color) (color-values beacon-color)) - ((< (color-distance "black" bg) - (color-distance "white" bg)) + ((and (stringp bg) + (< (color-distance "black" bg) + (color-distance "white" bg))) (make-list 3 (* beacon-color 65535))) (t (make-list 3 (* (- 1 beacon-color) 65535)))))) - (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b)) + (apply #'seq-mapn (lambda (r g b) (format "#%04x%04x%04x" r g b)) (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n)))) [0 1 2])))) @@ -243,8 +307,10 @@ Only returns `beacon-size' elements." (o (delete-overlay o) (save-excursion - (while (progn (forward-char 1) - (setq o (beacon--ov-at-point))) + (while (and (condition-case nil + (progn (forward-char 1) t) + (end-of-buffer nil)) + (setq o (beacon--ov-at-point))) (let ((colors (overlay-get o 'beacon-colors))) (if (not colors) (move-overlay o (1- (point)) (point)) @@ -253,38 +319,66 @@ Only returns `beacon-size' elements." (beacon--ov-put-after-string o colors) (forward-char 1)))))))) +;;;###autoload (defun beacon-blink () - "Blink the beacon at the position of the cursor." + "Blink the beacon at the position of the cursor. +Unlike `beacon-blink-automated', the beacon will blink +unconditionally (even if `beacon-mode' is disabled), and this can +be invoked as a user command or called from lisp code." (interactive) (beacon--vanish) + (run-hooks 'beacon-before-blink-hook) + (beacon--shine) + (setq beacon--timer + (run-at-time beacon-blink-delay + (/ beacon-blink-duration 1.0 beacon-size) + #'beacon--dec))) + +(defun beacon-blink-automated () + "If appropriate, blink the beacon at the position of the cursor. +Unlike `beacon-blink', the blinking is conditioned on a series of +variables: `beacon-mode', `beacon-dont-blink-commands', +`beacon-dont-blink-major-modes', and +`beacon-dont-blink-predicates'." + ;; Record vars here in case something is blinking outside the + ;; command loop. + (beacon--record-vars) (unless (or (not beacon-mode) (run-hook-with-args-until-success 'beacon-dont-blink-predicates) - (seq-find #'derived-mode-p beacon-dont-blink-major-modes)) - (beacon--shine) - (setq beacon--timer - (run-at-time beacon-blink-delay - (/ beacon-blink-duration 1.0 beacon-size) - #'beacon--dec)))) + (seq-find #'derived-mode-p beacon-dont-blink-major-modes) + (memq (or this-command last-command) beacon-dont-blink-commands)) + (beacon-blink))) ;;; Movement detection -(defvar beacon--window-scrolled nil) -(defvar beacon--previous-place nil) -(defvar beacon--previous-mark-head nil) -(defvar beacon--previous-window nil) - -(defun beacon--movement-> (delta) - "Return non-nil if latest point movement is > DELTA. -If DELTA is nil, return nil." - (and delta +(defun beacon--movement-> (delta-y &optional delta-x) + "Return non-nil if latest vertical movement is > DELTA-Y. +If DELTA-Y is nil, return nil. +The same is true for DELTA-X and horizonta movement." + (and delta-y (markerp beacon--previous-place) (equal (marker-buffer beacon--previous-place) (current-buffer)) + ;; Quick check that prevents running the code below in very + ;; short movements (like typing). (> (abs (- (point) beacon--previous-place)) - delta) - (> (count-screen-lines (min (point) beacon--previous-place) - (max (point) beacon--previous-place)) - delta))) + delta-y) + ;; Col movement. + (or (and delta-x + (> (abs (- (current-column) + (save-excursion + (goto-char beacon--previous-place) + (current-column)))) + delta-x)) + ;; Check if the movement was >= DELTA lines by moving DELTA + ;; lines. `count-screen-lines' is too slow if the movement had + ;; thousands of lines. + (save-excursion + (let ((p (point))) + (goto-char (min beacon--previous-place p)) + (vertical-motion delta-y) + (> (max p beacon--previous-place) + (line-beginning-position))))))) (defun beacon--maybe-push-mark () "Push mark if it seems to be safe." @@ -293,35 +387,34 @@ If DELTA is nil, return nil." (let ((head (car mark-ring))) (when (and (eq beacon--previous-mark-head head) (not (equal head beacon--previous-place))) - (push-mark beacon--previous-place))))) + (push-mark beacon--previous-place 'silent))))) (defun beacon--post-command () "Blink if point moved very far." (cond - ((not (markerp beacon--previous-place)) - (beacon--vanish)) + ;; Sanity check. + ((not (markerp beacon--previous-place))) + ;; Blink for switching buffers. + ((and beacon-blink-when-buffer-changes + (not (eq (marker-buffer beacon--previous-place) + (current-buffer)))) + (beacon-blink-automated)) ;; Blink for switching windows. ((and beacon-blink-when-window-changes - (not (eq beacon--previous-window (selected-window)))) - (beacon-blink)) + (not (eq beacon--previous-window (selected-window)))) + (beacon-blink-automated)) ;; Blink for scrolling. - ((and beacon-blink-when-window-scrolls - beacon--window-scrolled + ((and beacon--window-scrolled (equal beacon--window-scrolled (selected-window))) - (beacon-blink)) + (beacon-blink-automated)) ;; Blink for movement - ((beacon--movement-> beacon-blink-when-point-moves) - (beacon-blink)) - ;; Even if we don't blink, vanish any previous beacon. - (t (beacon--vanish))) + ((beacon--movement-> beacon-blink-when-point-moves-vertically + beacon-blink-when-point-moves-horizontally) + (beacon-blink-automated))) (beacon--maybe-push-mark) - (setq beacon--window-scrolled nil) - (unless (window-minibuffer-p) - (setq beacon--previous-mark-head (car mark-ring)) - (setq beacon--previous-place (point-marker)) - (setq beacon--previous-window (selected-window)))) + (setq beacon--window-scrolled nil)) -(defun beacon--window-scroll-function (win _start-pos) +(defun beacon--window-scroll-function (win start-pos) "Blink the beacon or record that window has been scrolled. If invoked during the command loop, record the current window so that it may be blinked on post-command. This is because the @@ -330,18 +423,26 @@ scrolled window might not be active, but we only know that at If invoked outside the command loop, `post-command-hook' would be unreliable, so just blink immediately." - (if this-command - (setq beacon--window-scrolled win) - (setq beacon--window-scrolled nil) - (beacon-blink))) + (unless (or (and (equal beacon--previous-window-start start-pos) + (equal beacon--previous-window win)) + (not beacon-blink-when-window-scrolls)) + (if this-command + (setq beacon--window-scrolled win) + (setq beacon--window-scrolled nil) + (beacon-blink-automated)))) + +(defun beacon--blink-on-focus () + "Blink if `beacon-blink-when-focused' is non-nil" + (when beacon-blink-when-focused + (beacon-blink-automated))) ;;; Minor-mode (defcustom beacon-lighter (cond - ((char-displayable-p ?💡) " 💡") - ((char-displayable-p ?Λ) " Λ") - (t " *")) + ;; ((char-displayable-p ?💡) " 💡") + ;; ((char-displayable-p ?Λ) " Λ") + (t " (*)")) "Lighter string used on the mode-line." :type 'string) @@ -352,11 +453,21 @@ unreliable, so just blink immediately." (if beacon-mode (progn (add-hook 'window-scroll-functions #'beacon--window-scroll-function) + (add-hook 'focus-in-hook #'beacon--blink-on-focus) (add-hook 'post-command-hook #'beacon--post-command) + (add-hook 'before-change-functions #'beacon--vanish) + (add-hook 'pre-command-hook #'beacon--record-vars) (add-hook 'pre-command-hook #'beacon--vanish)) + (remove-hook 'focus-in-hook #'beacon--blink-on-focus) (remove-hook 'window-scroll-functions #'beacon--window-scroll-function) (remove-hook 'post-command-hook #'beacon--post-command) + (remove-hook 'before-change-functions #'beacon--vanish) + (remove-hook 'pre-command-hook #'beacon--record-vars) (remove-hook 'pre-command-hook #'beacon--vanish))) (provide 'beacon) ;;; beacon.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: