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

   1 ;; custom
   2 (defvar spray-wpm 400 "words/min")
   3 (defvar spray-text-scale 5)
   4
   5 (make-face 'spray-orp-face)
   6 (set-face-attribute 'spray-orp-face nil
   7                     :foreground "red"
   8                     :underline (face-foreground 'default)
   9                     :overline (face-foreground 'default))
  10
  11 ;; internal variables for spraying
  12 (defvar spray--padding-overlay nil)
  13 (defvar spray--orp-overlay nil)
  14 (defvar spray--timer nil)
  15 (defvar spray--delay 0)
  16
  17 ;; incompatible minor-modes
  18 (defvar spray--saved-global-hl-line-mode nil)
  19 (defvar spray--saved-font-lock-mode nil)
  20 (defvar spray--saved-hl-line-mode nil)
  21 (defvar spray--saved-cursor-type nil)
  22
  23 (define-minor-mode spray-mode
  24   "spray mode"
  25   :init nil
  26   :global nil
  27   (cond (spray-mode
  28          (setq spray--orp-overlay (make-overlay 0 0)
  29                spray--padding-overlay (make-overlay 0 0)
  30                spray--timer (run-with-timer 0 (/ 60.0 spray-wpm) 'spray-next)
  31                spray--saved-cursor-type cursor-type)
  32          (setq cursor-type nil)
  33          (text-scale-set spray-text-scale)
  34          (overlay-put spray--orp-overlay 'face 'spray-orp-face)
  35          (add-hook 'pre-command-hook 'turn-off-spray-mode)
  36          ;; disable incompatible minor-modes
  37          (when (boundp 'global-hl-line-mode)
  38            (setq spray--saved-global-hl-line-mode global-hl-line-mode)
  39            (set (make-local-variable 'global-hl-line-mode) nil))
  40          (when (boundp 'font-lock-mode)
  41            (setq spray--saved-font-lock-mode font-lock-mode)
  42            (font-lock-mode -1))
  43          (when (boundp 'hl-line-mode)
  44            (setq spray--saved-hl-line-mode hl-line-mode)
  45            (hl-line-mode -1)))
  46         (t
  47          (widen)
  48          (setq cursor-type spray--saved-cursor-type)
  49          (text-scale-set 0)
  50          (delete-overlay spray--orp-overlay)
  51          (delete-overlay spray--padding-overlay)
  52          (cancel-timer spray--timer)
  53          (remove-hook 'pre-command-hook 'turn-off-spray-mode)
  54          ;; restore incompatible minor-modes
  55          (when spray--saved-global-hl-line-mode
  56            (setq global-hl-line-mode spray--saved-global-hl-line-mode))
  57          (when spray--saved-font-lock-mode
  58            (font-lock-mode 1))
  59          (when spray--saved-hl-line-mode
  60            (hl-line-mode 1)))))
  61
  62 (defun turn-on-spray-mode () (interactive) (spray-mode 1))
  63 (defun turn-off-spray-mode () (interactive) (spray-mode -1))
  64
  65 (defun spray-next ()
  66   (cond ((not (zerop spray--delay))
  67          (setq spray--delay (1- spray--delay))
  68          (when (and (<= spray--delay 2)
  69                     (= (char-before) ?.))
  70            (narrow-to-region (point) (point))))
  71         (t
  72          (widen)
  73          (if (eobp)
  74              (turn-off-spray-mode)
  75            (skip-chars-forward "\s\t\n")
  76            (let* ((beg (point))
  77                   (len (skip-chars-forward "^\s\t\n"))
  78                   (end (point))
  79                   (orp (+ beg (cl-case len
  80                                 ((1) 1)
  81                                 ((2 3 4 5) 2)
  82                                 ((6 7 8 9) 3)
  83                                 ((10 11 12 13) 4)
  84                                 (t 5)))))
  85              (setq spray--delay (+ (if (> len 8) 1 0) (cl-case (char-before)
  86                                                         ((?. ?! ?\? ?\;) 3)
  87                                                         ((?, ?:) 1)
  88                                                         (t 0))))
  89              (overlay-put spray--padding-overlay
  90                           'before-string (make-string (- 5 (- orp beg)) ?\s))
  91              (move-overlay spray--padding-overlay beg (1+ beg))
  92              (move-overlay spray--orp-overlay (1- orp) orp)
  93              (narrow-to-region beg end))))))
  94
  95 (provide 'spray)