From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Kaushal Modi Newsgroups: gmane.emacs.devel Subject: Re: [ELPA] New package: beacon Date: Thu, 15 Oct 2015 13:33:24 -0400 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/alternative; boundary=001a1140b482d09dd4052228152b X-Trace: ger.gmane.org 1444930525 28379 80.91.229.3 (15 Oct 2015 17:35:25 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 15 Oct 2015 17:35:25 +0000 (UTC) Cc: emacs-devel To: Artur Malabarba Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Oct 15 19:35:18 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1ZmmQv-0005bT-QL for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 19:35:18 +0200 Original-Received: from localhost ([::1]:48887 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmQv-0001Sp-3V for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 13:35:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37637) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmPn-0000xD-JG for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:34:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZmmPk-0002gB-AE for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:34:07 -0400 Original-Received: from mail-oi0-x230.google.com ([2607:f8b0:4003:c06::230]:36760) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmPk-0002g7-0s for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:34:04 -0400 Original-Received: by oihr205 with SMTP id r205so50263971oih.3 for ; Thu, 15 Oct 2015 10:34:03 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:in-reply-to:references:from:date:message-id:subject:to :cc:content-type; bh=6RxGz7s9VSIsq3QXkuKqVJ9SFYqhjbVIrgtERrs0wQw=; b=IF29LRDehVrgJfLS0oqv/XTp/VNHnfDM2TYZdyAWQD2oLPrxouNED3uCa4eOASF/++ cX3QrhSmApIwshN+V3wcc0Hi62g14i6OkX0l9CBMak2w+wFLHbxgyWl6hx3jEmRjXx6I tkr0yayLV43adxa3JMpLeKGwaXW7GXFywYmouZmUBgiuPTjRq9j301/jnZIqpajLah2+ s53teKmibaF8aMT5J0G2qCVMbl3cOhLe1bUU5P7iC8nJdACwc04x4uZgVN0SskGmpIoM k1JYrIJ/hiDIx9TnQFTEZhiEf8bbbBcK0RO8Jtv+sz2M9/RQf/VvTKeiTZRdDe7S8KC6 UL3Q== X-Received: by 10.202.104.35 with SMTP id d35mr6253192oic.57.1444930443580; Thu, 15 Oct 2015 10:34:03 -0700 (PDT) Original-Received: by 10.202.44.8 with HTTP; Thu, 15 Oct 2015 10:33:24 -0700 (PDT) In-Reply-To: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2607:f8b0:4003:c06::230 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:191670 Archived-At: --001a1140b482d09dd4052228152b Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable BTW, I just tried it out and it looks great! I like that meteor trail effect :) I now just need to figure out how to make it play nice with fci-mode. If a beacon pre/post hook is available, I can disable/enable fci-mode in there. I have this to make fci-mode play nice with popup: ;; Turn off fci-mode when popups are activated ;; https://github.com/alpaker/Fill-Column-Indicator/issues/21#issuecomment-695= 9718 (with-eval-after-load 'popup (defvar sanityinc/fci-mode-suppressed nil) (defun sanityinc/suppress-fci-mode (&rest args) "Suspend fci-mode while popups are visible" (setq-local sanityinc/fci-mode-suppressed fci-mode) (when fci-mode (turn-off-fci-mode))) (advice-add 'popup-create :before #'sanityinc/suppress-fci-mode) (defun sanityinc/restore-fci-mode (&rest args) "Restore fci-mode when all popups have closed" (when (and sanityinc/fci-mode-suppressed (null popup-instances)) (setq-local sanityinc/fci-mode-suppressed nil) (turn-on-fci-mode))) (advice-add 'popup-delete :after #'sanityinc/restore-fci-mode)) -- Kaushal Modi On Thu, Oct 15, 2015 at 1:26 PM, Kaushal Modi wrote: > Of course pulse.el is a library which other packages might find useful an= d > beacon.el is an end-user package. I was just curious if the technique use= d > to set overlay on the current position was similar. > > > -- > Kaushal Modi > > On Thu, Oct 15, 2015 at 1:24 PM, Kaushal Modi > wrote: > >> I haven't read either of the source codes, but is it similar to >> lisp/cedet/pulse.el? >> >> >> -- >> Kaushal Modi >> >> On Thu, Oct 15, 2015 at 1:02 PM, Artur Malabarba < >> bruce.connor.am@gmail.com> wrote: >> >>> Whenever the window scrolls or the buffer changes a light will shine on >>> top of your cursor so you know where it is. >>> >>> That=E2=80=99s it. See this gif for example: >>> https://github.com/Malabarba/beacon/raw/master/example-beacon.gif >>> >>> >>> ---------- >>> >>> >>> ;;; beacon.el --- Highlight the cursor when 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 >>> ;; 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 >>> ;; the Free Software Foundation, either version 3 of the License, or >>> ;; (at your option) any later version. >>> >>> ;; This program is distributed in the hope that it will be useful, >>> ;; but WITHOUT ANY WARRANTY; without even the implied warranty of >>> ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the >>> ;; GNU General Public License for more details. >>> >>> ;; You should have received a copy of the GNU General Public License >>> ;; along with this program. If not, see = . >>> >>> ;;; Commentary: >>> >>> ;; This is a global minor-mode. Turn it on everywhere with: >>> ;; =E2=94=8C=E2=94=80=E2=94=80=E2=94=80=E2=94=80 >>> ;; =E2=94=82 (beacon-mode 1) >>> ;; =E2=94=94=E2=94=80=E2=94=80=E2=94=80=E2=94=80 >>> ;; >>> ;; Whenever the window scrolls or the buffer changes a light will shine >>> on >>> ;; top of your cursor so you know where it is. >>> ;; >>> ;; That=E2=80=99s it. >>> ;; >>> ;; >>> ;; 1 Customizations >>> ;; =E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2= =95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95= =90 >>> ;; >>> ;; =E2=80=A2 To customize the appearance of the beacon, configure `be= acon-size' >>> ;; and `beacon-color'. >>> ;; >>> ;; =E2=80=A2 To customize how long it lasts, configure `beacon-blink-= duration' >>> ;; and `beacon-blink-delay'. >>> ;; >>> ;; =E2=80=A2 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'. >>> >>> ;;; Code: >>> >>> (require 'seq) >>> >>> (defgroup beacon nil >>> "Customization group for beacon." >>> :group 'emacs >>> :prefix "beacon-") >>> >>> (defvar beacon--timer nil) >>> >>> (defcustom beacon-push-mark nil >>> "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 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." >>> :type '(choice integer (const nil))) >>> >>> (defcustom beacon-blink-when-buffer-changes t >>> "Should the beacon blink when changing buffer?" >>> :type 'boolean) >>> >>> (defcustom beacon-blink-when-window-scrolls t >>> "Should the beacon blink when the window scrolls?" >>> :type 'boolean) >>> >>> (defcustom beacon-blink-duration 0.3 >>> "Time, in seconds, that the blink should last." >>> :type 'number) >>> >>> (defcustom beacon-blink-delay 0.3 >>> "Time, in seconds, before starting to fade the beacon." >>> :type 'number) >>> >>> (defcustom beacon-size 40 >>> "Size of the beacon in characters." >>> :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)) >>> >>> >>> ;;; Overlays >>> (defvar beacon--ovs nil) >>> >>> (defun beacon--colored-overlay (color) >>> "Put an overlay at point with background COLOR." >>> (let ((ov (make-overlay (point) (1+ (point))))) >>> (overlay-put ov 'face (list :background color)) >>> (overlay-put ov 'beacon t) >>> (push ov beacon--ovs))) >>> >>> (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 (not colors) >>> (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." >>> (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 (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." >>> (when (timerp beacon--timer) >>> (cancel-timer beacon--timer)) >>> (mapc #'delete-overlay beacon--ovs) >>> (setq beacon--ovs nil)) >>> >>> >>> ;;; Colors >>> (defun beacon--int-range (a b) >>> "Return a list of integers between A inclusive and B exclusive. >>> Only returns `beacon-size' elements." >>> (let ((d (/ (- b a) beacon-size)) >>> (out (list a))) >>> (dotimes (_ (1- beacon-size)) >>> (push (+ (car out) d) out)) >>> (nreverse out))) >>> >>> (defun beacon--color-range () >>> "Return a list of background colors for the beacon." >>> (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)) >>> (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 >>> (defun beacon--shine () >>> "Shine a beacon at point." >>> (let ((colors (beacon--color-range))) >>> (save-excursion >>> (while colors >>> (if (looking-at "$") >>> (progn >>> (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." >>> (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))) >>> >>> >>> ;;; Movement detection >>> (defvar beacon--window-scrolled nil) >>> (defvar beacon--previous-place nil) >>> (defvar beacon--previous-mark-head 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 (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))) >>> (push-mark beacon--previous-place))))) >>> >>> (defun beacon--post-command () >>> "Blink if point moved very far." >>> (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 scrolling. >>> ((and beacon-blink-when-window-scrolls >>> 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)) >>> ;; Even if we don't blink, vanish any previous beacon. >>> (t (beacon--vanish))) >>> (beacon--maybe-push-mark) >>> (unless (window-minibuffer-p) >>> (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 ?=F0=9F=92=A1) " =F0=9F=92=A1") >>> ((char-displayable-p ?=CE=9B) " =CE=9B") >>> (t " *")) >>> "Lighter string used on the mode-line." >>> :type 'string) >>> >>> ;;;###autoload >>> (define-minor-mode beacon-mode >>> nil nil beacon-lighter nil >>> :global t >>> (if beacon-mode >>> (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) >>> ;;; beacon.el ends here >>> >>> >> > --001a1140b482d09dd4052228152b Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: quoted-printable
BTW, I just tried it out and it = looks great! I like that meteor trail effect :)

I now just need to figure out how t= o make it play nice with fci-mode.

If a beacon pre/post hook is available, I can d= isable/enable fci-mode in there.

<= div class=3D"gmail_default" style=3D"font-family:'trebuchet ms',san= s-serif;font-size:small">I have this to make fci-mode play nice with popup:=

=C2=A0 =C2=A0 ;; Turn off fci-mode when popups are activated
=C2=A0 =C2=A0 ;; https://github.com/alpaker= /Fill-Column-Indicator/issues/21#issuecomment-6959718
= =C2=A0 =C2=A0 (with-eval-after-load 'popup
=C2=A0 =C2= =A0 =C2=A0 (defvar sanityinc/fci-mode-suppressed nil)

=
=C2=A0 =C2=A0 =C2=A0 (defun sanityinc/suppress-fci-mode (= &rest args)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 "Suspend = fci-mode while popups are visible"
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 (setq-local sanityinc/fci-mode-suppressed fci-mode)
=
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (when fci-mode
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 (turn-off-fci-mode)))
=C2=A0 =C2= =A0 =C2=A0 (advice-add 'popup-create :before #'sanityinc/suppress-f= ci-mode)

=C2=A0 =C2=A0 =C2=A0 (defun= sanityinc/restore-fci-mode (&rest args)
=C2=A0 =C2=A0= =C2=A0 =C2=A0 "Restore fci-mode when all popups have closed"
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (when (and sanityinc/fci-mode-sup= pressed
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0(null popup-instances))
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 (setq-local sanityinc/fci-mode-suppressed nil)<= /div>
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (turn-on-fci-mode)))
=C2=A0 =C2=A0 =C2=A0 (advice-add 'popup-delete :after #'san= ityinc/restore-fci-mode))



<= /div>


--Kaushal Modi

On Thu, Oct 15, 2015 at 1:26 PM, Kaushal Mod= i <kaushal.modi@gmail.com> wrote:
Of course pulse.el is a libr= ary which other packages might find useful and beacon.el is an end-user pac= kage. I was just curious if the technique used to set overlay on the curren= t position was similar.


--
= Kaushal Modi

On Thu, Oct 15, 2015 at 1:24 PM, Kaushal Mod= i <kaushal.modi@gmail.com> wrote:
I haven't read either of= the source codes, but is it similar to lisp/cedet/pulse.el?


--
Kaushal Modi

On Thu, Oct 15, 2015 at 1:02 PM, Artur Malab= arba <bruce.connor.am@gmail.com> wrote:
Whenever the window scrolls or the buffer changes a l= ight will shine on
top of your cursor so you know where it is.

That=E2=80=99s it. See this gif for example:
https://github.com/Malabarba/beacon= /raw/master/example-beacon.gif


----------


;;; beacon.el --- Highlight the cursor when the window scrolls=C2=A0 -*- lexical-binding: t; -*-

;; Copyright (C) 2015 Free Software Foundation, Inc.

;; Author: Artur Malabarba <emacs@endlessparentheses.com>
;; URL: https://github.com/Malabarba/beacon
;; Keywords: convenience
;; Version: 0.1
;; 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
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.=C2=A0 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.=C2=A0 If not, see <http://www.gnu.org/lic= enses/>.

;;; Commentary:

;; This is a global minor-mode. Turn it on everywhere with:
;; =E2=94=8C=E2=94=80=E2=94=80=E2=94=80=E2=94=80
;; =E2=94=82 (beacon-mode 1)
;; =E2=94=94=E2=94=80=E2=94=80=E2=94=80=E2=94=80
;;
;; Whenever the window scrolls or the buffer changes a light will shine on<= br> ;; top of your cursor so you know where it is.
;;
;; That=E2=80=99s it.
;;
;;
;; 1 Customizations
;; =E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90= =E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90=E2=95=90 ;;
;;=C2=A0 =C2=A0=E2=80=A2 To customize the appearance of the beacon, configu= re `beacon-size'
;;=C2=A0 =C2=A0 =C2=A0and `beacon-color'.
;;
;;=C2=A0 =C2=A0=E2=80=A2 To customize how long it lasts, configure `beacon-= blink-duration'
;;=C2=A0 =C2=A0 =C2=A0 =C2=A0and `beacon-blink-delay'.
;;
;;=C2=A0 =C2=A0=E2=80=A2 To customize /when/ it is used at all, configure ;;=C2=A0 =C2=A0 =C2=A0`beacon-blink-when-window-scrolls',
;;=C2=A0 =C2=A0 =C2=A0`beacon-blink-when-buffer-changes', and
;;=C2=A0 =C2=A0 =C2=A0`beacon-blink-when-point-moves'.

;;; Code:

(require 'seq)

(defgroup beacon nil
=C2=A0 "Customization group for beacon."
=C2=A0 :group 'emacs
=C2=A0 :prefix "beacon-")

(defvar beacon--timer nil)

(defcustom beacon-push-mark nil
=C2=A0 "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."
=C2=A0 :type '(choice integer (const nil)))

(defcustom beacon-blink-when-point-moves nil
=C2=A0 "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."
=C2=A0 :type '(choice integer (const nil)))

(defcustom beacon-blink-when-buffer-changes t
=C2=A0 "Should the beacon blink when changing buffer?"
=C2=A0 :type 'boolean)

(defcustom beacon-blink-when-window-scrolls t
=C2=A0 "Should the beacon blink when the window scrolls?"
=C2=A0 :type 'boolean)

(defcustom beacon-blink-duration 0.3
=C2=A0 "Time, in seconds, that the blink should last."
=C2=A0 :type 'number)

(defcustom beacon-blink-delay 0.3
=C2=A0 "Time, in seconds, before starting to fade the beacon." =C2=A0 :type 'number)

(defcustom beacon-size 40
=C2=A0 "Size of the beacon in characters."
=C2=A0 :type 'number)

(defcustom beacon-color 0.5
=C2=A0 "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\"."
=C2=A0 :type '(choice number color))


;;; Overlays
(defvar beacon--ovs nil)

(defun beacon--colored-overlay (color)
=C2=A0 "Put an overlay at point with background COLOR."
=C2=A0 (let ((ov (make-overlay (point) (1+ (point)))))
=C2=A0 =C2=A0 (overlay-put ov 'face (list :background color))
=C2=A0 =C2=A0 (overlay-put ov 'beacon t)
=C2=A0 =C2=A0 (push ov beacon--ovs)))

(defun beacon--ov-put-after-string (overlay colors)
=C2=A0 "Add an after-string property to OVERLAY.
The property's value is a string of spaces with background
COLORS applied to each one."
=C2=A0 (if (not colors)
=C2=A0 =C2=A0 =C2=A0 (delete-overlay overlay)
=C2=A0 =C2=A0 (overlay-put overlay 'beacon-colors colors)
=C2=A0 =C2=A0 (overlay-put overlay 'after-string
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(propertize =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (mapconcat (= lambda (c) (propertize " " 'face (list
:background c)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0colors
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0"")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 'cursor = 1000))))

(defun beacon--after-string-overlay (colors)
=C2=A0 "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."
=C2=A0 (let ((ov (make-overlay (point) (point)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; The after-string must not be longer than the= remaining columns from
=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; point to right window-end else it will be wr= apped around (assuming
=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; truncate-lines is nil) introducing an ugly w= rap-around for a
=C2=A0 =C2=A0 =C2=A0 =C2=A0 ;; fraction of a second.
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (colors (seq-take colors (- (window-width) (cur= rent-column)))))
=C2=A0 =C2=A0 (beacon--ov-put-after-string ov colors)
=C2=A0 =C2=A0 (overlay-put ov 'beacon t)
=C2=A0 =C2=A0 (push ov beacon--ovs)))

(defun beacon--ov-at-point ()
=C2=A0 (car (or (seq-filter (lambda (o) (overlay-get o 'beacon))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0(overlays-in (point) (point)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(seq-filter (lambda (o) (overlay-g= et o 'beacon))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0(overlays-at (point))))))

(defun beacon--vanish ()
=C2=A0 "Turn off the beacon."
=C2=A0 (when (timerp beacon--timer)
=C2=A0 =C2=A0 (cancel-timer beacon--timer))
=C2=A0 (mapc #'delete-overlay beacon--ovs)
=C2=A0 (setq beacon--ovs nil))


;;; Colors
(defun beacon--int-range (a b)
=C2=A0 "Return a list of integers between A inclusive and B exclusive.=
Only returns `beacon-size' elements."
=C2=A0 (let ((d (/ (- b a) beacon-size))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (out (list a)))
=C2=A0 =C2=A0 (dotimes (_ (1- beacon-size))
=C2=A0 =C2=A0 =C2=A0 (push (+ (car out) d) out))
=C2=A0 =C2=A0 (nreverse out)))

(defun beacon--color-range ()
=C2=A0 "Return a list of background colors for the beacon."
=C2=A0 (let* ((bg (color-values (face-attribute 'default :background)))=
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(fg (cond
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((stringp beacon-color) (c= olor-values beacon-color))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 ((< (color-distance &qu= ot;black" bg)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (color-dista= nce "white" bg))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(make-list 3 (* beac= on-color 65535)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (t (make-list 3 (* (- 1 be= acon-color) 65535))))))
=C2=A0 =C2=A0 (apply #'cl-mapcar (lambda (r g b) (format "#%04x%04= x%04x" r g b))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(mapcar (lambda (n) (butlast (beac= on--int-range (elt fg n)
(elt bg n))))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0[0 1 2= ]))))


;;; Blinking
(defun beacon--shine ()
=C2=A0 "Shine a beacon at point."
=C2=A0 (let ((colors (beacon--color-range)))
=C2=A0 =C2=A0 (save-excursion
=C2=A0 =C2=A0 =C2=A0 (while colors
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (if (looking-at "$")
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (progn
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (beacon--after-string-over= lay colors)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setq colors nil))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (beacon--colored-overlay (pop colors)) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (forward-char 1))))))

(defun beacon--dec ()
=C2=A0 "Decrease the beacon brightness by one."
=C2=A0 (pcase (beacon--ov-at-point)
=C2=A0 =C2=A0 (`nil (beacon--vanish))
=C2=A0 =C2=A0 ((and o (let c (overlay-get o 'beacon-colors)) (guard c))=
=C2=A0 =C2=A0 =C2=A0(beacon--ov-put-after-string o (cdr c)))
=C2=A0 =C2=A0 (o
=C2=A0 =C2=A0 =C2=A0(delete-overlay o)
=C2=A0 =C2=A0 =C2=A0(save-excursion
=C2=A0 =C2=A0 =C2=A0 =C2=A0(while (progn (forward-char 1)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0(setq o (beacon--ov-at-point)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(let ((colors (overlay-get o 'beacon-= colors)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(if (not colors)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(move-overlay o (1- = (point)) (point))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(forward-char -1)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(beacon--colored-overlay (p= op colors))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(beacon--ov-put-after-strin= g o colors)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(forward-char 1))))))))

(defun beacon-blink ()
=C2=A0 "Blink the beacon at the position of the cursor."
=C2=A0 (interactive)
=C2=A0 (beacon--vanish)
=C2=A0 (beacon--shine)
=C2=A0 (setq beacon--timer
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (run-at-time beacon-blink-delay
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0(/ beacon-blink-duration 1.0 beacon-size)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0#'beacon--dec)))


;;; Movement detection
(defvar beacon--window-scrolled nil)
(defvar beacon--previous-place nil)
(defvar beacon--previous-mark-head nil)

(defun beacon--movement-> (delta)
=C2=A0 "Return non-nil if latest point movement is > DELTA.
If DELTA is nil, return nil."
=C2=A0 (and delta
=C2=A0 =C2=A0 =C2=A0 =C2=A0(markerp beacon--previous-place)
=C2=A0 =C2=A0 =C2=A0 =C2=A0(equal (marker-buffer beacon--previous-place) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (current-buffer))
=C2=A0 =C2=A0 =C2=A0 =C2=A0(> (abs (- (point) beacon--previous-place)) =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 delta)
=C2=A0 =C2=A0 =C2=A0 =C2=A0(> (count-screen-lines (min (point) beacon--p= revious-place)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (max (point) beacon--previous-place))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 delta)))

(defun beacon--maybe-push-mark ()
=C2=A0 "Push mark if it seems to be safe."
=C2=A0 (when (and (not mark-active)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(beacon--movement-> beac= on-push-mark))
=C2=A0 =C2=A0 (let ((head (car mark-ring)))
=C2=A0 =C2=A0 =C2=A0 (when (and (eq beacon--previous-mark-head head)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(not (equal h= ead beacon--previous-place)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (push-mark beacon--previous-place)))))

(defun beacon--post-command ()
=C2=A0 "Blink if point moved very far."
=C2=A0 (cond
=C2=A0 =C2=A0((not (markerp beacon--previous-place))
=C2=A0 =C2=A0 (beacon--vanish))
=C2=A0 =C2=A0;; Blink because we changed buffer.
=C2=A0 =C2=A0((not (equal (marker-buffer beacon--previous-place)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (current-buffer)))<= br> =C2=A0 =C2=A0 (when beacon-blink-when-buffer-changes
=C2=A0 =C2=A0 =C2=A0 (unless (window-minibuffer-p)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (beacon-blink))))
=C2=A0 =C2=A0;; Blink for scrolling.
=C2=A0 =C2=A0((and beacon-blink-when-window-scrolls
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0beacon--window-scrolled
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(equal beacon--window-scrolled (selected-= window)))
=C2=A0 =C2=A0 (beacon-blink)
=C2=A0 =C2=A0 (setq beacon--window-scrolled nil))
=C2=A0 =C2=A0;; Blink for movement
=C2=A0 =C2=A0((beacon--movement-> beacon-blink-when-point-moves)
=C2=A0 =C2=A0 (beacon-blink))
=C2=A0 =C2=A0;; Even if we don't blink, vanish any previous beacon.
=C2=A0 =C2=A0(t (beacon--vanish)))
=C2=A0 (beacon--maybe-push-mark)
=C2=A0 (unless (window-minibuffer-p)
=C2=A0 =C2=A0 (setq beacon--previous-mark-head (car mark-ring))
=C2=A0 =C2=A0 (setq beacon--previous-place (point-marker))))

(defun beacon--window-scroll-function (win _start-pos)
=C2=A0 "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.=C2=A0 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."
=C2=A0 (if this-command
=C2=A0 =C2=A0 =C2=A0 (setq beacon--window-scrolled win)
=C2=A0 =C2=A0 (beacon-blink)))


;;; Minor-mode
(defcustom beacon-lighter
=C2=A0 (cond
=C2=A0 =C2=A0((char-displayable-p ?=F0=9F=92=A1) " =F0=9F=92=A1")=
=C2=A0 =C2=A0((char-displayable-p ?=CE=9B) " =CE=9B")
=C2=A0 =C2=A0(t " *"))
=C2=A0 "Lighter string used on the mode-line."
=C2=A0 :type 'string)

;;;###autoload
(define-minor-mode beacon-mode
=C2=A0 nil nil beacon-lighter nil
=C2=A0 :global t
=C2=A0 (if beacon-mode
=C2=A0 =C2=A0 =C2=A0 (progn
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (add-hook 'window-scroll-functions #'be= acon--window-scroll-function)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (add-hook 'post-command-hook #'beacon--= post-command))
=C2=A0 =C2=A0 (remove-hook 'window-scroll-functions #'beacon--windo= w-scroll-function)
=C2=A0 =C2=A0 (remove-hook 'post-command-hook #'beacon--post-comman= d)))

(provide 'beacon)
;;; beacon.el ends here




--001a1140b482d09dd4052228152b--