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:26:52 -0400 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/alternative; boundary=001a11c1bb247434b2052227fe5e X-Trace: ger.gmane.org 1444930159 22702 80.91.229.3 (15 Oct 2015 17:29:19 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 15 Oct 2015 17:29:19 +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:29:07 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 1ZmmKp-0007RP-6R for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 19:28:59 +0200 Original-Received: from localhost ([::1]:48860 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmKo-0007vl-AS for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 13:28:58 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36151) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmJX-0007tq-MR for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:27:42 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZmmJQ-0000PD-8p for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:27:39 -0400 Original-Received: from mail-ob0-x22c.google.com ([2607:f8b0:4003:c01::22c]:36111) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZmmJQ-0000Om-00 for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:27:32 -0400 Original-Received: by obbrx8 with SMTP id rx8so70745365obb.3 for ; Thu, 15 Oct 2015 10:27:31 -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=sa6D6KMoI9RtsJ9Z3Ny4+kw8mJ7y6uaXbYlE0/eRcS4=; b=Fxn+bnFcDCQZoNKBygm8cw5vvA5Ql1AhEXhBsSKJBi5J2ee5ww63gviGbVAlPk1Jal WQPiGze01BqjUdJrT+wSDLjB13j/bQH/Y7dZQmRupZSjVUEoVyXeNpjn5aSHt9hp9rlB QcRj2uXvBSy7pjkPkZUgnxmRiZV1J7+naiKcz23crD2eDNdbQZ9FvZQlbv5C6ZAEN6+p KCmLc16IPeaGlgRbcOx0AKIPmwblthl906OGQKz9AYuaAUsotJLshxdWYzyql6L0IJ2X w6TSxKUCnF/y8/KpQ6UHujl3R0W6F8orx9oCkGfKwtEBWwhOtRUck0YufdBWEd6ljqri elzg== X-Received: by 10.182.65.138 with SMTP id x10mr6447814obs.39.1444930051648; Thu, 15 Oct 2015 10:27:31 -0700 (PDT) Original-Received: by 10.202.44.8 with HTTP; Thu, 15 Oct 2015 10:26:52 -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:c01::22c 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:191669 Archived-At: --001a11c1bb247434b2052227fe5e Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Of course pulse.el is a library which other packages might find useful and beacon.el is an end-user package. I was just curious if the technique used 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 `bea= con-size' >> ;; and `beacon-color'. >> ;; >> ;; =E2=80=A2 To customize how long it lasts, configure `beacon-blink-d= uration' >> ;; 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 column= s >> 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 >> >> > --001a11c1bb247434b2052227fe5e Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: quoted-printable
Of course pulse.el is a library which othe= r packages might find useful and beacon.el is an end-user package. I was ju= st curious if the technique used to set overlay on the current position was= similar.

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



--001a11c1bb247434b2052227fe5e--