code.delx.au - gnu-emacs-elpa/blob - packages/spinner/spinner.el

   1 ;;; spinner.el --- Add spinners and progress-bars to the mode-line for ongoing operations -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; Version: 1.7.1
   7 ;; URL: https://github.com/Malabarba/spinner.el
   8 ;; Keywords: processes mode-line
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; 1 Usage
  26 ;; ═══════
  27 ;;
  28 ;;   First of all, don’t forget to add `(spinner "VERSION")' to your
  29 ;;   package’s dependencies.
  30 ;;
  31 ;;
  32 ;; 1.1 Major-modes
  33 ;; ───────────────
  34 ;;
  35 ;;   1. Just call `(spinner-start)' and a spinner will be added to the
  36 ;;      mode-line.
  37 ;;   2. Call `(spinner-stop)' on the same buffer when you want to remove
  38 ;;      it.
  39 ;;
  40 ;;   The default spinner is a line drawing that rotates. You can pass an
  41 ;;   argument to `spinner-start' to specify which spinner you want. All
  42 ;;   possibilities are listed in the `spinner-types' variable, but here are
  43 ;;   a few examples for you to try:
  44 ;;
  45 ;;   • `(spinner-start 'vertical-breathing 10)'
  46 ;;   • `(spinner-start 'minibox)'
  47 ;;   • `(spinner-start 'moon)'
  48 ;;   • `(spinner-start 'triangle)'
  49 ;;
  50 ;;   You can also define your own as a vector of strings (see the examples
  51 ;;   in `spinner-types').
  52 ;;
  53 ;;
  54 ;; 1.2 Minor-modes
  55 ;; ───────────────
  56 ;;
  57 ;;   Minor-modes can create a spinner with `spinner-create' and then add it
  58 ;;   to their mode-line lighter. They can then start the spinner by setting
  59 ;;   a variable and calling `spinner-start-timer'. Finally, they can stop
  60 ;;   the spinner (and the timer) by just setting the same variable to nil.
  61 ;;
  62 ;;   Here’s an example for a minor-mode named `foo'. Assuming that
  63 ;;   `foo--lighter' is used as the mode-line lighter, the following code
  64 ;;   will add an *inactive* global spinner to the mode-line.
  65 ;;   ┌────
  66 ;;   │ (defvar foo--spinner (spinner-create 'rotating-line))
  67 ;;   │ (defconst foo--lighter
  68 ;;   │   '(" foo" (:eval (spinner-print foo--spinner))))
  69 ;;   └────
  70 ;;
  71 ;;   1. To activate the spinner, just call `(spinner-start foo--spinner)'.
  72 ;;      It will show up on the mode-line and start animating.
  73 ;;   2. To get rid of it, call `(spinner-stop foo--spinner)'. It will then
  74 ;;      disappear again.
  75 ;;
  76 ;;   Some minor-modes will need spinners to be buffer-local. To achieve
  77 ;;   that, just make the `foo--spinner' variable buffer-local and use the
  78 ;;   third argument of the `spinner-create' function. The snippet below is an
  79 ;;   example.
  80 ;;
  81 ;;   ┌────
  82 ;;   │ (defvar-local foo--spinner nil)
  83 ;;   │ (defconst foo--lighter
  84 ;;   │   '(" foo" (:eval (spinner-print foo--spinner))))
  85 ;;   │ (defun foo--start-spinner ()
  86 ;;   │   "Create and start a spinner on this buffer."
  87 ;;   │   (unless foo--spinner
  88 ;;   │     (setq foo--spinner (spinner-create 'moon t)))
  89 ;;   │   (spinner-start foo--spinner))
  90 ;;   └────
  91 ;;
  92 ;;   1. To activate the spinner, just call `(foo--start-spinner)'.
  93 ;;   2. To get rid of it, call `(spinner-stop foo--spinner)'.
  94 ;;
  95 ;;   This will use the `moon' spinner, but you can use any of the names
  96 ;;   defined in the `spinner-types' variable or even define your own.
  97
  98 \f
  99 ;;; Code:
 100 (eval-when-compile
 101   (require 'cl))
 102
 103 (defconst spinner-types
 104   '((3-line-clock . ["┤" "┘" "┴" "└" "├" "┌" "┬" "┐"])
 105     (2-line-clock . ["┘" "└" "┌" "┐"])
 106     (flipping-line . ["_" "\\" "|" "/"])
 107     (rotating-line . ["-" "\\" "|" "/"])
 108     (progress-bar . ["[    ]" "[=   ]" "[==  ]" "[=== ]" "[====]" "[ ===]" "[  ==]" "[   =]"])
 109     (progress-bar-filled . ["|    |" "|█   |" "|██  |" "|███ |" "|████|" "| ███|" "|  ██|" "|   █|"])
 110     (vertical-breathing . ["▁" "▂" "▃" "▄" "▅" "▆" "▇" "█" "▇" "▆" "▅" "▄" "▃" "▂" "▁" " "])
 111     (vertical-rising . ["▁" "▄" "█" "▀" "▔"])
 112     (horizontal-breathing . [" " "▏" "▎" "▍" "▌" "▋" "▊" "▉" "▉" "▊" "▋" "▌" "▍" "▎" "▏"])
 113     (horizontal-breathing-long
 114      . ["  " "▎ " "▌ " "▊ " "█ " "█▎" "█▌" "█▊" "██" "█▊" "█▌" "█▎" "█ " "▊ " "▋ " "▌ " "▍ " "▎ " "▏ "])
 115     (horizontal-moving . ["  " "▌ " "█ " "▐▌" " █" " ▐"])
 116     (minibox . ["▖" "▘" "▝" "▗"])
 117     (triangle . ["◢" "◣" "◤" "◥"])
 118     (box-in-box . ["◰" "◳" "◲" "◱"])
 119     (box-in-circle . ["◴" "◷" "◶" "◵"])
 120     (half-circle . ["◐" "◓" "◑" "◒"])
 121     (moon . ["🌑" "🌘" "🌖" "🌕" "🌔" "🌒"]))
 122   "Predefined alist of spinners.
 123 Each car is a symbol identifying the spinner, and each cdr is a
 124 vector, the spinner itself.")
 125
 126 (defun spinner-make-progress-bar (width &optional char)
 127   "Return a vector of strings of the given WIDTH.
 128 The vector is a valid spinner type and is similar to the
 129 `progress-bar' spinner, except without the sorrounding brackets.
 130 CHAR is the character to use for the moving bar (defaults to =)."
 131   (let ((whole-string (concat (make-string (1- width) ?\s)
 132                               (make-string 4 (or char ?=))
 133                               (make-string width ?\s))))
 134     (apply #'vector (mapcar (lambda (n) (substring whole-string n (+ n width)))
 135                             (number-sequence (+ width 3) 0 -1)))))
 136
 137 (defvar spinner-current nil
 138   "Spinner curently being displayed on the `mode-line-process'.")
 139 (make-variable-buffer-local 'spinner-current)
 140
 141 (defconst spinner--mode-line-construct
 142   '(:eval (spinner-print spinner-current))
 143   "Construct used to display a spinner in `mode-line-process'.")
 144 (put 'spinner--mode-line-construct 'risky-local-variable t)
 145
 146 (defvar spinner-frames-per-second 10
 147   "Default speed at which spinners spin, in frames per second.
 148 Each spinner can override this value.")
 149
 150 \f
 151 ;;; The spinner object.
 152 (defun spinner--type-to-frames (type)
 153   "Return a vector of frames corresponding to TYPE.
 154 The list of possible built-in spinner types is given by the
 155 `spinner-types' variable, but you can also use your own (see
 156 below).
 157
 158 If TYPE is nil, the frames of this spinner are given by the first
 159 element of `spinner-types'.
 160 If TYPE is a symbol, it specifies an element of `spinner-types'.
 161 If TYPE is `random', use a random element of `spinner-types'.
 162 If TYPE is a list, it should be a list of symbols, and a random
 163 one is chosen as the spinner type.
 164 If TYPE is a vector, it should be a vector of strings and these
 165 are used as the spinner's frames.  This allows you to make your
 166 own spinner animations."
 167   (cond
 168    ((vectorp type) type)
 169    ((not type) (cdr (car spinner-types)))
 170    ((eq type 'random)
 171     (cdr (elt spinner-types
 172               (random (length spinner-types)))))
 173    ((listp type)
 174     (cdr (assq (elt type (random (length type)))
 175                spinner-types)))
 176    ((symbolp type) (cdr (assq type spinner-types)))
 177    (t (error "Unknown spinner type: %s" type))))
 178
 179 (defstruct (spinner
 180             (:copier nil)
 181             (:conc-name spinner--)
 182             (:constructor make-spinner (&optional type buffer-local frames-per-second delay-before-start)))
 183   (frames (spinner--type-to-frames type))
 184   (counter 0)
 185   (fps (or frames-per-second spinner-frames-per-second))
 186   (timer (timer-create) :read-only)
 187   (active-p nil)
 188   (buffer (when buffer-local
 189             (if (bufferp buffer-local)
 190                 buffer-local
 191               (current-buffer))))
 192   (delay (or delay-before-start 0)))
 193
 194 ;;;###autoload
 195 (defun spinner-create (&optional type buffer-local fps delay)
 196   "Create a spinner of the given TYPE.
 197 The possible TYPEs are described in `spinner--type-to-frames'.
 198
 199 FPS, if given, is the number of desired frames per second.
 200 Default is `spinner-frames-per-second'.
 201
 202 If BUFFER-LOCAL is non-nil, the spinner will be automatically
 203 deactivated if the buffer is killed.  If BUFFER-LOCAL is a
 204 buffer, use that instead of current buffer.
 205
 206 When started, in order to function properly, the spinner runs a
 207 timer which periodically calls `force-mode-line-update' in the
 208 curent buffer.  If BUFFER-LOCAL was set at creation time, then
 209 `force-mode-line-update' is called in that buffer instead.  When
 210 the spinner is stopped, the timer is deactivated.
 211
 212 DELAY, if given, is the number of seconds to wait after starting
 213 the spinner before actually displaying it. It is safe to cancel
 214 the spinner before this time, in which case it won't display at
 215 all."
 216   (make-spinner type buffer-local fps delay))
 217
 218 (defun spinner-print (spinner)
 219   "Return a string of the current frame of SPINNER.
 220 If SPINNER is nil, just return nil.
 221 Designed to be used in the mode-line with:
 222     (:eval (spinner-print some-spinner))"
 223   (when (and spinner (spinner--active-p spinner))
 224     (let ((frame (spinner--counter spinner)))
 225       (when (>= frame 0)
 226         (elt (spinner--frames spinner) frame)))))
 227
 228 (defun spinner--timer-function (spinner)
 229   "Function called to update SPINNER.
 230 If SPINNER is no longer active, or if its buffer has been killed,
 231 stop the SPINNER's timer."
 232   (let ((buffer (spinner--buffer spinner)))
 233     (if (or (not (spinner--active-p spinner))
 234             (and buffer (not (buffer-live-p buffer))))
 235         (spinner-stop spinner)
 236       ;; Increment
 237       (callf (lambda (x) (if (< x 0)
 238                         (1+ x)
 239                       (% (1+ x) (length (spinner--frames spinner)))))
 240           (spinner--counter spinner))
 241       ;; Update mode-line.
 242       (if (buffer-live-p buffer)
 243           (with-current-buffer buffer
 244             (force-mode-line-update))
 245         (force-mode-line-update)))))
 246
 247 (defun spinner--start-timer (spinner)
 248   "Start a SPINNER's timer."
 249   (let ((old-timer (spinner--timer spinner)))
 250     (when (timerp old-timer)
 251       (cancel-timer old-timer))
 252
 253     (setf (spinner--active-p spinner) t)
 254
 255     (unless (ignore-errors (> (spinner--fps spinner) 0))
 256       (error "A spinner's FPS must be a positive number"))
 257     (setf (spinner--counter spinner) (round (- (* (or (spinner--delay spinner) 0)
 258                                            (spinner--fps spinner)))))
 259     ;; Create timer.
 260     (let* ((repeat (/ 1.0 (spinner--fps spinner)))
 261            (time (timer-next-integral-multiple-of-time (current-time) repeat))
 262            ;; Create the timer as a lex variable so it can cancel itself.
 263            (timer (spinner--timer spinner)))
 264       (timer-set-time timer time repeat)
 265       (timer-set-function timer #'spinner--timer-function (list spinner))
 266       (timer-activate timer)
 267       ;; Return a stopping function.
 268       (lambda () (spinner-stop spinner)))))
 269
 270 \f
 271 ;;; The main functions
 272 ;;;###autoload
 273 (defun spinner-start (&optional type-or-object fps delay)
 274   "Start a mode-line spinner of given TYPE-OR-OBJECT.
 275 If TYPE-OR-OBJECT is an object created with `make-spinner',
 276 simply activate it.  This method is designed for minor modes, so
 277 they can use the spinner as part of their lighter by doing:
 278     \\='(:eval (spinner-print THE-SPINNER))
 279 To stop this spinner, call `spinner-stop' on it.
 280
 281 If TYPE-OR-OBJECT is anything else, a buffer-local spinner is
 282 created with this type, and it is displayed in the
 283 `mode-line-process' of the buffer it was created it.  Both
 284 TYPE-OR-OBJECT and FPS are passed to `make-spinner' (which see).
 285 To stop this spinner, call `spinner-stop' in the same buffer.
 286
 287 Either way, the return value is a function which can be called
 288 anywhere to stop this spinner.  You can also call `spinner-stop'
 289 in the same buffer where the spinner was created.
 290
 291 FPS, if given, is the number of desired frames per second.
 292 Default is `spinner-frames-per-second'.
 293
 294 DELAY, if given, is the number of seconds to wait until actually
 295 displaying the spinner. It is safe to cancel the spinner before
 296 this time, in which case it won't display at all."
 297   (unless (spinner-p type-or-object)
 298     ;; Choose type.
 299     (if (spinner-p spinner-current)
 300         (setf (spinner--frames spinner-current) (spinner--type-to-frames type-or-object))
 301       (setq spinner-current (make-spinner type-or-object (current-buffer) fps delay)))
 302     (setq type-or-object spinner-current)
 303     ;; Maybe add to mode-line.
 304     (unless (memq 'spinner--mode-line-construct mode-line-process)
 305       (setq mode-line-process
 306             (list (or mode-line-process "")
 307                   'spinner--mode-line-construct))))
 308
 309   ;; Create timer.
 310   (when fps (setf (spinner--fps type-or-object) fps))
 311   (when delay (setf (spinner--delay type-or-object) delay))
 312   (spinner--start-timer type-or-object))
 313
 314 (defun spinner-start-print (spinner)
 315   "Like `spinner-print', but also start SPINNER if it's not active."
 316   (unless (spinner--active-p spinner)
 317     (spinner-start spinner))
 318   (spinner-print spinner))
 319
 320 (defun spinner-stop (&optional spinner)
 321   "Stop SPINNER, defaulting to the current buffer's spinner.
 322 It is always safe to call this function, even if there is no
 323 active spinner."
 324   (let ((spinner (or spinner spinner-current)))
 325     (when (spinner-p spinner)
 326       (let ((timer (spinner--timer spinner)))
 327         (when (timerp timer)
 328           (cancel-timer timer)))
 329       (setf (spinner--active-p spinner) nil)
 330       (force-mode-line-update))))
 331
 332 (provide 'spinner)
 333
 334 ;;; spinner.el ends here