X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/8abbedcc63e7e3d6efd1c0bbbdfd678b88592d21..3e1defba2d847bec0f67570c3f8d9148823b1703:/beacon.el diff --git a/beacon.el b/beacon.el index 0628dadc6..290054eb0 100644 --- a/beacon.el +++ b/beacon.el @@ -1,11 +1,12 @@ -;;; 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 Artur Malabarba +;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Author: Artur Malabarba +;; URL: https://github.com/Malabarba/beacon ;; Keywords: convenience ;; Version: 0.1 -;; Package-Requires: ((cl-lib "0.5")) +;; Package-Requires: ((seq "1.9")) ;; 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 @@ -22,12 +23,42 @@ ;;; Commentary: -;; This is a global minor-mode. Turn it on everywhere with -;; (beacon-mode 1) +;; This is a global minor-mode. Turn it on everywhere with: +;; ┌──── +;; │ (beacon-mode 1) +;; └──── +;; +;; Whenever the window scrolls a light will shine on top of your cursor so +;; you know where it is. +;; +;; 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'. ;;; Code: -(require 'cl-lib) +(require 'seq) (defgroup beacon nil "Customization group for beacon." @@ -37,11 +68,14 @@ (defvar beacon--timer nil) (defcustom beacon-push-mark nil - "Should the mark be pushed before long movements?" - :type 'boolean) + "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 changing buffer? + "Should the beacon blink when moving a long distance? If nil, don't blink due to plain movement. If non-nil, this should be an integer, which is the minimum movement distance (in lines) that triggers a beacon blink." @@ -55,6 +89,10 @@ 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-duration 0.3 "Time, in seconds, that the blink should last." :type 'number) @@ -63,28 +101,93 @@ movement distance (in lines) that triggers a beacon blink." "Time, in seconds, before starting to fade the beacon." :type 'number) -(defcustom beacon-size 30 +(defcustom beacon-size 40 "Size of the beacon in characters." :type 'number) -(defcustom beacon-brightness 0.4 - "Brightness as a float between 0 and 1." - :type 'number) +(defcustom beacon-color 0.5 + "Color of the beacon. +This can be a string or a number. + +If it is a number, the color is taken to be white or +black (depending on the current theme's background) and this +number is a float between 0 and 1 specifing the brightness. + +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 + "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) + +(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) + "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)) ;;; 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. +If COLORS is nil, OVERLAY is deleted!" + (if (not colors) + (when (overlayp overlay) + (delete-overlay overlay)) + (overlay-put overlay 'beacon-colors colors) + (overlay-put overlay 'after-string + (propertize + (mapconcat (lambda (c) (propertize " " 'face (list :background c))) + colors + "") + 'cursor 1000)))) + +(defun beacon--after-string-overlay (colors) + "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." + ;; 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 (cl-member-if (lambda (o) (overlay-get o 'beacon)) - (overlays-at (point))))) + (car (or (seq-filter (lambda (o) (overlay-get o 'beacon)) + (overlays-in (point) (point))) + (seq-filter (lambda (o) (overlay-get o 'beacon)) + (overlays-at (point)))))) (defun beacon--vanish () "Turn off the beacon." @@ -106,12 +209,16 @@ 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)))) - (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04x%04x" r g b)) - (if (< (color-distance "black" bg) + (let* ((bg (color-values (face-attribute 'default :background))) + (fg (cond + ((stringp beacon-color) (color-values beacon-color)) + ((< (color-distance "black" bg) (color-distance "white" bg)) - (mapcar (lambda (n) (butlast (beacon--int-range (* beacon-brightness 65535) n))) bg) - (mapcar (lambda (n) (cdr (beacon--int-range (* (- 1 beacon-brightness) 65535) n))) 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)) + (mapcar (lambda (n) (butlast (beacon--int-range (elt fg n) (elt bg n)))) + [0 1 2])))) ;;; Blinking @@ -122,42 +229,67 @@ Only returns `beacon-size' elements." (while colors (if (looking-at "$") (progn - ;; (beacon--after-string) + (beacon--after-string-overlay colors) (setq colors nil)) (beacon--colored-overlay (pop colors)) (forward-char 1)))))) (defun beacon--dec () "Decrease the beacon brightness by one." - (let ((o (beacon--ov-at-point))) - (if (not o) - (beacon--vanish) - (delete-overlay o) - (save-excursion - (while (progn (forward-char 1) - (setq o (beacon--ov-at-point))) - (move-overlay o (1- (point)) (point))))))) + (pcase (beacon--ov-at-point) + (`nil (beacon--vanish)) + ((and o (let c (overlay-get o 'beacon-colors)) (guard c)) + (beacon--ov-put-after-string o (cdr c))) + (o + (delete-overlay o) + (save-excursion + (while (progn (forward-char 1) + (setq o (beacon--ov-at-point))) + (let ((colors (overlay-get o 'beacon-colors))) + (if (not colors) + (move-overlay o (1- (point)) (point)) + (forward-char -1) + (beacon--colored-overlay (pop colors)) + (beacon--ov-put-after-string o colors) + (forward-char 1)))))))) (defun beacon-blink () "Blink the beacon at the position of the cursor." (interactive) (beacon--vanish) - (beacon--shine) - (setq beacon--timer - (run-at-time beacon-blink-delay - (/ beacon-blink-duration 1.0 beacon-size) - #'beacon--dec))) + (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)))) ;;; Movement detection +(defvar beacon--window-scrolled nil) (defvar beacon--previous-place nil) -(defvar beacon--previous-window-start 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 + (markerp beacon--previous-place) + (equal (marker-buffer beacon--previous-place) + (current-buffer)) + (> (abs (- (point) beacon--previous-place)) + delta) + (> (count-screen-lines (min (point) beacon--previous-place) + (max (point) beacon--previous-place)) + delta))) (defun beacon--maybe-push-mark () "Push mark if it seems to be safe." - (when (and beacon-push-mark - (not mark-active)) + (when (and (not mark-active) + (beacon--movement-> beacon-push-mark)) (let ((head (car mark-ring))) (when (and (eq beacon--previous-mark-head head) (not (equal head beacon--previous-place))) @@ -168,39 +300,48 @@ Only returns `beacon-size' elements." (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 - (unless (window-minibuffer-p) - (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 - (progn (redisplay) - (not (equal beacon--previous-window-start (window-start))))) - (beacon--maybe-push-mark) + beacon--window-scrolled + (equal beacon--window-scrolled (selected-window))) (beacon-blink)) ;; Blink for movement - ((and beacon-blink-when-point-moves - (> (abs (- (point) beacon--previous-place)) - beacon-blink-when-point-moves) - (> (count-screen-lines (min (point) beacon--previous-place) - (max (point) beacon--previous-place)))) - (beacon--maybe-push-mark) + ((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-window-start (window-start)) (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. +If invoked during the command loop, record the current window so +that it may be blinked on post-command. This is because the +scrolled window might not be active, but we only know that at +`post-command-hook'. + +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))) ;;; Minor-mode -(defcustom beacon-lighter (cond - ((char-displayable-p ?💡) "💡") - ((char-displayable-p ?Λ) "Λ") - (t "*")) +(defcustom beacon-lighter + (cond + ((char-displayable-p ?💡) " 💡") + ((char-displayable-p ?Λ) " Λ") + (t " *")) "Lighter string used on the mode-line." :type 'string) @@ -209,8 +350,13 @@ Only returns `beacon-size' elements." nil nil beacon-lighter nil :global t (if beacon-mode - (add-hook 'post-command-hook #'beacon--post-command) - (remove-hook 'post-command-hook #'beacon--post-command))) + (progn + (add-hook 'window-scroll-functions #'beacon--window-scroll-function) + (add-hook 'post-command-hook #'beacon--post-command) + (add-hook 'pre-command-hook #'beacon--vanish)) + (remove-hook 'window-scroll-functions #'beacon--window-scroll-function) + (remove-hook 'post-command-hook #'beacon--post-command) + (remove-hook 'pre-command-hook #'beacon--vanish))) (provide 'beacon) ;;; beacon.el ends here