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

   1 ;;; ffs.el --- Form Feed Slides mode       -*- 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.0
   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).
  26
  27 ;; Configuration: TODO
  28
  29 ;; Usage:
  30
  31 ;; Put this file, ffs.el, in a directory in your `load-path', then add
  32 ;; something like the following to your init file:
  33 ;;
  34 ;; (require 'ffs)
  35 ;; (global-set-key (kbd "C-c f s") #'ffs)
  36
  37 ;; Then, open a text file/buffer that you would like you to use as the
  38 ;; source of your presentation and type `M-x ffs RET' or a keyboard
  39 ;; shortcut you defined (like the above example) to start ffs, at
  40 ;; which point you should be able to see "ffs" appear as one of the
  41 ;; currently enabled minor modes in your mode-line.  Once ffs is
  42 ;; enabled, you can invoke its various commands.  To see a list of
  43 ;; available commands, you can either type `M-x ffs- TAB' (to get a
  44 ;; completion of commands starting with the "ffs-" prefix), or see the
  45 ;; definition of `ffs-minor-mode-map' near the end of this file.
  46
  47 ;;; Code:
  48
  49 (defgroup ffs nil
  50   "Minor mode for form feed-separated plain text presentations."
  51   :version "29.1"
  52   :prefix "ffs-")
  53
  54 (defcustom ffs-default-face-height 370
  55   "The value of the `height' property for the `default' face to use
  56 during the ffs presentation."
  57   :group 'ffs
  58   :type '(choice (const nil)
  59                  (integer :value 300)))
  60
  61 (defcustom ffs-edit-buffer-name "*ffs-edit*"
  62   "The name of the ffs-edit buffer used when editing a slide."
  63   :group 'ffs
  64   :type 'string)
  65
  66 (defvar ffs--slides-buffer nil
  67   "The main ffs presentation slides buffer.
  68 When the user enables ffs in a buffer using `\\[ffs]', we store a
  69 reference to that buffer in this variable.
  70
  71 As a special case, in a speaker notes buffer selected by the user
  72 using `\\[ffs-find-speaker-notes-file]' from the main ffs slides
  73 buffer, this variable will point to the main ffs slides buffer
  74 rather than the speaker notes buffer.")
  75
  76 (defvar ffs--notes-buffer nil
  77   "The ffs speaker notes buffer (only if selected).
  78 When the user chooses (and opens) a speaker notes file using
  79 `\\[ffs-find-speaker-notes-file]', a reference to the file's
  80 corresponding buffer is stored in this variable, local to the
  81 main ffs presentation slides buffer (`ffs--slides-buffer').")
  82
  83 (defvar ffs--old-mode-line-format nil
  84   "The old value of `mode-line-format' before enabling
  85 `ffs--no-mode-line-minor-mode'.")
  86
  87 (defvar ffs--old-cursor-type nil
  88   "The old value of `cursor-type' before enabling
  89 `ffs--no-cursor-minor-mode'.")
  90
  91 (defvar ffs--old-default-face-height nil
  92   "The old value of the `default' face's `height' property before
  93 starting the ffs presentation.")
  94
  95 (define-minor-mode ffs--no-mode-line-minor-mode
  96   "Minor mode for hiding the mode-line."
  97   :lighter nil
  98   (if ffs--no-mode-line-minor-mode
  99       (progn
 100         (unless ffs--old-mode-line-format
 101           (setq-local ffs--old-mode-line-format mode-line-format))
 102         (setq-local mode-line-format nil))
 103     (setq-local mode-line-format ffs--old-mode-line-format)
 104     (when ffs--old-mode-line-format
 105       ffs--old-mode-line-format nil))
 106   (redraw-display))
 107
 108 (define-minor-mode ffs--no-cursor-minor-mode
 109   "Minor mode for hiding the cursor."
 110   :lighter nil
 111   (if ffs--no-cursor-minor-mode
 112       (progn
 113         (unless ffs--old-cursor-type
 114           (setq-local ffs--old-cursor-type cursor-type))
 115         (setq-local cursor-type nil))
 116     (setq-local cursor-type ffs--old-cursor-type)
 117     (when ffs--old-cursor-type
 118       ffs--old-cursor-type nil)))
 119
 120 (defun ffs--toggle-dark-mode ()
 121   "Swap the frame background and foreground colours."
 122   (interactive)
 123   (let ((bg (frame-parameter nil 'background-color))
 124         (fg (frame-parameter nil 'foreground-color)))
 125     (set-background-color fg)
 126     (set-foreground-color bg)))
 127
 128 (defun ffs--goto-previous (buffer)
 129   "Go to the previous slide in the given BUFFER."
 130   (interactive)
 131   (with-current-buffer buffer
 132     (let ((n (buffer-narrowed-p)))
 133       (when n
 134         (goto-char (point-min))
 135         (widen)
 136         (backward-page))
 137       (backward-page)
 138       (when n (narrow-to-page)))))
 139
 140 (defun ffs-goto-previous ()
 141   "Go to the previous slide in the main ffs presentation and the
 142 speaker notes buffer (if any)."
 143   (interactive)
 144   (ffs--goto-previous ffs--slides-buffer)
 145   (when ffs--notes-buffer
 146     (ffs--goto-previous ffs--notes-buffer)
 147     (redraw-display)))
 148
 149 (defun ffs--goto-next (buffer)
 150   "Go to the next slide in the given BUFFER."
 151   (interactive)
 152   (with-current-buffer buffer
 153     (let ((n (buffer-narrowed-p))
 154           (e (= (- (point-max) (point-min)) 0)))
 155       (when n
 156         (goto-char (point-min))
 157         (widen))
 158       (unless e (forward-page))
 159       (when n (narrow-to-page)))))
 160
 161 (defun ffs-goto-next ()
 162   "Go to the next slide in the main ffs presentation and the
 163 speaker notes buffer (if any)."
 164   (interactive)
 165   (ffs--goto-next ffs--slides-buffer)
 166   (when ffs--notes-buffer
 167     (ffs--goto-next ffs--notes-buffer)
 168     (redraw-display)))
 169
 170 (defun ffs--goto-first (buffer)
 171   "Go to the first slide in the given BUFFER."
 172   (interactive)
 173   (with-current-buffer buffer
 174     (let ((n (buffer-narrowed-p)))
 175       (when n (widen))
 176       (goto-char (point-min))
 177       (when n (narrow-to-page)))))
 178
 179 (defun ffs-goto-first ()
 180   "Go to the first slide in the main ffs presentation and the
 181 speaker notes buffer (if any)."
 182   (interactive)
 183   (ffs--goto-first ffs--slides-buffer)
 184   (when ffs--notes-buffer
 185     (ffs--goto-first ffs--notes-buffer)
 186     (redraw-display)))
 187
 188 (defun ffs--goto-last (buffer)
 189   "Go to the last slide in the given BUFFER."
 190   (interactive)
 191   (let ((n (buffer-narrowed-p)))
 192     (when n (widen))
 193     (goto-char (point-max))
 194     (when n (narrow-to-page))))
 195
 196 (defun ffs-goto-last ()
 197   "Go to the last slide in the main ffs presentation and the
 198 speaker notes buffer (if any)."
 199   (interactive)
 200   (ffs--goto-last ffs--slides-buffer)
 201   (when ffs--notes-buffer
 202     (ffs--goto-last ffs--notes-buffer)
 203     (redraw-display)))
 204
 205 (defun ffs-start ()
 206   "Start the presentation."
 207   (interactive)
 208   (ffs-minor-mode 1)
 209   (ffs--no-mode-line-minor-mode 1)
 210   (ffs--no-cursor-minor-mode 1)
 211   (when (integerp ffs-default-face-height)
 212     (setq-local
 213      ffs--old-default-face-height
 214      (face-attribute 'default :height))
 215     (face-remap-add-relative
 216      'default :height ffs-default-face-height))
 217   (show-paren-local-mode -1)
 218   (display-battery-mode -1)
 219   (flyspell-mode -1)
 220   (narrow-to-page))
 221
 222 (defun ffs-quit ()
 223   "Quit the presentation."
 224   (interactive)
 225   (let ((n (buffer-narrowed-p))
 226         (e (= (- (point-max) (point-min)) 0)))
 227     (when (integerp ffs-default-face-height)
 228       (face-remap-add-relative
 229        'default :height ffs--old-default-face-height))
 230     (show-paren-local-mode 1)
 231     (display-battery-mode 1)
 232     (flyspell-mode 1)
 233     (ffs--no-mode-line-minor-mode -1)
 234     (ffs--no-cursor-minor-mode -1)
 235     (if n
 236         (progn
 237           (goto-char (point-min))
 238           (widen))
 239       (ffs-minor-mode -1))
 240     (when e (forward-char -1))))
 241
 242 (defun ffs-edit (&optional add-above-or-below)
 243   "Pop to a new buffer to edit a slide.
 244 If ADD-ABOVE-OR-BELOW is nil or not given, we are editing an
 245 existing slide.  Otherwise, if it is `add-above' then the new
 246 slide will be added above/before the current slide, and if it is
 247 `add-below' then the new slide will be added below/after the
 248 current slide.  The logic is implemented in `ffs-edit-done'."
 249   (interactive)
 250   (let* ((b (current-buffer))
 251          (m major-mode)
 252          (n (buffer-narrowed-p))
 253          (s (if add-above-or-below      ; if we are adding a new slide
 254                 "\n"                    ; start with just a newline
 255               (unless n (narrow-to-page))
 256               (prog1 (buffer-string)
 257                 (unless n (widen))))))
 258     (pop-to-buffer-same-window
 259      (get-buffer-create ffs-edit-buffer-name))
 260     (funcall m)
 261     (ffs-edit-minor-mode 1)
 262     (insert s)
 263     (goto-char (point-min))
 264     (set-buffer-modified-p nil)
 265     (setq-local
 266      ffs--edit-source-buffer b
 267      ffs--new-location add-above-or-below)
 268     (message
 269      (substitute-command-keys "Edit, then use `\\[ffs-edit-done]' \
 270 to apply your changes or `\\[ffs-edit-discard]' to discard them."))))
 271
 272 (defun ffs-new-above ()
 273   "Add a new slide above/before the current slide."
 274   (interactive)
 275   (ffs-edit 'add-above))
 276
 277 (defun ffs-new-below ()
 278   "Add a new slide below/after the current slide."
 279   (interactive)
 280   (ffs-edit 'add-below))
 281
 282 (defun ffs-edit-discard ()
 283   "Discard current ffs-edit buffer and return to the presentation."
 284   (interactive)
 285   (let ((b (current-buffer)))
 286     (quit-windows-on b)
 287     (kill-buffer b)))
 288
 289 (defun ffs-edit-done ()
 290   "Apply the ffs-edit changes and return to the presentation."
 291   (interactive)
 292   (let* (f
 293          (str (buffer-string))
 294          (s (if (string-suffix-p "\n" str)
 295                 str
 296               (concat str "\n")))
 297          (l ffs--new-location))
 298     (with-current-buffer ffs--edit-source-buffer
 299       (let ((inhibit-read-only t))
 300         (save-excursion
 301           (cond
 302            ((eq l 'add-above)
 303             (backward-page)
 304             (insert (format "\n%s\f" s))
 305             (setq f #'ffs-previous-slide))
 306            ((eq l 'add-below)
 307             (forward-page)
 308             (insert (format "\n%s\f" s))
 309             (setq f #'ffs-next-slide))
 310            ((null l)
 311             (narrow-to-page)
 312             (delete-region (point-min) (point-max))
 313             (insert s)
 314             (widen))))))
 315     (ffs-edit-discard)
 316     (when (functionp f)
 317       (funcall f))))
 318
 319 (defun ffs--undo (&optional arg)
 320   "Like `undo', but it works even when the buffer is read-only."
 321   (interactive "P")
 322   (let ((inhibit-read-only t))
 323     (undo arg)))
 324
 325 (defun ffs-find-speaker-notes-file (file)
 326   "Prompt user for a speaker notes file, open it in a new frame."
 327   (interactive "Fspeakers notes buffer: ")
 328   (let ((b (current-buffer)))
 329     (save-excursion
 330       (find-file-other-frame file)
 331       (ffs-minor-mode 1)
 332       (setq-local
 333        ffs--slides-buffer b
 334        ffs--notes-buffer (current-buffer)))
 335     (setq-local ffs--notes-buffer (get-file-buffer file))))
 336
 337 (defun ffs-export-slides-to-pdf ()
 338   (interactive)
 339   (with-current-buffer ffs--slides-buffer
 340     (ffs-goto-first)
 341     (let ((c 1)
 342           (fringe fringe-mode))
 343       (fringe-mode 0)
 344       (while (not (eobp))
 345         (let ((fn (format "%s-%03d.pdf"
 346                           (file-name-sans-extension (buffer-name))
 347                           c))
 348               (data (x-export-frames nil 'pdf)))
 349           (with-temp-file fn
 350             (insert data)))
 351         (setq c (+ c 1))
 352         (ffs-goto-next))
 353       (fringe-mode fringe))))
 354
 355 (defvar ffs-edit-minor-mode-map
 356   (let ((map (make-sparse-keymap)))
 357     (define-key map (kbd "C-c C-k") #'ffs-edit-discard)
 358     (define-key map (kbd "C-c C-c") #'ffs-edit-done)
 359     map)
 360   "Keymap for `ffs-edit-minor-mode'.")
 361
 362 (define-minor-mode ffs-edit-minor-mode
 363   "Minor mode for editing a single ffs slide.
 364 When done editing the slide, run \\[ffs-edit-done] to apply your
 365 changes, or \\[ffs-edit-discard] to discard them."
 366   :group 'ffs
 367   :lighter " ffs-edit"
 368   :keymap ffs-edit-minor-mode-map
 369   (defvar-local ffs--edit-source-buffer nil
 370     "The ffs presentation buffer of the slide being edited.")
 371   (defvar-local ffs--new-location nil
 372     "The location where the new slide should be inserted.
 373 See the docstring for `ffs-edit' for more details."))
 374
 375 (defvar ffs-minor-mode-map
 376   (let ((map (make-sparse-keymap)))
 377     (define-key map (kbd "p") #'ffs-goto-previous)
 378     (define-key map (kbd "n") #'ffs-goto-next)
 379     (define-key map (kbd "DEL") #'ffs-goto-previous)
 380     (define-key map (kbd "SPC") #'ffs-goto-next)
 381     (define-key map (kbd "[") #'ffs-goto-previous)
 382     (define-key map (kbd "]") #'ffs-goto-next)
 383     (define-key map (kbd "<") #'ffs-goto-first)
 384     (define-key map (kbd ">") #'ffs-goto-last)
 385     (define-key map (kbd "s") #'ffs-start)
 386     (define-key map (kbd "q") #'ffs-quit)
 387     (define-key map (kbd "e") #'ffs-edit)
 388     (define-key map (kbd "O") #'ffs-new-above)
 389     (define-key map (kbd "o") #'ffs-new-below)
 390     (define-key map (kbd "m") #'ffs--no-mode-line-minor-mode)
 391     (define-key map (kbd "c") #'ffs--no-cursor-minor-mode)
 392     (define-key map (kbd "d") #'ffs--toggle-dark-mode)
 393     (define-key map (kbd "N") #'narrow-to-page)
 394     (define-key map (kbd "W") #'widen)
 395     (define-key map [remap undo] #'ffs--undo)
 396     (define-key map (kbd "C-c n") #'ffs-find-speaker-notes-file)
 397     map)
 398   "Keymap for `ffs-minor-mode'.")
 399
 400 (define-minor-mode ffs-minor-mode
 401   "Minor mode for form feed-separated plain text presentations."
 402   :group 'ffs
 403   :lighter " ffs"
 404   :keymap ffs-minor-mode-map
 405   (setq-local
 406    ffs--old-mode-line-format mode-line-format
 407    ffs--old-cursor-type cursor-type
 408    ffs--old-default-face-height
 409    (face-attribute 'default :height))
 410   (setq buffer-read-only ffs-minor-mode))
 411
 412 (defun ffs ()
 413   "Enable `ffs-minor-mode' for presenting the current buffer."
 414   (interactive)
 415   (ffs-minor-mode 1)
 416   (setq-local ffs--slides-buffer (current-buffer)))
 417
 418 (provide 'ffs)
 419 ;;; ffs.el ends here