Default `beacon-push-mark' to 35

[gnu-emacs-elpa] / beacon.el

diff --git a/beacon.el b/beacon.el
index 8e24120081cc8335f0a49ace3fd779483d224ea8..66853ca9a8c8ea976c98d9c2a95250df9aa1e15b 100644 (file)
--- 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 <emacs@endlessparentheses.com>
 ;; URL: https://github.com/Malabarba/beacon
 ;; Keywords: convenience
 
 ;; Copyright (C) 2015 Free Software Foundation, Inc.
 
 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
 ;; URL: https://github.com/Malabarba/beacon
 ;; Keywords: convenience

-;; Version: 0.1
+;; Version: 0.1.1

 ;; Package-Requires: ((seq "1.9"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; Package-Requires: ((seq "1.9"))
 
 ;; This program is free software; you can redistribute it and/or modify


@@ -28,25 +28,12 @@
 ;; │ (beacon-mode 1)
 ;; └────
 ;;
 ;; │ (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.
 ;;
 ;;
 ;; 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:
 
 
 ;;; Code:
 


@@ -59,7 +46,7 @@
 
 (defvar beacon--timer nil)
 
 
 (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
   "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,10 @@ movement distance (in lines) that triggers a beacon blink."
   "Should the beacon blink when the window scrolls?"
   :type 'boolean)
 
   "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)
 (defcustom beacon-blink-duration 0.3
   "Time, in seconds, that the blink should last."
   :type 'number)


@@ -105,33 +96,57 @@ If it is a string, it is a color name or specification,
 e.g. \"#666600\"."
   :type '(choice number color))
 
 e.g. \"#666600\"."
   :type '(choice number color))
 

-(defcustom beacon-dont-blink-predicates nil
+(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
   "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)
 
 (add-hook 'beacon-dont-blink-predicates #'window-minibuffer-p)
 

-(defcustom beacon-dont-blink-major-modes nil
+(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))
 
   "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))
+

 \f
 ;;; Overlays
 (defvar beacon--ovs nil)
 
 \f
 ;;; 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."
   "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)
     (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.
 
 (defun beacon--ov-put-after-string (overlay colors)
   "Add an after-string property to OVERLAY.


@@ -142,7 +157,6 @@ If COLORS is nil, OVERLAY is deleted!"
       (when (overlayp overlay)
         (delete-overlay overlay))
     (overlay-put overlay 'beacon-colors colors)
       (when (overlayp overlay)
         (delete-overlay overlay))
     (overlay-put overlay 'beacon-colors colors)

-    (overlay-put overlay 'priority most-positive-fixnum)

     (overlay-put overlay 'after-string
                  (propertize
                   (mapconcat (lambda (c) (propertize " " 'face (list :background c)))
     (overlay-put overlay 'after-string
                  (propertize
                   (mapconcat (lambda (c) (propertize " " 'face (list :background c)))


@@ -154,15 +168,10 @@ If COLORS is nil, OVERLAY is deleted!"
   "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."
   "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))
 
 (defun beacon--ov-at-point ()
   (car (or (seq-filter (lambda (o) (overlay-get o 'beacon))


@@ -240,7 +249,8 @@ Only returns `beacon-size' elements."
   (beacon--vanish)
   (unless (or (not beacon-mode)
               (run-hook-with-args-until-success 'beacon-dont-blink-predicates)
   (beacon--vanish)
   (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))
+              (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
     (beacon--shine)
     (setq beacon--timer
           (run-at-time beacon-blink-delay


@@ -252,6 +262,7 @@ Only returns `beacon-size' elements."
 (defvar beacon--window-scrolled nil)
 (defvar beacon--previous-place nil)
 (defvar beacon--previous-mark-head nil)
 (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.
 
 (defun beacon--movement-> (delta)
   "Return non-nil if latest point movement is > DELTA.


@@ -280,26 +291,26 @@ If DELTA is nil, return nil."
   (cond
    ((not (markerp beacon--previous-place))
     (beacon--vanish))
   (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)))
    ;; 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)
    ;; 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))
   (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.
 
 (defun beacon--window-scroll-function (win _start-pos)
   "Blink the beacon or record that window has been scrolled.


@@ -312,6 +323,7 @@ If invoked outside the command loop, `post-command-hook' would be
 unreliable, so just blink immediately."
   (if this-command
       (setq beacon--window-scrolled win)
 unreliable, so just blink immediately."
   (if this-command
       (setq beacon--window-scrolled win)

+    (setq beacon--window-scrolled nil)

     (beacon-blink)))
 
 \f
     (beacon-blink)))
 
 \f