org-show.el

   1
   2 ;;; org-show.el --- Summary
   3 ;; Copyright(C) 2014 John Kitchin
   4
   5 ;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
   6 ;; Contributions from Sacha Chua.
   7 ;; This file is not currently part of GNU Emacs.
   8
   9 ;; This program is free software; you can redistribute it and/or
  10 ;; modify it under the terms of the GNU General Public License as
  11 ;; published by the Free Software Foundation; either version 2, or (at
  12 ;; your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; 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 ; see the file COPYING.  If not, write to
  21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25 ;; A simple mode for presenting org-files as slide-shows
  26
  27 (defvar org-show-presentation-file nil "File containing the presentation.")
  28 (defvar org-show-slide-tag "slide" "Tag that marks slides.")
  29 (defvar org-show-slide-tag-regexp (concat ":" (regexp-quote org-show-slide-tag) ":"))
  30 (defvar org-show-latex-scale 4.0 "scale for latex preview")
  31
  32 (defvar org-show-original-latex-scale
  33   (plist-get org-format-latex-options :scale)
  34   "Original scale for latex preview, so we can reset it.")
  35
  36 (defvar org-show-text-scale 4 "scale for text in presentation")
  37 (defvar org-show-current-slide-number 1 "holds current slide number")
  38
  39 (defvar org-show-mogrify-p (executable-find "mogrify"))
  40
  41 (defvar org-show-tags-column -60 "column position to move tags to in slide mode")
  42 (defvar org-show-original-tags-column org-tags-column "Save value so we can change back to it")
  43
  44 (when org-show-mogrify-p (require 'eimp))
  45
  46 (require 'easymenu)
  47
  48 (defvar org-show-mode-map
  49   (let ((map (make-sparse-keymap)))
  50     (define-key map [next] 'org-show-next-slide)
  51     (define-key map [prior] 'org-show-previous-slide)
  52
  53     (define-key map [f5] 'org-show-start-slideshow)
  54     (define-key map [f6] 'org-show-execute-slide)
  55     (define-key map (kbd "C--") 'org-show-decrease-text-size)
  56     (define-key map (kbd "C-=") 'org-show-increase-text-size)
  57     (define-key map (kbd "\e\eg") 'org-show-goto-slide)
  58     (define-key map (kbd "\e\et") 'org-show-toc)
  59     (define-key map (kbd "\e\eq") 'org-show-stop-slideshow)
  60     map)
  61   "Keymap for org-show-mode.")
  62
  63 (easy-menu-define my-menu org-show-mode-map "My own menu"
  64   '("org-show"
  65     ["Start slide show" org-show-start-slideshow t]
  66     ["Next slide" org-show-next-slide t]
  67     ["Previous slide" org-show-previous-slide t]
  68     ["Open this slide" org-show-open-slide t]
  69     ["Goto slide" org-show-goto-slide t]
  70     ["Table of contents" org-show-toc t]
  71     ["Stop slide show"  org-show-stop-slideshow t]
  72 ))
  73
  74
  75 (define-minor-mode org-show-mode
  76   "Minor mode for org-show
  77
  78 \\{org-show-mode-map}"
  79   :lighter " org-show"
  80   :global t
  81   :keymap org-show-mode-map)
  82
  83 (defvar org-show-temp-images '() "list of temporary images")
  84
  85 (defun org-show-execute-slide ()
  86   "Process slide at point.
  87   If it contains an Emacs Lisp source block, evaluate it.
  88   If it contains an image, view it in a split buffer
  89   Else, focus on that buffer.
  90   Hide all drawers."
  91   (interactive)
  92   (setq org-show-presentation-file (expand-file-name (buffer-name)))
  93   (delete-other-windows)
  94
  95   ;; make sure nothing is folded. This seems to be necessary to
  96   ;; prevent an error on narrowing then trying to make latex fragments
  97   ;; I think.
  98   (org-cycle '(64))
  99
 100   (org-narrow-to-subtree)
 101   (visual-line-mode 1)
 102   (let ((heading-text (nth 4 (org-heading-components)))
 103         (org-format-latex-options (plist-put org-format-latex-options :scale org-show-latex-scale)))
 104
 105     (set-frame-name (format "%-180s%15s%s" heading-text "slide " (cdr (assoc heading-text org-show-slide-titles))))
 106
 107     ;; preview equations in the current subtree
 108     (org-preview-latex-fragment '(4))
 109     (message "") ; clear minibuffer
 110     (cond
 111
 112      ;; view images if there is one. WE only do this this for the first one.
 113      ((and (goto-char (point-min))
 114            (re-search-forward "\\[\\[\\(.*\\.\\(jpg\\|gif\\|png\\)\\)" nil t))
 115
 116       (unless (file-exists-p "org-show-images")
 117         (make-directory "org-show-images"))
 118
 119       (let* ((png-file (match-string 1))
 120              (temp-png (expand-file-name (concat "org-show-images/" (secure-hash 'sha1
 121                                             (with-temp-buffer
 122                                               (insert-file-contents png-file)
 123                                               (buffer-string))) ".png"))))
 124
 125         (add-to-list 'org-show-temp-images temp-png)
 126         (unless (file-exists-p temp-png)
 127           (copy-file png-file temp-png t))
 128
 129         (split-window-right)
 130
 131         (other-window 1)
 132         (find-file temp-png)
 133         (when org-show-mogrify-p
 134           (eimp-fit-image-width-to-window nil)))
 135
 136       (other-window 1) ; back to slide
 137       (goto-char (point-min))
 138       (text-scale-set org-show-text-scale)
 139       (org-display-inline-images)
 140       (org-cycle-hide-drawers t)
 141       (org-show-subtree))
 142
 143      ;; find and execute source code blocks.
 144      ;; you can either have images, or code. Not both.
 145      ;; Only code blocks of type emacs-lisp-slide are used.
 146      ((and (goto-char (point-min))
 147            (re-search-forward "#\\+begin_src emacs-lisp-slide" nil t))
 148       (let ((info (org-babel-get-src-block-info)))
 149         (unwind-protect
 150             (eval (read (concat "(progn " (nth 1 info) ")"))))))
 151
 152      ;; plain text slides
 153      (t
 154       (switch-to-buffer (current-buffer))
 155       (text-scale-set org-show-text-scale)
 156       (org-show-subtree)
 157       (org-cycle-hide-drawers t)
 158       (org-display-inline-images)
 159       (delete-other-windows)))))
 160
 161 (defun org-show-next-slide ()
 162   "Goto next slide in presentation"
 163   (interactive)
 164   (find-file org-show-presentation-file)
 165   (widen)
 166   (if (<= (+ org-show-current-slide-number 1) (length org-show-slide-titles))
 167       (progn
 168         (setq org-show-current-slide-number (+ org-show-current-slide-number 1))
 169         (org-show-goto-slide org-show-current-slide-number))
 170     (org-show-goto-slide org-show-current-slide-number)
 171     (message "This is the end. My only friend the end.  Jim Morrison.")))
 172
 173 (defun org-show-previous-slide ()
 174   "Goto previous slide in the list"
 175   (interactive)
 176   (find-file org-show-presentation-file)
 177   (widen)
 178   (if (> (- org-show-current-slide-number 1) 0)
 179       (progn
 180         (setq org-show-current-slide-number (- org-show-current-slide-number 1))
 181         (org-show-goto-slide org-show-current-slide-number))
 182     (org-show-goto-slide org-show-current-slide-number)
 183     (message "Once upon a time...")))
 184
 185 (defun org-show-open-slide ()
 186  "Start show at this slide"
 187  (setq org-show-presentation-file (expand-file-name (buffer-name)))
 188  (org-show-initialize)
 189  (let ((n (cdr (assoc (nth 4 (org-heading-components)) org-show-slide-titles))))
 190    (setq org-show-current-slide-number n)
 191    (org-show-goto-slide n)))
 192
 193 (defvar org-show-slide-list '() "List of slide numbers and markers to each slide")
 194 (defvar org-show-slide-titles '() "List of titles and slide numbers for each slide")
 195
 196 (defun org-show-initialize ()
 197   ;; make slide lists for future navigation. rerun this if you change slide order
 198   (setq  org-show-slide-titles '()
 199          org-show-temp-images '()
 200          org-show-slide-list '())
 201
 202   (let ((n 0))
 203     (org-map-entries
 204      (lambda ()
 205        (when (string-match-p ":slide:" (or (nth 5 (org-heading-components)) ""))
 206          (setq n (+ n 1))
 207
 208          (add-to-list 'org-show-slide-titles
 209                       (cons (nth 4 (org-heading-components)) n) t)
 210
 211          (add-to-list 'org-show-slide-list
 212                       (cons n (set-marker (make-marker) (point))) t))))))
 213
 214 (defun org-show-start-slideshow ()
 215   "Start the slide show, at the beginning"
 216   (interactive)
 217
 218   (setq org-show-presentation-file (expand-file-name (buffer-name)))
 219   (beginning-of-buffer)
 220   (setq org-tags-column org-show-tags-column)
 221   (org-set-tags-command '(4) t)
 222
 223   (org-show-initialize)
 224   ;; hide slide tags
 225   (save-excursion
 226     (while (re-search-forward ":slide:" nil t)
 227       (overlay-put
 228        (make-overlay (match-beginning 0)(match-end 0))
 229        'invisible 'slide)))
 230   (add-to-invisibility-spec 'slide)
 231   (beginning-of-buffer)
 232   (delete-other-windows)
 233   (org-show-mode 1)
 234   (setq org-show-current-slide-number 1)
 235   (org-show-goto-slide 1))
 236
 237 (defun org-show-stop-slideshow ()
 238   (interactive)
 239   ;; make slide tag visible again
 240   (remove-from-invisibility-spec 'slide)
 241
 242   ;; reset latex scale
 243   (plist-put org-format-latex-options :scale org-show-original-latex-scale)
 244
 245   ;; clean up temp images
 246   (mapcar (lambda (x)
 247             (let ((bname (file-name-nondirectory x)))
 248               (when (get-buffer bname)
 249                 (set-buffer bname)
 250                 (save-buffer)
 251                 (kill-buffer bname)))
 252
 253             (when (file-exists-p x)
 254               (delete-file x)))
 255           org-show-temp-images)
 256   (setq org-show-temp-images '())
 257
 258   ;; ;; clean up miscellaneous buffers
 259   (when (get-buffer "*Animation*") (kill-buffer "*Animation*"))
 260
 261   (when org-show-presentation-file (find-file org-show-presentation-file))
 262   (widen)
 263   (text-scale-set 0)
 264   (delete-other-windows)
 265   (setq org-show-presentation-file nil)
 266   (setq org-show-current-slide-number 1)
 267   (set-frame-name (if (buffer-file-name)
 268                    (abbreviate-file-name (buffer-file-name))))
 269   (setq org-tags-column org-show-original-tags-column)
 270   (org-set-tags-command '(4) t)
 271
 272   (org-show-mode -1))
 273
 274 (defalias 'stop 'org-show-stop-slideshow)
 275
 276 (defun org-show-goto-slide (n)
 277  "Goto slide N"
 278  (interactive "nSlide number: ")
 279  (message "Going to slide %s" n)
 280  (find-file org-show-presentation-file)
 281  (setq org-show-current-slide-number n)
 282  (widen)
 283  (goto-char (cdr (assoc n org-show-slide-list)))
 284  (org-show-execute-slide))
 285
 286 (defun org-show-toc ()
 287   (interactive)
 288   (let ((links) (c-b (buffer-name)) (n))
 289     (save-excursion
 290       (widen)
 291       (mapcar
 292        (lambda (x)
 293          (setq n (car x))
 294          (goto-char (cdr x))
 295          (add-to-list
 296           'links
 297           (format " [[elisp:(progn (switch-to-buffer \"%s\")(goto-char %s)(org-show-execute-slide))][%2s %s]]\n\n"
 298                   (marker-buffer (cdr x))
 299                   (marker-position (cdr x))
 300                   (car x)
 301                   (nth 4 (org-heading-components))) t))
 302               org-show-slide-list))
 303
 304     (switch-to-buffer "*List of Slides*")
 305     (org-mode)
 306     (erase-buffer)
 307
 308     (insert (mapconcat 'identity links ""))
 309
 310     ;(setq buffer-read-only t)
 311     (use-local-map (copy-keymap org-mode-map))
 312     (local-set-key "q" #'(lambda () (interactive) (kill-buffer)))))
 313
 314 (require 'animate)
 315
 316 (defun org-show-animate (strings)
 317   "Animate STRINGS in an *Animation* buffer"
 318   (switch-to-buffer (get-buffer-create
 319                      (or animation-buffer-name
 320                          "*Animation*")))
 321   (erase-buffer)
 322   (text-scale-set 6)
 323   (let* ((vpos (/ (- 20
 324                      1 ;; For the mode-line
 325                      (1- (length strings))
 326                      (length strings))
 327                   2))
 328          (width 43)
 329          hpos)
 330     (while strings
 331       (setq hpos (/ (- width (length (car strings))) 2))
 332       (when (> 0 hpos) (setq hpos 0))
 333       (when (> 0 vpos) (setq vpos 0))
 334       (animate-string (car strings) vpos hpos)
 335       (setq vpos (1+ vpos))
 336       (setq strings (cdr strings)))))
 337
 338 (defun org-show-increase-text-size (&optional arg)
 339   "Increase text size. Bound to \\[org-show-increase-text-size].
 340
 341 With prefix ARG, set `org-show-text-scale' so subsquent slides are the same text size."
 342   (interactive "P")
 343   (text-scale-increase 1.5)
 344   (when arg
 345     (setq org-show-text-scale (* org-show-text-scale 1.5))))
 346
 347 (defun org-show-decrease-text-size (&optional arg)
 348   "Increase text size. Bound to \\[org-show-decrease-text-size].
 349
 350 With prefix ARG, set `org-show-text-scale' so subsquent slides are the same text size."
 351   (interactive "P")
 352   (text-scale-decrease 1.5)
 353   (when arg
 354     (setq org-show-text-scale (/ org-show-text-scale 1.5)))
 355 )
 356
 357 (provide 'org-show)