iankelling.org Git - spray/blob - spray.el

   1 ;;; spray.el --- a speed reading mode
   2
   3 ;; Copyright (C) 2014 Ian Kelling <ian@iankelling.org>
   4
   5 ;; This program is free software; you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;; Maintainer: Ian Kelling <ian@iankelling.org>
  19 ;; Author: Ian Kelling <ian@iankelling.org>
  20 ;; Author: zk_phi
  21 ;; Created: 18 Jun 2014
  22 ;; Version: 0.0.2
  23 ;; URL: https://github.com/ian-kelling/spray
  24 ;; Keywords: convenience
  25
  26 ;;; Commentary:
  27
  28 ;; For speed reading, or just more enjoyable reading. Narrows the buffer to show
  29 ;; one word at a time. Adjust speed / pause as needed.
  30 ;;
  31 ;; Download from Melpa or put this script into a "load-path"ed directory, and
  32 ;; load it in your init file:
  33
  34 ;;   (require 'spray)
  35
  36 ;; Then you may run spray with "M-x spray-mode". Binding some keys may
  37 ;; also be useful.
  38
  39 ;;   (global-set-key (kbd "<f6>") 'spray-mode)
  40
  41 ;; In spray-mode buffers, following commands are available.
  42
  43 ;; - =spray-start/stop= (SPC) ::
  44 ;; pause or resume spraying
  45
  46 ;; - =spray-backward-word= (h, <left>) ::
  47 ;; pause and back to the last word
  48
  49 ;; - =spray-forward-word= (l, <right>) ::
  50 ;; inverse of =spray-backward-word=
  51
  52 ;; - =spray-faster= (f) ::
  53 ;; increases speed
  54
  55 ;; - =spray-slower= (s) ::
  56 ;; decreases speed
  57
  58 ;; - =spray-quit= (q, <return>) ::
  59 ;; quit =spray-mode=
  60
  61 ;; You may customize spray by modifying following items:
  62
  63 ;; - [Variable] spray-wpm
  64 ;; - [Variable] spray-height
  65 ;; - [Variable] spray-margin-top
  66 ;; - [Variable] spray-margin-left
  67 ;; - [Variable] spray-ramp
  68 ;; - [Keymap] spray-mode-map
  69 ;; - [Face] spray-base-face
  70 ;; - [Face] spray-accent-face
  71
  72 ;; Readme.org from the package repository has some additional information:
  73 ;; A gif screencast.
  74 ;; Algorithm specification.
  75 ;; Comparison with similar projects.
  76
  77 ;;; Known bugs:
  78
  79 ;; repeated words are indistinguishable, for example
  80 ;; "going, going, gone" reads like going, gone, with a slight delay.
  81 ;;
  82 ;; sentences (like this) should trigger a pause for ( and )
  83
  84 ;;; Change Log:
  85
  86 ;; 0.0.0 test release
  87 ;; 0.0.1 add spray-set-margins
  88 ;; 0.0.2 margin options, speed control, better quit
  89
  90 ;;; Code:
  91
  92 (require 'face-remap)
  93
  94 ;; * customizable vars
  95
  96 (defcustom spray-wpm 400
  97   "Words per minute"
  98   :group 'spray
  99   :type 'integer)
 100
 101 (defcustom spray-height 400
 102   "Height of characters"
 103   :group 'spray
 104   :type 'integer)
 105
 106 (defcustom spray-margin-top 1
 107   "Character margin at top of buffer. Characters are as big as
 108   spray text characters."
 109   :group 'spray
 110   :type 'integer)
 111
 112 (defcustom spray-margin-left 1
 113   "Character margin at left of buffer. Characters are as big as
 114   spray text characters."
 115   :group 'spray
 116   :type 'integer)
 117
 118 (defcustom spray-ramp 2
 119   "Initial words before ramping up to full speed. Pauses for
 120 this multiple of wpm on the first word,
 121 decreasing by one for each subsequent word."
 122   :group 'spray
 123   :type 'integer)
 124
 125 (defcustom spray-unsupported-minor-modes
 126   '(buffer-face-mode smartparens-mode highlight-symbol-mode)
 127   "Minor modes to toggle off when in spray mode."
 128   :group 'spray
 129   :type '(list symbol))
 130
 131
 132 ;; * faces
 133
 134 (defface spray-base-face
 135   '((t (:inherit default)))
 136   "Face for non-accent characters."
 137   :group 'spray)
 138
 139 (defface spray-accent-face
 140   '((t (:foreground "red" :inherit spray-base-face)))
 141   "Face for accent character."
 142   :group 'spray)
 143
 144
 145 ;; keymap
 146
 147 (defvar spray-mode-map
 148   (let ((km (make-sparse-keymap)))
 149     (define-key km (kbd "SPC") 'spray-start/stop)
 150     (define-key km (kbd "h") 'spray-backward-word)
 151     (define-key km (kbd "l") 'spray-forward-word)
 152     (define-key km (kbd "<left>") 'spray-backward-word)
 153     (define-key km (kbd "<right>") 'spray-forward-word)
 154     (define-key km (kbd "f") 'spray-faster)
 155     (define-key km (kbd "s") 'spray-slower)
 156     (define-key km (kbd "q") 'spray-quit)
 157     (define-key km (kbd "<return>") 'spray-quit)
 158     (define-key km [remap forward-char] 'spray-forward-word)
 159     (define-key km [remap backward-char] 'spray-backward-word)
 160     (define-key km [remap forward-word] 'spray-forward-word)
 161     (define-key km [remap backward-word] 'spray-backward-word)
 162     (define-key km [remap keyboard-quit] 'spray-quit)
 163     km)
 164   "keymap for spray-mode buffers")
 165
 166
 167 ;; * internal vars
 168
 169 (defvar spray--margin-string "")
 170 (defvar spray--base-overlay nil)
 171 (defvar spray--accent-overlay nil)
 172 (defvar spray--running nil)
 173 (defvar spray--first-words 0)
 174 (defvar spray--initial-delay 0)
 175 (defvar spray--delay 0)
 176 (defvar spray--saved-cursor-type nil)
 177 (defvar spray--saved-restriction nil)
 178 (defvar spray--saved-minor-modes nil)
 179
 180 ;; * utility functions
 181
 182 (defun spray-set-margins ()
 183   "Setup spray--margin-string"
 184   (setq spray--margin-string
 185         (concat (make-string spray-margin-top 10) ;; 10 = ascii newline
 186                 (make-string spray-margin-left 32)))) ;; 32 = ascii space
 187
 188 ;; * the mode
 189
 190 ;;;###autoload
 191 (define-minor-mode spray-mode
 192   "spray mode"
 193   :init nil
 194   :keymap spray-mode-map
 195   (cond (spray-mode
 196          (setq spray--base-overlay (make-overlay (point-min) (point-max))
 197                spray--accent-overlay (make-overlay 0 0)
 198                spray--saved-cursor-type cursor-type
 199                spray--saved-restriction (and (buffer-narrowed-p)
 200                                              (cons (point-min) (point-max))))
 201          (dolist (mode spray-unsupported-minor-modes)
 202            (when (and (boundp mode) (eval mode))
 203              (funcall mode -1)
 204              (push mode spray--saved-minor-modes)))
 205          (setq cursor-type nil)
 206          (let ((buffer-face-mode-face `(:height ,spray-height)))
 207            (buffer-face-mode 1))
 208          (overlay-put spray--base-overlay 'priority 100)
 209          (overlay-put spray--base-overlay 'face 'spray-base-face)
 210          (overlay-put spray--accent-overlay 'priority 101)
 211          (overlay-put spray--accent-overlay 'face 'spray-accent-face)
 212          (spray-start))
 213         (t
 214          (spray-stop)
 215          (delete-overlay spray--accent-overlay)
 216          (delete-overlay spray--base-overlay)
 217          (buffer-face-mode -1)
 218          (if spray--saved-restriction
 219              (narrow-to-region (car spray--saved-restriction)
 220                                (cdr spray--saved-restriction))
 221            (widen))
 222          (setq cursor-type spray--saved-cursor-type)
 223          (dolist (mode spray--saved-minor-modes)
 224            (funcall mode 1))
 225          (setq spray--saved-minor-modes nil))))
 226
 227 (defun spray-quit ()
 228   "Exit spray mode."
 229   (interactive)
 230   (spray-mode -1))
 231
 232 (defun spray--word-at-point ()
 233   (skip-chars-backward "^\s\t\n—")
 234   (let* ((beg (point))
 235          (len (+ (skip-chars-forward "^\s\t\n—") (skip-chars-forward "—")))
 236          (end (point))
 237          (accent (+ beg (cl-case len
 238                        ((1) 1)
 239                        ((2 3 4 5) 2)
 240                        ((6 7 8 9) 3)
 241                        ((10 11 12 13) 4)
 242                        (t 5)))))
 243     ;; this fairly obfuscated, using magic numbers to store state
 244     ;; it would be nice to sometime patch this so it is more readable.
 245     ;; for greater than 9 length, we display for twice as long
 246     ;; for some punctuation, we display a blank
 247     (setq spray--delay (+ (if (> len 9) 1 0)
 248                           (if (looking-at "\n[\s\t\n]") 3 0)
 249                           (cl-case (char-before)
 250                             ((?. ?! ?\? ?\;) 3)
 251                             ((?, ?: ?—) 1)
 252                             (t 0))))
 253     (move-overlay spray--accent-overlay (1- accent) accent)
 254     (move-overlay spray--base-overlay beg end)
 255     (spray-set-margins)
 256     (overlay-put spray--base-overlay 'before-string
 257                  (concat spray--margin-string
 258                          (make-string (- 5 (- accent beg)) ?\s)))
 259     (narrow-to-region beg end)))
 260
 261 (defun spray--update ()
 262   (cond ((not (zerop spray--initial-delay))
 263          (setq spray--initial-delay (1- spray--initial-delay)))
 264         ((not (zerop spray--delay))
 265          (setq spray--delay (1- spray--delay))
 266          (when (= spray--delay 2)
 267            (narrow-to-region (point) (point))))
 268         (t
 269          (widen)
 270          (if (eobp)
 271              (spray-mode -1)
 272            (when (not (zerop spray--first-words))
 273              (setq spray--initial-delay spray--first-words)
 274              (setq spray--first-words (1- spray--first-words)))
 275            (skip-chars-forward "\s\t\n—")
 276            (spray--word-at-point)))))
 277
 278 ;; * interactive commands
 279
 280 (defun spray-start/stop ()
 281   "Toggle pause/unpause spray."
 282   (interactive)
 283   (or (spray-stop) (spray-start)))
 284
 285 (defun spray-stop ()
 286   "Pause spray.
 287 Returns t if spray was unpaused."
 288   (interactive)
 289   (prog1 spray--running
 290     (when spray--running
 291       (cancel-timer spray--running)
 292       (setq spray--running nil))))
 293
 294 (defun spray-start ()
 295   "Start / resume spray."
 296   (interactive)
 297   (setq spray--first-words spray-ramp)
 298   (setq spray--running
 299         (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update)))
 300
 301 (defun spray-forward-word ()
 302   (interactive)
 303   (spray-stop)
 304   (widen)
 305   (skip-chars-forward "\s\t\n—")
 306   (spray--word-at-point))
 307
 308 (defun spray-backward-word ()
 309   (interactive)
 310   (spray-stop)
 311   (widen)
 312   (skip-chars-backward "^\s\t\n—")
 313   (skip-chars-backward "\s\t\n—")
 314   (spray--word-at-point))
 315
 316 (defun spray-faster ()
 317   "Increases speed.
 318
 319 Increases the wpm (words per minute) parameter. See the variable
 320 `spray-wpm'."
 321   (interactive)
 322   (spray-inc-wpm 20))
 323
 324 (defun spray-slower ()
 325   "Decreases speed.
 326
 327 Decreases the wpm (words per minute) parameter. See the variable
 328 `spray-wpm'."
 329   (interactive)
 330   (spray-inc-wpm -20))
 331
 332 (defun spray-inc-wpm (delta)
 333   (let ((was-running spray--running))
 334     (spray-stop)
 335     (when (< 10 (+ spray-wpm delta))
 336       (setq spray-wpm (+ spray-wpm delta)))
 337     (and was-running (spray-backward-word))
 338     (message "spray wpm: %d" spray-wpm)
 339     (when was-running
 340       (spray-start))))
 341
 342 ;; * provide
 343
 344 (provide 'spray)
 345
 346 ;;; spray.el ends here