git.shemshak.org - ~bandali/configs/blob - .emacs.d/lisp/ffs/ffsanim.el

   1 ;;; ffsanim.el --- Form Feed Slides animate -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2022  Amin Bandali <bandali@gnu.org>
   4
   5 ;; Author: Amin Bandali <bandali@gnu.org>
   6 ;; Version: 0.1.5
   7 ;; Keywords: outlines, tools
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; A simple mode for doing simple plain text presentations where the
  25 ;; slides are separated using the form feed character (\f).  Uses
  26 ;; animate.el to animate each slide.
  27
  28 ;; Configuration: TODO
  29
  30 ;; Usage:
  31
  32 ;; (add-to-list 'load-path (b/lisp "ffs"))
  33 ;; (run-with-idle-timer 0.5 nil #'require 'ffsanim)
  34 ;; (with-eval-after-load 'ffsanim
  35 ;;   (defvar b/original-default-height)
  36 ;;   (defvar b/ffsanim-default-height 300)
  37 ;;   (global-set-key
  38 ;;    (kbd "C-c f s")
  39 ;;    (lambda ()
  40 ;;      (interactive)
  41 ;;      (setq
  42 ;;       b/original-default-height (face-attribute 'default :height))
  43 ;;      (set-face-attribute
  44 ;;       'default nil :height b/ffsanim-default-height)
  45 ;;      (message " ")
  46 ;;      (ffsanim)))
  47 ;;   (define-key
  48 ;;    ffsanim-mode-map (kbd "q")
  49 ;;    (lambda ()
  50 ;;      (interactive)
  51 ;;      (quit-window)
  52 ;;      (set-face-attribute
  53 ;;       'default nil :height b/original-default-height)
  54 ;;      (message " "))))
  55
  56 ;;; Code:
  57
  58 (require 'animate)
  59
  60 (defgroup ffsanim nil
  61   "Major mode for form feed-separated plain text presentations."
  62   :version "29.1"
  63   :prefix "ffsanim-")
  64
  65 (defcustom ffsanim-buffer-name "*ffsanim*"
  66   "The name of the ffsanim presentation buffer."
  67   :group 'ffsanim
  68   :type 'string)
  69
  70 (defcustom ffsanim-edit-buffer-name "*ffsanim-edit*"
  71   "The name of the ffsanim-edit buffer used when editing a slide."
  72   :group 'ffsanim
  73   :type 'string)
  74
  75 (defvar ffsanim--source-buffer-name ""
  76   "The name of the form feed-separated \"source\" buffer for a
  77 presentation.")
  78
  79 (defun ffsanim--buffer ()
  80   "Get the ffsanim presentation buffer."
  81   (get-buffer-create ffsanim-buffer-name))
  82
  83 (defmacro ffsanim-define-move-to-slide (name &optional doc &rest body)
  84   "Define a function for moving to a slide.
  85 Symbol NAME is the name describing the movement.
  86 DOC is the documentation string to use for the function."
  87   (declare (debug (&define name [&optional stringp] def-body))
  88            (doc-string 2) (indent defun))
  89   (when (and doc (not (stringp doc)))
  90     ;; `doc' is the first element of `body', not an actual docstring
  91     (push doc body)
  92     (setq doc nil))
  93   (let* ((sn (symbol-name name))
  94          (fname (intern (format "ffsanim-%s-slide" (downcase sn)))))
  95     `(defun ,fname ()
  96        ,doc
  97        (interactive)
  98        (let ((s (progn
  99                   (pop-to-buffer-same-window
 100                    (get-buffer ffsanim--source-buffer-name))
 101                   ,@body
 102                   (narrow-to-page)
 103                   (prog1 (buffer-string)
 104                     (widen)
 105                     (pop-to-buffer-same-window (ffsanim--buffer)))))
 106              (animation-buffer-name (buffer-name (ffsanim--buffer)))
 107              (inhibit-read-only t))
 108          (animate-sequence (split-string s "\n") 0)))))
 109
 110 (defun ffsanim-edit-slide (&optional add-before-or-after)
 111   "Pop to a new buffer to edit a slide.
 112 If ADD-BEFORE-OR-AFTER is nil or not given, we are editing an
 113 existing slide.  Otherwise, if it is `add-before' then the new
 114 slide will be added before the current slide, and if it is
 115 `add-after' then the new slide will be added after the current
 116 slide.  The logic for handling this is in `ffsanim-edit-done'."
 117   (interactive)
 118   (let* (m
 119          (s (with-current-buffer (get-buffer ffsanim--source-buffer-name)
 120               (setq m major-mode)
 121               (if add-before-or-after   ; if we are adding a new slide
 122                   "\n"                  ; start with just a newline
 123                 (narrow-to-page)
 124                 (prog1 (buffer-string)
 125                   (widen))))))
 126     (pop-to-buffer-same-window
 127      (get-buffer-create ffsanim-edit-buffer-name))
 128     (funcall m)
 129     (ffsanim-edit-mode 1)
 130     (insert s)
 131     (goto-char (point-min))
 132     (setq-local ffsanim--new-location add-before-or-after)
 133     (message
 134      (substitute-command-keys "Edit, then use `\\[ffsanim-edit-done]' \
 135 to apply your changes or `\\[ffsanim-edit-discard]' to discard them."))))
 136
 137 (defun ffsanim-edit-discard ()
 138   "Discard current ffsanim-edit buffer and return to the presentation."
 139   (interactive)
 140   (let ((buf (current-buffer)))
 141     (quit-windows-on buf)
 142     (kill-buffer buf))
 143   (pop-to-buffer-same-window (ffsanim--buffer)))
 144
 145 (defun ffsanim-edit-done ()
 146   "Apply the ffsanim-edit changes and return to the presentation."
 147   (interactive)
 148   (let* (f
 149          (str (buffer-string))
 150          (s (if (string-suffix-p "\n" str)
 151                 str
 152               (concat str "\n")))
 153          (l ffsanim--new-location))
 154     (with-current-buffer (get-buffer ffsanim--source-buffer-name)
 155       (save-excursion
 156         (cond
 157          ((eq l 'add-before)
 158           (backward-page)
 159           (insert (format "\n%s\f" s))
 160           (setq f #'ffsanim-previous-slide))
 161          ((eq l 'add-after)
 162           (forward-page)
 163           (insert (format "\n%s\f" s))
 164           (setq f #'ffsanim-next-slide))
 165          ((null l)
 166           (narrow-to-page)
 167           (delete-region (point-min) (point-max))
 168           (insert s)
 169           (widen)
 170           (setq f #'ffsanim-current-slide)))))
 171     (ffsanim-edit-discard)
 172     (funcall f)))
 173
 174 (defun ffsanim-new-slide-before ()
 175   "Add a new slide before the current slide."
 176   (interactive)
 177   (ffsanim-edit-slide 'add-before))
 178
 179 (defun ffsanim-new-slide-after ()
 180   "Add a new slide after the current slide."
 181   (interactive)
 182   (ffsanim-edit-slide 'add-after))
 183
 184 (defvar ffsanim--old-mode-line-format nil
 185   "The value of `mode-line-format' in the ffsanim presentation buffer
 186 before the last call to `ffsanim--toggle-mode-line'.")
 187
 188 (defun ffsanim--toggle-mode-line ()
 189   "Toggle the display of the mode-line in the current buffer."
 190   (interactive)
 191   (if mode-line-format
 192       (setq-local ffsanim--old-mode-line-format mode-line-format
 193                   mode-line-format nil)
 194     (setq-local mode-line-format ffsanim--old-mode-line-format
 195                 ffsanim--old-mode-line-format nil))
 196   (redraw-display))
 197
 198 (ffsanim-define-move-to-slide previous
 199   "Go to the previous slide."
 200   (backward-page)
 201   (backward-page))
 202
 203 (ffsanim-define-move-to-slide next
 204   "Go to the next slide."
 205   (forward-page))
 206
 207 (ffsanim-define-move-to-slide current
 208   "Reload and renimate the current slide."
 209   nil)
 210
 211 (ffsanim-define-move-to-slide first
 212   "Go to the first slide."
 213   (goto-char (point-min)))
 214
 215 (ffsanim-define-move-to-slide last
 216   "Go to the last slide."
 217   (goto-char (point-max)))
 218
 219 (define-derived-mode ffsanim-mode special-mode "ffsanim"
 220   "Major mode for form feed-separated plain text presentations."
 221   :group 'ffsanim
 222   :interative nil
 223   (setq-local animate-total-added-delay 0.3)
 224   (show-paren-local-mode -1)
 225   (display-battery-mode -1)
 226   (ffsanim--toggle-mode-line)
 227   (ffsanim-current-slide))
 228
 229 (defvar ffsanim-edit-mode-map
 230   (let ((map (make-sparse-keymap)))
 231     (define-key map (kbd "C-c C-k") #'ffsanim-edit-discard)
 232     (define-key map (kbd "C-c C-c") #'ffsanim-edit-done)
 233     map)
 234   "Keymap for `ffsanim-edit-mode'.")
 235
 236 (define-minor-mode ffsanim-edit-mode
 237   "Minor mode for editing a single ffsanim slide.
 238 When done editing the slide, run \\[ffsanim-edit-done] to apply your
 239 changes, or \\[ffsanim-edit-discard] to discard them."
 240   :group 'ffsanim
 241   :lighter " ffsanim-edit"
 242   :keymap ffsanim-edit-mode-map
 243   (defvar-local ffsanim--new-location nil
 244     "The location where the new slide should be inserted.
 245 See the docstring for `ffsanim-edit-slide' for more details."))
 246
 247 (define-key ffsanim-mode-map (kbd "p") #'ffsanim-previous-slide)
 248 (define-key ffsanim-mode-map (kbd "n") #'ffsanim-next-slide)
 249 (define-key ffsanim-mode-map (kbd "DEL") #'ffsanim-previous-slide)
 250 (define-key ffsanim-mode-map (kbd "SPC") #'ffsanim-next-slide)
 251 (define-key ffsanim-mode-map (kbd "g") #'ffsanim-current-slide)
 252 (define-key ffsanim-mode-map (kbd "<") #'ffsanim-first-slide)
 253 (define-key ffsanim-mode-map (kbd ">") #'ffsanim-last-slide)
 254 (define-key ffsanim-mode-map (kbd "e") #'ffsanim-edit-slide)
 255 (define-key ffsanim-mode-map (kbd "O") #'ffsanim-new-slide-before)
 256 (define-key ffsanim-mode-map (kbd "o") #'ffsanim-new-slide-after)
 257 (define-key ffsanim-mode-map (kbd "m") #'ffsanim--toggle-mode-line)
 258
 259 (defun ffsanim ()
 260   "Start an ffsanim presentation with current buffer as source."
 261   (interactive)
 262   (setq ffsanim--source-buffer-name (buffer-name))
 263   (pop-to-buffer-same-window (ffsanim--buffer))
 264   (ffsanim-mode))
 265
 266 (provide 'ffsanim)
 267 ;;; ffsanim.el ends here