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

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