X-Git-Url: https://iankelling.org/git/?p=spray;a=blobdiff_plain;f=spray.el;h=29a95a09d4136dc46471f9a90141b893edfd46bb;hp=361e0490cb0d0af45f85e9cdf4088d175b564d0f;hb=091c1d22fdca14e2cb7e3170c5f8ec191d996280;hpb=19017e3d79de794de7654d66033fa8cf5b276599 diff --git a/spray.el b/spray.el index 361e049..29a95a0 100644 --- a/spray.el +++ b/spray.el @@ -1,6 +1,6 @@ -;;; cedit.el --- a speed reading mode +;;; spray.el --- a speed reading mode -;; Copyright (C) 2014 zk_phi +;; Copyright (C) 2014 Ian Kelling ;; 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 @@ -16,26 +16,77 @@ ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +;; Maintainer: Ian Kelling +;; Author: Ian Kelling ;; Author: zk_phi -;; URL: http://hins11.yu-yake.com/ -;; Version: 0.0.0 +;; Created: 18 Jun 2014 +;; Version: 0.0.2 +;; URL: https://github.com/ian-kelling/spray +;; Keywords: convenience ;;; Commentary: -;; Put this script into a "load-path"ed directory, and load it in your -;; init file. -;; +;; For speed reading, or just more enjoyable reading. Narrows the buffer to show +;; one word at a time. Adjust speed / pause as needed. +;; +;; Download from Melpa or put this script into a "load-path"ed directory, and +;; load it in your init file: + ;; (require 'spray) -;; + ;; Then you may run spray with "M-x spray-mode". Binding some keys may ;; also be useful. -;; + ;; (global-set-key (kbd "") 'spray-mode) + +;; In spray-mode buffers, following commands are available. + +;; - =spray-start/stop= (SPC) :: +;; pause or resume spraying + +;; - =spray-backward-word= (h, ) :: +;; pause and back to the last word + +;; - =spray-forward-word= (l, ) :: +;; inverse of =spray-backward-word= + +;; - =spray-faster= (f) :: +;; increases speed + +;; - =spray-slower= (s) :: +;; decreases speed + +;; - =spray-quit= (q, ) :: +;; quit =spray-mode= + +;; You may customize spray by modifying following items: + +;; - [Variable] spray-wpm +;; - [Variable] spray-height +;; - [Variable] spray-margin-top +;; - [Variable] spray-margin-left +;; - [Variable] spray-ramp +;; - [Keymap] spray-mode-map +;; - [Face] spray-base-face +;; - [Face] spray-accent-face + +;; Readme.org from the package repository has some additional information: +;; A gif screencast. +;; Algorithm specification. +;; Comparison with similar projects. + +;;; Known bugs: + +;; repeated words are indistinguishable, for example +;; "going, going, gone" reads like going, gone, with a slight delay. ;; -;; For more informations, see Readme.org. +;; sentences (like this) should trigger a pause for ( and ) ;;; Change Log: + ;; 0.0.0 test release +;; 0.0.1 add spray-set-margins +;; 0.0.2 margin options, speed control, better quit ;;; Code: @@ -43,8 +94,56 @@ ;; * customizable vars -(defvar spray-wpm 400 "words/min") -(defvar spray-height 400 "height of characters") +(defcustom spray-wpm 400 + "Words per minute" + :group 'spray + :type 'integer) + +(defcustom spray-height 400 + "Height of characters" + :group 'spray + :type 'integer) + +(defcustom spray-margin-top 1 + "Character margin at top of buffer. Characters are as big as + spray text characters." + :group 'spray + :type 'integer) + +(defcustom spray-margin-left 1 + "Character margin at left of buffer. Characters are as big as + spray text characters." + :group 'spray + :type 'integer) + +(defcustom spray-ramp 2 + "Initial words before ramping up to full speed. Pauses for +this multiple of wpm on the first word, +decreasing by one for each subsequent word." + :group 'spray + :type 'integer) + +(defcustom spray-unsupported-minor-modes + '(buffer-face-mode smartparens-mode highlight-symbol-mode) + "Minor modes to toggle off when in spray mode." + :group 'spray + :type '(list symbol)) + + +;; * faces + +(defface spray-base-face + '((t (:inherit default))) + "Face for non-accent characters." + :group 'spray) + +(defface spray-accent-face + '((t (:foreground "red" :inherit spray-base-face))) + "Face for accent character." + :group 'spray) + + +;; keymap (defvar spray-mode-map (let ((km (make-sparse-keymap))) @@ -53,31 +152,39 @@ (define-key km (kbd "l") 'spray-forward-word) (define-key km (kbd "") 'spray-backward-word) (define-key km (kbd "") 'spray-forward-word) + (define-key km (kbd "f") 'spray-faster) + (define-key km (kbd "s") 'spray-slower) + (define-key km (kbd "q") 'spray-quit) + (define-key km (kbd "") 'spray-quit) + (define-key km [remap forward-char] 'spray-forward-word) + (define-key km [remap backward-char] 'spray-backward-word) + (define-key km [remap forward-word] 'spray-forward-word) + (define-key km [remap backward-word] 'spray-backward-word) + (define-key km [remap keyboard-quit] 'spray-quit) km) "keymap for spray-mode buffers") -;; * faces - -(make-face 'spray-base-face) -(set-face-attribute 'spray-base-face nil - :background (face-background 'default) - :foreground (face-foreground 'default)) - -(make-face 'spray-orp-face) -(set-face-attribute 'spray-orp-face nil - :foreground "red" - :overline (face-foreground 'default) - :underline (face-foreground 'default)) ;; * internal vars +(defvar spray--margin-string "") (defvar spray--base-overlay nil) -(defvar spray--orp-overlay nil) +(defvar spray--accent-overlay nil) (defvar spray--running nil) +(defvar spray--first-words 0) +(defvar spray--initial-delay 0) (defvar spray--delay 0) (defvar spray--saved-cursor-type nil) -(defvar spray--saved-buffer-face nil) (defvar spray--saved-restriction nil) +(defvar spray--saved-minor-modes nil) + +;; * utility functions + +(defun spray-set-margins () + "Setup spray--margin-string" + (setq spray--margin-string + (concat (make-string spray-margin-top 10) ;; 10 = ascii newline + (make-string spray-margin-left 32)))) ;; 32 = ascii space ;; * the mode @@ -88,67 +195,74 @@ :keymap spray-mode-map (cond (spray-mode (setq spray--base-overlay (make-overlay (point-min) (point-max)) - spray--orp-overlay (make-overlay 0 0) + spray--accent-overlay (make-overlay 0 0) spray--saved-cursor-type cursor-type spray--saved-restriction (and (buffer-narrowed-p) - (cons (point-min) (point-max))) - spray--saved-buffer-face (and (boundp 'buffer-face-mode) - buffer-face-mode - buffer-face-mode-face)) + (cons (point-min) (point-max)))) + (dolist (mode spray-unsupported-minor-modes) + (when (and (boundp mode) (eval mode)) + (funcall mode -1) + (push mode spray--saved-minor-modes))) (setq cursor-type nil) (let ((buffer-face-mode-face `(:height ,spray-height))) (buffer-face-mode 1)) (overlay-put spray--base-overlay 'priority 100) (overlay-put spray--base-overlay 'face 'spray-base-face) - (overlay-put spray--orp-overlay 'priority 101) - (overlay-put spray--orp-overlay 'face 'spray-orp-face) - (add-hook 'pre-command-hook 'spray--pre-command-handler) - (spray-start/stop 1)) + (overlay-put spray--accent-overlay 'priority 101) + (overlay-put spray--accent-overlay 'face 'spray-accent-face) + (spray-start)) (t - (setq cursor-type spray--saved-cursor-type) + (spray-stop) + (delete-overlay spray--accent-overlay) + (delete-overlay spray--base-overlay) + (buffer-face-mode -1) (if spray--saved-restriction (narrow-to-region (car spray--saved-restriction) (cdr spray--saved-restriction)) (widen)) - (buffer-face-mode -1) - (if spray--saved-buffer-face - (let ((buffer-face-mode-face spray--saved-buffer-face)) - (buffer-face-mode 1))) - (delete-overlay spray--base-overlay) - (delete-overlay spray--orp-overlay) - (remove-hook 'pre-command-hook 'spray--pre-command-handler) - (spray-start/stop -1)))) + (setq cursor-type spray--saved-cursor-type) + (dolist (mode spray--saved-minor-modes) + (funcall mode 1)) + (setq spray--saved-minor-modes nil)))) -(defun spray--pre-command-handler () - (unless (memq this-command - '(spray-forward-word spray-backward-word spray-start/stop)) - (spray-mode -1))) +(defun spray-quit () + "Exit spray mode." + (interactive) + (spray-mode -1)) (defun spray--word-at-point () - (skip-chars-backward "^\s\t\n") + (skip-chars-backward "^\s\t\n—") (let* ((beg (point)) - (len (skip-chars-forward "^\s\t\n")) + (len (+ (skip-chars-forward "^\s\t\n—") (skip-chars-forward "—"))) (end (point)) - (orp (+ beg (cl-case len + (accent (+ beg (cl-case len ((1) 1) ((2 3 4 5) 2) ((6 7 8 9) 3) ((10 11 12 13) 4) (t 5))))) + ;; this fairly obfuscated, using magic numbers to store state + ;; it would be nice to sometime patch this so it is more readable. + ;; for greater than 9 length, we display for twice as long + ;; for some punctuation, we display a blank (setq spray--delay (+ (if (> len 9) 1 0) (if (looking-at "\n[\s\t\n]") 3 0) (cl-case (char-before) ((?. ?! ?\? ?\;) 3) - ((?, ?:) 1) + ((?, ?: ?—) 1) (t 0)))) - (move-overlay spray--orp-overlay (1- orp) orp) + (move-overlay spray--accent-overlay (1- accent) accent) (move-overlay spray--base-overlay beg end) - (overlay-put spray--base-overlay - 'before-string (make-string (- 5 (- orp beg)) ?\s)) + (spray-set-margins) + (overlay-put spray--base-overlay 'before-string + (concat spray--margin-string + (make-string (- 5 (- accent beg)) ?\s))) (narrow-to-region beg end))) (defun spray--update () - (cond ((not (zerop spray--delay)) + (cond ((not (zerop spray--initial-delay)) + (setq spray--initial-delay (1- spray--initial-delay))) + ((not (zerop spray--delay)) (setq spray--delay (1- spray--delay)) (when (= spray--delay 2) (narrow-to-region (point) (point)))) @@ -156,38 +270,76 @@ (widen) (if (eobp) (spray-mode -1) - (skip-chars-forward "\s\t\n") + (when (not (zerop spray--first-words)) + (setq spray--initial-delay spray--first-words) + (setq spray--first-words (1- spray--first-words))) + (skip-chars-forward "\s\t\n—") (spray--word-at-point))))) ;; * interactive commands -(defun spray-start/stop (&optional switch) +(defun spray-start/stop () + "Toggle pause/unpause spray." (interactive) - (cond ((and (memql switch '(nil 1)) - (not spray--running)) - (setq spray--running - (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update))) - ((memql switch '(nil -1)) - (cancel-timer spray--running) - (setq spray--running nil)) - (t - nil))) + (or (spray-stop) (spray-start))) + +(defun spray-stop () + "Pause spray. +Returns t if spray was unpaused." + (interactive) + (prog1 spray--running + (when spray--running + (cancel-timer spray--running) + (setq spray--running nil)))) + +(defun spray-start () + "Start / resume spray." + (interactive) + (setq spray--first-words spray-ramp) + (setq spray--running + (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update))) (defun spray-forward-word () (interactive) - (when spray--running (spray-start/stop -1)) + (spray-stop) (widen) - (skip-chars-forward "\s\t\n") + (skip-chars-forward "\s\t\n—") (spray--word-at-point)) (defun spray-backward-word () (interactive) - (when spray--running (spray-start/stop -1)) + (spray-stop) (widen) - (skip-chars-backward "^\s\t\n") - (skip-chars-backward "\s\t\n") + (skip-chars-backward "^\s\t\n—") + (skip-chars-backward "\s\t\n—") (spray--word-at-point)) +(defun spray-faster () + "Increases speed. + +Increases the wpm (words per minute) parameter. See the variable +`spray-wpm'." + (interactive) + (spray-inc-wpm 20)) + +(defun spray-slower () + "Decreases speed. + +Decreases the wpm (words per minute) parameter. See the variable +`spray-wpm'." + (interactive) + (spray-inc-wpm -20)) + +(defun spray-inc-wpm (delta) + (let ((was-running spray--running)) + (spray-stop) + (when (< 10 (+ spray-wpm delta)) + (setq spray-wpm (+ spray-wpm delta))) + (and was-running (spray-backward-word)) + (message "spray wpm: %d" spray-wpm) + (when was-running + (spray-start)))) + ;; * provide (provide 'spray)