X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/c507480196ff1812c4339a07ac6cc9ffb9dd0a7b..6f647f60c5b289cb593de779c9ee79ff88089a89:/beacon.el

diff --git a/beacon.el b/beacon.el
index 25a1b9e5e..149f6fbc7 100644
--- a/beacon.el
+++ b/beacon.el
@@ -6,7 +6,7 @@
 ;; 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
@@ -28,7 +28,7 @@
 
 ;;; Code:
 
-(require 'cl-lib)
+(require 'seq)
 
 (defgroup beacon nil
   "Customization group for beacon."
@@ -112,16 +112,21 @@ 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))))
+  (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)))
 
 (defun beacon--ov-at-point ()
-  (car (or (cl-member-if (lambda (o) (overlay-get o 'beacon))
-                         (overlays-in (point) (point)))
-           (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."
@@ -199,8 +204,8 @@ Only returns `beacon-size' elements."
 
 
 ;;; Movement detection
+(defvar beacon--window-scrolled nil)
 (defvar beacon--previous-place nil)
-(defvar beacon--previous-window-start nil)
 (defvar beacon--previous-mark-head nil)
 
 (defun beacon--movement-> (delta)
@@ -238,9 +243,10 @@ If DELTA is nil, return nil."
         (beacon-blink))))
    ;; Blink for scrolling.
    ((and beacon-blink-when-window-scrolls
-         (progn (redisplay)
-                (not (equal beacon--previous-window-start (window-start)))))
-    (beacon-blink))
+         beacon--window-scrolled
+         (equal beacon--window-scrolled (selected-window)))
+    (beacon-blink)
+    (setq beacon--window-scrolled nil))
    ;; Blink for movement
    ((beacon--movement-> beacon-blink-when-point-moves)
     (beacon-blink))
@@ -248,16 +254,29 @@ If DELTA is nil, return nil."
    (t (beacon--vanish)))
   (beacon--maybe-push-mark)
   (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))))
 
+(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)
+    (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)
 
@@ -266,7 +285,10 @@ If DELTA is nil, return nil."
   nil nil beacon-lighter nil
   :global t
   (if beacon-mode
-      (add-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))
+    (remove-hook 'window-scroll-functions #'beacon--window-scroll-function)
     (remove-hook 'post-command-hook #'beacon--post-command)))
 
 (provide 'beacon)