1 ;;; spray.el --- a speed reading mode
3 ;; Copyright (C) 2014 Ian Kelling <ian@iankelling.org>
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.
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.
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/>.
18 ;; Maintainer: Ian Kelling <ian@iankelling.org>
19 ;; Author: Ian Kelling <ian@iankelling.org>
21 ;; Created: 18 Jun 2014
23 ;; URL: https://github.com/ian-kelling/spray
24 ;; Mailing list: https://lists.iankelling.org/listinfo/spray
25 ;; Keywords: convenience
29 ;; For speed reading, or just more enjoyable reading. Narrows the buffer to show
30 ;; one word at a time. Adjust speed / pause as needed.
32 ;; Download from Melpa or put this script into a "load-path"ed directory, and
33 ;; load it in your init file:
37 ;; Then you may run spray with "M-x spray-mode". Binding some keys may
40 ;; (global-set-key (kbd "<f6>") 'spray-mode)
42 ;; In spray-mode buffers, following commands are available.
44 ;; - =spray-start/stop= (SPC) ::
45 ;; pause or resume spraying
47 ;; - =spray-backward-word= (h, <left>) ::
48 ;; pause and back to the last word
50 ;; - =spray-forward-word= (l, <right>) ::
51 ;; inverse of =spray-backward-word=
53 ;; - =spray-faster= (f) ::
56 ;; - =spray-slower= (s) ::
59 ;; - =spray-quit= (q, <return>) ::
62 ;; You may customize spray by modifying following items:
64 ;; - [Variable] spray-wpm
65 ;; - [Variable] spray-height
66 ;; - [Variable] spray-margin-top
67 ;; - [Variable] spray-margin-left
68 ;; - [Variable] spray-ramp
69 ;; - [Keymap] spray-mode-map
70 ;; - [Face] spray-base-face
71 ;; - [Face] spray-accent-face
73 ;; Readme.org from the package repository has some additional information:
75 ;; Algorithm specification.
76 ;; Comparison with similar projects.
80 ;; repeated words are indistinguishable, for example
81 ;; "going, going, gone" reads like going, gone, with a slight delay.
83 ;; sentences (like this) should trigger a pause for ( and )
88 ;; 0.0.1 add spray-set-margins
89 ;; 0.0.2 margin options, speed control, better quit
95 ;; * customizable vars
97 (defcustom spray-wpm 400
102 (defcustom spray-save-point nil
103 "Set to true and then exiting spray mode will restore the point"
108 (defcustom spray-height 400
109 "Height of characters"
113 (defcustom spray-margin-top 1
114 "Character margin at top of buffer. Characters are as big as
115 spray text characters."
119 (defcustom spray-margin-left 1
120 "Character margin at left of buffer. Characters are as big as
121 spray text characters."
125 (defcustom spray-ramp 2
126 "Initial words before ramping up to full speed. Pauses for
127 this multiple of wpm on the first word,
128 decreasing by one for each subsequent word."
132 (defcustom spray-unsupported-minor-modes
133 '(buffer-face-mode smartparens-mode highlight-symbol-mode
135 "Minor modes to toggle off when in spray mode."
137 :type '(list symbol))
142 (defface spray-base-face
143 '((t (:inherit default)))
144 "Face for non-accent characters."
147 (defface spray-accent-face
148 '((t (:foreground "red" :inherit spray-base-face)))
149 "Face for accent character."
155 (defvar spray-mode-map
156 (let ((km (make-sparse-keymap)))
157 (define-key km (kbd "SPC") 'spray-start/stop)
158 (define-key km (kbd "h") 'spray-backward-word)
159 (define-key km (kbd "l") 'spray-forward-word)
160 (define-key km (kbd "<left>") 'spray-backward-word)
161 (define-key km (kbd "<right>") 'spray-forward-word)
162 (define-key km (kbd "f") 'spray-faster)
163 (define-key km (kbd "s") 'spray-slower)
164 (define-key km (kbd "t") 'spray-time)
165 (define-key km (kbd "q") 'spray-quit)
166 (define-key km (kbd "<return>") 'spray-quit)
167 (define-key km [remap forward-char] 'spray-forward-word)
168 (define-key km [remap backward-char] 'spray-backward-word)
169 (define-key km [remap forward-word] 'spray-forward-word)
170 (define-key km [remap backward-word] 'spray-backward-word)
171 (define-key km [remap keyboard-quit] 'spray-quit)
173 "keymap for spray-mode buffers")
178 (defvar spray--margin-string "")
179 (defvar spray--base-overlay nil)
180 (defvar spray--accent-overlay nil)
181 (defvar spray--running nil)
182 (defvar spray--first-words 0)
183 (defvar spray--initial-delay 0)
184 (defvar spray--delay 0)
185 (defvar spray--saved-cursor-type nil)
186 (defvar spray--saved-restriction nil)
187 (defvar spray--saved-minor-modes nil)
188 (defvar spray--saved-point nil)
190 ;; * utility functions
192 (defun spray-set-margins ()
193 "Setup spray--margin-string"
194 (setq spray--margin-string
195 (concat (make-string spray-margin-top 10) ;; 10 = ascii newline
196 (make-string spray-margin-left 32)))) ;; 32 = ascii space
201 (define-minor-mode spray-mode
204 :keymap spray-mode-map
206 (setq spray--base-overlay (make-overlay (point-min) (point-max))
207 spray--accent-overlay (make-overlay 0 0)
208 spray--saved-cursor-type cursor-type
209 spray--saved-point (point)
210 spray--saved-restriction (and (buffer-narrowed-p)
211 (cons (point-min) (point-max))))
212 (dolist (mode spray-unsupported-minor-modes)
213 (when (and (boundp mode) (eval mode))
215 (push mode spray--saved-minor-modes)))
216 (setq cursor-type nil)
217 (let ((buffer-face-mode-face `(:height ,spray-height)))
218 (buffer-face-mode 1))
219 (overlay-put spray--base-overlay 'priority 100)
220 (overlay-put spray--base-overlay 'face 'spray-base-face)
221 (overlay-put spray--accent-overlay 'priority 101)
222 (overlay-put spray--accent-overlay 'face 'spray-accent-face)
226 (delete-overlay spray--accent-overlay)
227 (delete-overlay spray--base-overlay)
228 (buffer-face-mode -1)
229 (if spray--saved-restriction
230 (narrow-to-region (car spray--saved-restriction)
231 (cdr spray--saved-restriction))
233 (setq cursor-type spray--saved-cursor-type)
234 (when (and spray-save-point spray--saved-point)
235 (goto-char spray--saved-point))
236 (dolist (mode spray--saved-minor-modes)
238 (setq spray--saved-minor-modes nil))))
245 (defun spray--word-at-point ()
246 (skip-chars-backward "^\s\t\n—")
248 (len (+ (skip-chars-forward "^\s\t\n—") (skip-chars-forward "—")))
250 (accent (+ beg (cl-case len
256 ;; this fairly obfuscated, using magic numbers to store state
257 ;; it would be nice to sometime patch this so it is more readable.
258 ;; for greater than 9 length, we display for twice as long
259 ;; for some punctuation, we display a blank
260 (setq spray--delay (+ (if (> len 9) 1 0)
261 (if (looking-at "\n[\s\t\n]") 3 0)
262 (cl-case (char-before)
266 (move-overlay spray--accent-overlay (1- accent) accent)
267 (move-overlay spray--base-overlay beg end)
269 (overlay-put spray--base-overlay 'before-string
270 (concat spray--margin-string
271 (make-string (- 5 (- accent beg)) ?\s)))
272 (narrow-to-region beg end)))
274 (defun spray--update ()
275 (cond ((not (zerop spray--initial-delay))
276 (setq spray--initial-delay (1- spray--initial-delay)))
277 ((not (zerop spray--delay))
278 (setq spray--delay (1- spray--delay)))
283 (when (not (zerop spray--first-words))
284 (setq spray--initial-delay spray--first-words)
285 (setq spray--first-words (1- spray--first-words)))
286 (skip-chars-forward "\s\t\n—")
287 (spray--word-at-point)))))
289 ;; * interactive commands
291 (defun spray-start/stop ()
292 "Toggle pause/unpause spray."
294 (or (spray-stop) (spray-start)))
298 Returns t if spray was unpaused."
300 (prog1 spray--running
302 (cancel-timer spray--running)
303 (setq spray--running nil))))
305 (defun spray-start ()
306 "Start / resume spray."
308 (setq spray--first-words spray-ramp)
310 (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update)))
312 (defun spray-forward-word ()
316 (skip-chars-forward "\s\t\n—")
317 (spray--word-at-point))
319 (defun spray-backward-word ()
323 (skip-chars-backward "^\s\t\n—")
324 (skip-chars-backward "\s\t\n—")
325 (spray--word-at-point))
327 (defun spray-faster ()
330 Increases the wpm (words per minute) parameter. See the variable
335 (defun spray-slower ()
338 Decreases the wpm (words per minute) parameter. See the variable
343 (defun spray-inc-wpm (delta)
344 (let ((was-running spray--running))
346 (when (< 10 (+ spray-wpm delta))
347 (setq spray-wpm (+ spray-wpm delta)))
348 (and was-running (spray-backward-word))
349 (message "spray wpm: %d" spray-wpm)
356 (let ((position (progn (skip-chars-backward "^\s\t\n—") (point))))
358 "%d per cent done; ~%d minute(s) remaining"
359 (* 100 (/ position (+ 0.0 (point-max))))
360 (fround (/ (count-words-region position (point-max)) (+ 0.0 spray-wpm)))))
361 (spray--word-at-point))
367 ;;; spray.el ends here