From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Artur Malabarba Newsgroups: gmane.emacs.devel Subject: [ELPA] New package: beacon Date: Thu, 15 Oct 2015 18:02:59 +0100 Message-ID: Reply-To: bruce.connor.am@gmail.com NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1444928996 3052 80.91.229.3 (15 Oct 2015 17:09:56 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 15 Oct 2015 17:09:56 +0000 (UTC) To: emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Oct 15 19:09:43 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 1Zmm27-0004JE-Bj for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 19:09:39 +0200 Original-Received: from localhost ([::1]:48731 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zmm26-00034e-UA for ged-emacs-devel@m.gmane.org; Thu, 15 Oct 2015 13:09:38 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:52714) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zmlvi-0000KW-BX for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:03:07 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zmlvg-0006O2-A0 for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:03:02 -0400 Original-Received: from mail-lb0-x236.google.com ([2a00:1450:4010:c04::236]:35549) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zmlvf-0006N5-VM for emacs-devel@gnu.org; Thu, 15 Oct 2015 13:03:00 -0400 Original-Received: by lbwr8 with SMTP id r8so76661645lbw.2 for ; Thu, 15 Oct 2015 10:02:59 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:reply-to:sender:date:message-id:subject:from:to :content-type:content-transfer-encoding; bh=aTSyzMVAu0exVsd/p/MmKfm/K6zOY5kq6aL/iXZB1TU=; b=DF+9yfOD2f8GOJ7L7ejXbmDsLg+yoYFj6Gwf63qREFk5Xg0Z80rLVzyhdanmocuaxT 8YpTnunHsP+N5FEUx5WrArxHlEYz7jAvH3S+k1LJKYLtQI0kNE0g+dnvAsDX2+Zcj4Oh qJb+HNWMuQjvhfyAjbsu4KMhM1NV7i76JSUREy7obj1j8nntO3NJj20jkHfxc07BIUxj Ko+CVAiIcHn333cCKjXF3/RJ1AStmBqUAhGrmENaB+cNe6w9E0T4eiz5BAPnw3O7uQBZ RVw3UWzBcwj7rUU2jCWayaliqJEaybCGa2Zm9GEsQm3ZekD6IvG335n0QCqWIoi0/9kM YgfA== X-Received: by 10.112.168.228 with SMTP id zz4mr5293252lbb.73.1444928579107; Thu, 15 Oct 2015 10:02:59 -0700 (PDT) Original-Received: by 10.25.22.197 with HTTP; Thu, 15 Oct 2015 10:02:59 -0700 (PDT) X-Google-Sender-Auth: rg9DsLw-pPy9cu2QG3K07BvnNQs X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:4010:c04::236 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:191667 Archived-At: 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 `beacon= -size' ;; and `beacon-color'. ;; ;; =E2=80=A2 To customize how long it lasts, configure `beacon-blink-dura= tion' ;; 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 f= rom ;; point to right window-end else it will be wrapped around (assumi= ng ;; 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