X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/f439a41c3ca070b5a5c0984d4d0c3603fb11e8d1..0bdebedefd366bae9164b896a53f3e4001297998:/beacon.el diff --git a/beacon.el b/beacon.el index d7be5a625..d9f239668 100644 --- a/beacon.el +++ b/beacon.el @@ -45,6 +45,7 @@ ;; ;; • To customize /when/ the beacon should blink at all, configure ;; `beacon-blink-when-window-scrolls', +;; `beacon-blink-when-window-changes', ;; `beacon-blink-when-buffer-changes', and ;; `beacon-blink-when-point-moves'. ;; @@ -89,6 +90,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) @@ -134,12 +139,25 @@ blink." ;;; 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. @@ -150,7 +168,6 @@ If COLORS is nil, OVERLAY is deleted!" (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))) @@ -162,15 +179,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." - (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)) @@ -260,6 +272,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. @@ -288,6 +301,10 @@ If DELTA is nil, return nil." (cond ((not (markerp beacon--previous-place)) (beacon--vanish)) + ;; 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 @@ -302,7 +319,8 @@ If DELTA is nil, return nil." (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.