Fix missing accent character regression

[spray] / spray.el

diff --git a/spray.el b/spray.el
index 7a6b8fd23c47b4253c94140919bf709f650089e2..29a95a09d4136dc46471f9a90141b893edfd46bb 100644 (file)
--- 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 <ian@iankelling.org>

 
 ;; 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
 
 ;; 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,28 +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
 
 ;; along with this program; if not, write to the Free Software
 ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
 

-;; Author: zk_phi
-;; URL: http://hins11.yu-yake.com/
+;; Maintainer: Ian Kelling <ian@iankelling.org>

 ;; Author: Ian Kelling <ian@iankelling.org>
 ;; Author: Ian Kelling <ian@iankelling.org>

-;; Version: 0.0.1
+;; Author: zk_phi
+;; Created: 18 Jun 2014
+;; Version: 0.0.2
+;; URL: https://github.com/ian-kelling/spray
+;; Keywords: convenience

 
 ;;; Commentary:
 
 
 ;;; 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)
 ;;   (require 'spray)

-;;
+

 ;; Then you may run spray with "M-x spray-mode". Binding some keys may
 ;; also be useful.
 ;; Then you may run spray with "M-x spray-mode". Binding some keys may
 ;; also be useful.

-;;
+

 ;;   (global-set-key (kbd "<f6>") 'spray-mode)
 ;;   (global-set-key (kbd "<f6>") 'spray-mode)

+
+;; In spray-mode buffers, following commands are available.
+
+;; - =spray-start/stop= (SPC) ::
+;; pause or resume spraying
+
+;; - =spray-backward-word= (h, <left>) ::
+;; pause and back to the last word
+
+;; - =spray-forward-word= (l, <right>) ::
+;; inverse of =spray-backward-word=
+
+;; - =spray-faster= (f) ::
+;; increases speed
+
+;; - =spray-slower= (s) ::
+;; decreases speed
+
+;; - =spray-quit= (q, <return>) ::
+;; 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:
 
 ;;; Change Log:

+

 ;; 0.0.0 test release
 ;; 0.0.1 add spray-set-margins
 ;; 0.0.0 test release
 ;; 0.0.1 add spray-set-margins

+;; 0.0.2 margin options, speed control, better quit

 
 ;;; Code:
 
 
 ;;; Code:
 


@@ -45,10 +94,56 @@
 
 ;; * customizable vars
 
 
 ;; * customizable vars
 

-(defvar spray-wpm 400 "words/min")
-(defvar spray-height 400 "height of characters")
-(defvar spray-margin-top 1 "character margin at top of buffer. Characters are as big as spray text characters.")
-(defvar spray-margin-left 0 "character margin at left of buffer. Characters are as big as spray text 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)))
 
 (defvar spray-mode-map
   (let ((km (make-sparse-keymap)))


@@ -58,37 +153,30 @@
     (define-key km (kbd "<left>") 'spray-backward-word)
     (define-key km (kbd "<right>") 'spray-forward-word)
     (define-key km (kbd "f") 'spray-faster)
     (define-key km (kbd "<left>") 'spray-backward-word)
     (define-key km (kbd "<right>") '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 "<return>") 'spray-quit)
     (define-key km (kbd "q") 'spray-quit)
     (define-key km (kbd "<return>") '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")
 
     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)
-                    :slant 'normal)
-
-(make-face 'spray-orp-face)
-(set-face-attribute 'spray-orp-face nil
-                    :foreground "red"
-                    :overline (face-foreground 'default)
-                    :underline (face-foreground 'default)
-                    :slant 'normal)

 
 ;; * internal vars
 
 
 ;; * internal vars
 

-(defvar spray--margin-string ""
-  "Currently not used.")
+(defvar spray--margin-string "")

 (defvar spray--base-overlay nil)
 (defvar spray--base-overlay nil)

-(defvar spray--orp-overlay nil)
+(defvar spray--accent-overlay nil)

 (defvar spray--running 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--delay 0)
 (defvar spray--saved-cursor-type nil)

-(defvar spray--saved-buffer-face nil)

 (defvar spray--saved-restriction nil)
 (defvar spray--saved-restriction nil)

+(defvar spray--saved-minor-modes nil)

 
 ;; * utility functions
 
 
 ;; * utility functions
 


@@ -107,73 +195,74 @@
   :keymap spray-mode-map
   (cond (spray-mode
          (setq spray--base-overlay (make-overlay (point-min) (point-max))
   :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)
                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)
          (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)
+         (overlay-put spray--accent-overlay 'priority 101)
+         (overlay-put spray--accent-overlay 'face 'spray-accent-face)

          (spray-start))
         (t
          (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))
          (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-stop))))
+         (setq cursor-type spray--saved-cursor-type)
+         (dolist (mode spray--saved-minor-modes)
+           (funcall mode 1))
+         (setq spray--saved-minor-modes nil))))

 
 (defun spray-quit ()
   "Exit spray mode."
   (interactive)
   (spray-mode -1))
 
 
 (defun spray-quit ()
   "Exit spray mode."
   (interactive)
   (spray-mode -1))
 

-(defun spray--pre-command-handler ()
-  (unless (string-match "^spray-" (symbol-name this-command))
-    (spray-mode -1)))
-

 (defun spray--word-at-point ()
 (defun spray--word-at-point ()

-  (skip-chars-backward "^\s\t\n")
+  (skip-chars-backward "^\s\t\n—")

   (let* ((beg (point))
   (let* ((beg (point))

-         (len (skip-chars-forward "^\s\t\n"))
+         (len (+ (skip-chars-forward "^\s\t\n—") (skip-chars-forward "—")))

          (end (point))
          (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)))))
                        ((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)
     (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))))
                             (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)
     (spray-set-margins)
     (overlay-put spray--base-overlay 'before-string
                  (concat spray--margin-string
     (move-overlay spray--base-overlay beg end)
     (spray-set-margins)
     (overlay-put spray--base-overlay 'before-string
                  (concat spray--margin-string

-                         (make-string (- 5 (- orp beg)) ?\s)))
+                         (make-string (- 5 (- accent beg)) ?\s)))

     (narrow-to-region beg end)))
 
 (defun spray--update ()
     (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))))
          (setq spray--delay (1- spray--delay))
          (when (= spray--delay 2)
            (narrow-to-region (point) (point))))


@@ -181,7 +270,10 @@
          (widen)
          (if (eobp)
              (spray-mode -1)
          (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
            (spray--word-at-point)))))
 
 ;; * interactive commands


@@ -203,30 +295,30 @@ Returns t if spray was unpaused."
 (defun spray-start ()
   "Start / resume spray."
   (interactive)
 (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)))
 
   (setq spray--running
         (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update)))
 

-

 (defun spray-forward-word ()
   (interactive)
   (spray-stop)
   (widen)
 (defun spray-forward-word ()
   (interactive)
   (spray-stop)
   (widen)

-  (skip-chars-forward "\s\t\n")
+  (skip-chars-forward "\s\t\n—")

   (spray--word-at-point))
 
 (defun spray-backward-word ()
   (interactive)
   (spray-stop)
   (widen)
   (spray--word-at-point))
 
 (defun spray-backward-word ()
   (interactive)
   (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--word-at-point))
 
 (defun spray-faster ()
   "Increases speed.
 
 Increases the wpm (words per minute) parameter. See the variable

-`spray-wmp'."
+`spray-wpm'."

   (interactive)
   (spray-inc-wpm 20))
 
   (interactive)
   (spray-inc-wpm 20))
 


@@ -234,7 +326,7 @@ Increases the wpm (words per minute) parameter. See the variable
   "Decreases speed.
 
 Decreases the wpm (words per minute) parameter. See the variable
   "Decreases speed.
 
 Decreases the wpm (words per minute) parameter. See the variable

-`spray-wmp'."
+`spray-wpm'."

   (interactive)
   (spray-inc-wpm -20))
 
   (interactive)
   (spray-inc-wpm -20))