X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/729472997f2a86eb14277c1f0c2fc94709ff8cb9..ceff01b9e1f5e63a1e64d2b151ec6674d95ec98c:/beacon.el diff --git a/beacon.el b/beacon.el index 76d7652de..bfeeade2d 100644 --- a/beacon.el +++ b/beacon.el @@ -1,11 +1,11 @@ -;;; beacon.el --- Highlight the cursor whenever it moves long distances -*- lexical-binding: t; -*- +;;; beacon.el --- Highlight the cursor whenever the window scrolls -*- lexical-binding: t; -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Author: Artur Malabarba ;; URL: https://github.com/Malabarba/beacon ;; Keywords: convenience -;; Version: 0.1 +;; Version: 0.2.1 ;; Package-Requires: ((seq "1.9")) ;; This program is free software; you can redistribute it and/or modify @@ -28,25 +28,12 @@ ;; │ (beacon-mode 1) ;; └──── ;; -;; Whenever the window scrolls or the buffer changes a light will shine on -;; top of your cursor so you know where it is. +;; Whenever the window scrolls a light will shine on top of your cursor so +;; you know where it is. ;; ;; That’s it. ;; -;; -;; 1 Customizations -;; ════════════════ -;; -;; • To customize the appearance of the beacon, configure `beacon-size' -;; and `beacon-color'. -;; -;; • To customize how long it lasts, configure `beacon-blink-duration' -;; and `beacon-blink-delay'. -;; -;; • To customize /when/ it is used at all, configure -;; `beacon-blink-when-window-scrolls', -;; `beacon-blink-when-buffer-changes', and -;; `beacon-blink-when-point-moves'. +;; See the accompanying Readme.org for configuration details. ;;; Code: @@ -59,7 +46,7 @@ (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 @@ -81,6 +68,17 @@ movement distance (in lines) that triggers a beacon blink." "Should the beacon blink when the window scrolls?" :type 'boolean) +(defcustom beacon-blink-when-window-changes t + "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) @@ -105,23 +103,66 @@ If it is a string, it is a color name or specification, e.g. \"#666600\"." :type '(choice number color)) +(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. + +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 #'window-minibuffer-p) + +(defcustom beacon-dont-blink-major-modes '(magit-status-mode magit-popup-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 '(recenter-top-bottom) + "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)) + ;;; Overlays (defvar beacon--ovs nil) -(defun beacon--colored-overlay (color) +(defconst beacon-overlay-priority (/ most-positive-fixnum 2) + "Priotiy used on all of our overlays.") + +(defun beacon--make-overlay (length &rest properties) "Put an overlay at point with background COLOR." - (let ((ov (make-overlay (point) (1+ (point))))) - (overlay-put ov 'face (list :background color)) + (let ((ov (make-overlay (point) (+ length (point))))) (overlay-put ov 'beacon t) - (push ov beacon--ovs))) + ;; Our overlay is very temporary, so we take the liberty of giving + ;; it a high priority. + (overlay-put ov 'priority beacon-overlay-priority) + (overlay-put ov 'window (selected-window)) + (while properties + (overlay-put ov (pop properties) (pop properties))) + (push ov beacon--ovs) + ov)) + +(defun beacon--colored-overlay (color) + "Put an overlay at point with background COLOR." + (beacon--make-overlay 1 'face (list :background color))) (defun beacon--ov-put-after-string (overlay colors) "Add an after-string property to OVERLAY. The property's value is a string of spaces with background -COLORS applied to each one." +COLORS applied to each one. +If COLORS is nil, OVERLAY is deleted!" (if (not colors) - (delete-overlay overlay) + (when (overlayp overlay) + (delete-overlay overlay)) (overlay-put overlay 'beacon-colors colors) (overlay-put overlay 'after-string (propertize @@ -134,15 +175,10 @@ COLORS applied to each one." "Put an overlay at point with an after-string property. The property's value is a string of spaces with background COLORS applied to each one." - (let ((ov (make-overlay (point) (point))) - ;; The after-string must not be longer than the remaining columns from - ;; point to right window-end else it will be wrapped around (assuming - ;; truncate-lines is nil) introducing an ugly wrap-around for a - ;; fraction of a second. - (colors (seq-take colors (- (window-width) (current-column))))) - (beacon--ov-put-after-string ov colors) - (overlay-put ov 'beacon t) - (push ov beacon--ovs))) + ;; The after-string must not be longer than the remaining columns + ;; from point to right window-end else it will be wrapped around. + (let ((colors (seq-take colors (- (window-width) (current-column))))) + (beacon--ov-put-after-string (beacon--make-overlay 0) colors))) (defun beacon--ov-at-point () (car (or (seq-filter (lambda (o) (overlay-get o 'beacon)) @@ -218,7 +254,10 @@ Only returns `beacon-size' elements." "Blink the beacon at the position of the cursor." (interactive) (beacon--vanish) - (unless (window-minibuffer-p) + (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) + (memq (or this-command last-command) beacon-dont-blink-commands)) (beacon--shine) (setq beacon--timer (run-at-time beacon-blink-delay @@ -230,6 +269,7 @@ Only returns `beacon-size' elements." (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. @@ -238,11 +278,19 @@ If DELTA is nil, return nil." (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))) + ;; 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) + (> (max p beacon--previous-place) + (line-beginning-position)))))) (defun beacon--maybe-push-mark () "Push mark if it seems to be safe." @@ -258,26 +306,26 @@ If DELTA is nil, return nil." (cond ((not (markerp beacon--previous-place)) (beacon--vanish)) - ;; Blink because we changed buffer. - ((not (equal (marker-buffer beacon--previous-place) - (current-buffer))) - (when beacon-blink-when-buffer-changes - (beacon-blink))) + ;; Blink for switching windows. + ((and beacon-blink-when-window-changes + (not (eq beacon--previous-window (selected-window)))) + (beacon-blink)) ;; Blink for scrolling. ((and beacon-blink-when-window-scrolls beacon--window-scrolled (equal beacon--window-scrolled (selected-window))) - (beacon-blink) - (setq beacon--window-scrolled nil)) + (beacon-blink)) ;; 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--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-place (point-marker)) + (setq beacon--previous-window (selected-window)))) (defun beacon--window-scroll-function (win _start-pos) "Blink the beacon or record that window has been scrolled. @@ -290,15 +338,21 @@ 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))) + +(defun beacon--blink-on-focus () + "Blink if `beacon-blink-when-focused' is non-nil" + (when beacon-blink-when-focused (beacon-blink))) ;;; 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) @@ -309,9 +363,17 @@ unreliable, so just blink immediately." (if beacon-mode (progn (add-hook 'window-scroll-functions #'beacon--window-scroll-function) - (add-hook 'post-command-hook #'beacon--post-command)) + (add-hook 'focus-in-hook #'beacon--blink-on-focus) + (add-hook 'post-command-hook #'beacon--post-command) + (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 'post-command-hook #'beacon--post-command) + (remove-hook 'pre-command-hook #'beacon--vanish))) (provide 'beacon) ;;; beacon.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: