+++ /dev/null
-
-;;; org-show.el --- Summary
-;; Copyright(C) 2014 John Kitchin
-
-;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
-;; Contributions from Sacha Chua.
-;; This file is not currently part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;; A simple mode for presenting org-files as slide-shows
-
-(defvar org-show-presentation-file nil "File containing the presentation.")
-(defvar org-show-slide-tag "slide" "Tag that marks slides.")
-(defvar org-show-slide-tag-regexp (concat ":" (regexp-quote org-show-slide-tag) ":"))
-(defvar org-show-latex-scale 4.0 "scale for latex preview")
-
-(defvar org-show-original-latex-scale
- (plist-get org-format-latex-options :scale)
- "Original scale for latex preview, so we can reset it.")
-
-(defvar org-show-text-scale 4 "scale for text in presentation")
-(defvar org-show-current-slide-number 1 "holds current slide number")
-
-(defvar org-show-mogrify-p (executable-find "mogrify"))
-
-(defvar org-show-tags-column -60 "column position to move tags to in slide mode")
-(defvar org-show-original-tags-column org-tags-column "Save value so we can change back to it")
-
-(when org-show-mogrify-p (require 'eimp))
-
-(require 'easymenu)
-
-(defvar org-show-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [next] 'org-show-next-slide)
- (define-key map [prior] 'org-show-previous-slide)
-
- (define-key map [f5] 'org-show-start-slideshow)
- (define-key map [f6] 'org-show-execute-slide)
- (define-key map (kbd "C--") 'org-show-decrease-text-size)
- (define-key map (kbd "C-=") 'org-show-increase-text-size)
- (define-key map (kbd "\e\eg") 'org-show-goto-slide)
- (define-key map (kbd "\e\et") 'org-show-toc)
- (define-key map (kbd "\e\eq") 'org-show-stop-slideshow)
- map)
- "Keymap for org-show-mode.")
-
-(easy-menu-define my-menu org-show-mode-map "My own menu"
- '("org-show"
- ["Start slide show" org-show-start-slideshow t]
- ["Next slide" org-show-next-slide t]
- ["Previous slide" org-show-previous-slide t]
- ["Open this slide" org-show-open-slide t]
- ["Goto slide" org-show-goto-slide t]
- ["Table of contents" org-show-toc t]
- ["Stop slide show" org-show-stop-slideshow t]
-))
-
-
-(define-minor-mode org-show-mode
- "Minor mode for org-show
-
-\\{org-show-mode-map}"
- :lighter " org-show"
- :global t
- :keymap org-show-mode-map)
-
-(defvar org-show-temp-images '() "list of temporary images")
-
-(defun org-show-execute-slide ()
- "Process slide at point.
- If it contains an Emacs Lisp source block, evaluate it.
- If it contains an image, view it in a split buffer
- Else, focus on that buffer.
- Hide all drawers."
- (interactive)
- (setq org-show-presentation-file (expand-file-name (buffer-name)))
- (delete-other-windows)
-
- ;; make sure nothing is folded. This seems to be necessary to
- ;; prevent an error on narrowing then trying to make latex fragments
- ;; I think.
- (org-cycle '(64))
-
- (org-narrow-to-subtree)
- (visual-line-mode 1)
- (let ((heading-text (nth 4 (org-heading-components)))
- (org-format-latex-options (plist-put org-format-latex-options :scale org-show-latex-scale)))
-
- (set-frame-name (format "%-180s%15s%s" heading-text "slide " (cdr (assoc heading-text org-show-slide-titles))))
-
- ;; preview equations in the current subtree
- (org-preview-latex-fragment '(4))
- (message "") ; clear minibuffer
- (cond
-
- ;; view images if there is one. WE only do this this for the first one.
- ((and (goto-char (point-min))
- (re-search-forward "\\[\\[\\(.*\\.\\(jpg\\|gif\\|png\\)\\)" nil t))
-
- (unless (file-exists-p "org-show-images")
- (make-directory "org-show-images"))
-
- (let* ((png-file (match-string 1))
- (temp-png (expand-file-name (concat "org-show-images/" (secure-hash 'sha1
- (with-temp-buffer
- (insert-file-contents png-file)
- (buffer-string))) ".png"))))
-
- (add-to-list 'org-show-temp-images temp-png)
- (unless (file-exists-p temp-png)
- (copy-file png-file temp-png t))
-
- (split-window-right)
-
- (other-window 1)
- (find-file temp-png)
- (when org-show-mogrify-p
- (eimp-fit-image-width-to-window nil)))
-
- (other-window 1) ; back to slide
- (goto-char (point-min))
- (text-scale-set org-show-text-scale)
- (org-display-inline-images)
- (org-cycle-hide-drawers t)
- (org-show-subtree))
-
- ;; find and execute source code blocks.
- ;; you can either have images, or code. Not both.
- ;; Only code blocks of type emacs-lisp-slide are used.
- ((and (goto-char (point-min))
- (re-search-forward "#\\+begin_src emacs-lisp-slide" nil t))
- (let ((info (org-babel-get-src-block-info)))
- (unwind-protect
- (eval (read (concat "(progn " (nth 1 info) ")"))))))
-
- ;; plain text slides
- (t
- (switch-to-buffer (current-buffer))
- (text-scale-set org-show-text-scale)
- (org-show-subtree)
- (org-cycle-hide-drawers t)
- (org-display-inline-images)
- (delete-other-windows)))))
-
-(defun org-show-next-slide ()
- "Goto next slide in presentation"
- (interactive)
- (find-file org-show-presentation-file)
- (widen)
- (if (<= (+ org-show-current-slide-number 1) (length org-show-slide-titles))
- (progn
- (setq org-show-current-slide-number (+ org-show-current-slide-number 1))
- (org-show-goto-slide org-show-current-slide-number))
- (org-show-goto-slide org-show-current-slide-number)
- (message "This is the end. My only friend the end. Jim Morrison.")))
-
-(defun org-show-previous-slide ()
- "Goto previous slide in the list"
- (interactive)
- (find-file org-show-presentation-file)
- (widen)
- (if (> (- org-show-current-slide-number 1) 0)
- (progn
- (setq org-show-current-slide-number (- org-show-current-slide-number 1))
- (org-show-goto-slide org-show-current-slide-number))
- (org-show-goto-slide org-show-current-slide-number)
- (message "Once upon a time...")))
-
-(defun org-show-open-slide ()
- "Start show at this slide"
- (setq org-show-presentation-file (expand-file-name (buffer-name)))
- (org-show-initialize)
- (let ((n (cdr (assoc (nth 4 (org-heading-components)) org-show-slide-titles))))
- (setq org-show-current-slide-number n)
- (org-show-goto-slide n)))
-
-(defvar org-show-slide-list '() "List of slide numbers and markers to each slide")
-(defvar org-show-slide-titles '() "List of titles and slide numbers for each slide")
-
-(defun org-show-initialize ()
- ;; make slide lists for future navigation. rerun this if you change slide order
- (setq org-show-slide-titles '()
- org-show-temp-images '()
- org-show-slide-list '())
-
- (let ((n 0))
- (org-map-entries
- (lambda ()
- (when (string-match-p ":slide:" (or (nth 5 (org-heading-components)) ""))
- (setq n (+ n 1))
-
- (add-to-list 'org-show-slide-titles
- (cons (nth 4 (org-heading-components)) n) t)
-
- (add-to-list 'org-show-slide-list
- (cons n (set-marker (make-marker) (point))) t))))))
-
-(defun org-show-start-slideshow ()
- "Start the slide show, at the beginning"
- (interactive)
-
- (setq org-show-presentation-file (expand-file-name (buffer-name)))
- (beginning-of-buffer)
- (setq org-tags-column org-show-tags-column)
- (org-set-tags-command '(4) t)
-
- (org-show-initialize)
- ;; hide slide tags
- (save-excursion
- (while (re-search-forward ":slide:" nil t)
- (overlay-put
- (make-overlay (match-beginning 0)(match-end 0))
- 'invisible 'slide)))
- (add-to-invisibility-spec 'slide)
- (beginning-of-buffer)
- (delete-other-windows)
- (org-show-mode 1)
- (setq org-show-current-slide-number 1)
- (org-show-goto-slide 1))
-
-(defun org-show-stop-slideshow ()
- (interactive)
- ;; make slide tag visible again
- (remove-from-invisibility-spec 'slide)
-
- ;; reset latex scale
- (plist-put org-format-latex-options :scale org-show-original-latex-scale)
-
- ;; clean up temp images
- (mapcar (lambda (x)
- (let ((bname (file-name-nondirectory x)))
- (when (get-buffer bname)
- (set-buffer bname)
- (save-buffer)
- (kill-buffer bname)))
-
- (when (file-exists-p x)
- (delete-file x)))
- org-show-temp-images)
- (setq org-show-temp-images '())
-
- ;; ;; clean up miscellaneous buffers
- (when (get-buffer "*Animation*") (kill-buffer "*Animation*"))
-
- (when org-show-presentation-file (find-file org-show-presentation-file))
- (widen)
- (text-scale-set 0)
- (delete-other-windows)
- (setq org-show-presentation-file nil)
- (setq org-show-current-slide-number 1)
- (set-frame-name (if (buffer-file-name)
- (abbreviate-file-name (buffer-file-name))))
- (setq org-tags-column org-show-original-tags-column)
- (org-set-tags-command '(4) t)
-
- (org-show-mode -1))
-
-(defalias 'stop 'org-show-stop-slideshow)
-
-(defun org-show-goto-slide (n)
- "Goto slide N"
- (interactive "nSlide number: ")
- (message "Going to slide %s" n)
- (find-file org-show-presentation-file)
- (setq org-show-current-slide-number n)
- (widen)
- (goto-char (cdr (assoc n org-show-slide-list)))
- (org-show-execute-slide))
-
-(defun org-show-toc ()
- (interactive)
- (let ((links) (c-b (buffer-name)) (n))
- (save-excursion
- (widen)
- (mapcar
- (lambda (x)
- (setq n (car x))
- (goto-char (cdr x))
- (add-to-list
- 'links
- (format " [[elisp:(progn (switch-to-buffer \"%s\")(goto-char %s)(org-show-execute-slide))][%2s %s]]\n\n"
- (marker-buffer (cdr x))
- (marker-position (cdr x))
- (car x)
- (nth 4 (org-heading-components))) t))
- org-show-slide-list))
-
- (switch-to-buffer "*List of Slides*")
- (org-mode)
- (erase-buffer)
-
- (insert (mapconcat 'identity links ""))
-
- ;(setq buffer-read-only t)
- (use-local-map (copy-keymap org-mode-map))
- (local-set-key "q" #'(lambda () (interactive) (kill-buffer)))))
-
-(require 'animate)
-
-(defun org-show-animate (strings)
- "Animate STRINGS in an *Animation* buffer"
- (switch-to-buffer (get-buffer-create
- (or animation-buffer-name
- "*Animation*")))
- (erase-buffer)
- (text-scale-set 6)
- (let* ((vpos (/ (- 20
- 1 ;; For the mode-line
- (1- (length strings))
- (length strings))
- 2))
- (width 43)
- hpos)
- (while strings
- (setq hpos (/ (- width (length (car strings))) 2))
- (when (> 0 hpos) (setq hpos 0))
- (when (> 0 vpos) (setq vpos 0))
- (animate-string (car strings) vpos hpos)
- (setq vpos (1+ vpos))
- (setq strings (cdr strings)))))
-
-(defun org-show-increase-text-size (&optional arg)
- "Increase text size. Bound to \\[org-show-increase-text-size].
-
-With prefix ARG, set `org-show-text-scale' so subsquent slides are the same text size."
- (interactive "P")
- (text-scale-increase 1.5)
- (when arg
- (setq org-show-text-scale (* org-show-text-scale 1.5))))
-
-(defun org-show-decrease-text-size (&optional arg)
- "Increase text size. Bound to \\[org-show-decrease-text-size].
-
-With prefix ARG, set `org-show-text-scale' so subsquent slides are the same text size."
- (interactive "P")
- (text-scale-decrease 1.5)
- (when arg
- (setq org-show-text-scale (/ org-show-text-scale 1.5)))
-)
-
-(provide 'org-show)