summaryrefslogtreecommitdiff
path: root/lisp/org-exp-blocks.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
commit7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch)
tree24d0f1d2a9751ca8c063409fd2ab71478b296efb /lisp/org-exp-blocks.el
Imported Upstream version 7.9.2
Diffstat (limited to 'lisp/org-exp-blocks.el')
-rw-r--r--lisp/org-exp-blocks.el402
1 files changed, 402 insertions, 0 deletions
diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el
new file mode 100644
index 0000000..89a0e5e
--- /dev/null
+++ b/lisp/org-exp-blocks.el
@@ -0,0 +1,402 @@
+;;; org-exp-blocks.el --- pre-process blocks when exporting org files
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This is a utility for pre-processing blocks in org files before
+;; export using the `org-export-preprocess-hook'. It can be used for
+;; exporting new types of blocks from org-mode files and also for
+;; changing the default export behavior of existing org-mode blocks.
+;; The `org-export-blocks' and `org-export-interblocks' variables can
+;; be used to control how blocks and the spaces between blocks
+;; respectively are processed upon export.
+;;
+;; The type of a block is defined as the string following =#+begin_=,
+;; so for example the following block would be of type ditaa. Note
+;; that both upper or lower case are allowed in =#+BEGIN_= and
+;; =#+END_=.
+;;
+;; #+begin_ditaa blue.png -r -S
+;; +---------+
+;; | cBLU |
+;; | |
+;; | +----+
+;; | |cPNK|
+;; | | |
+;; +----+----+
+;; #+end_ditaa
+;;
+;;; Currently Implemented Block Types
+;;
+;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
+;; ascii pictures to actual images using ditaa
+;; http://ditaa.sourceforge.net/. To use this set
+;; `org-ditaa-jar-path' to the path to ditaa.jar on your
+;; system (should be set automatically in most cases) .
+;;
+;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
+;; graphs defined using the dot graphing language to images
+;; using the dot utility. For information on dot see
+;; http://www.graphviz.org/
+;;
+;; export-comment :: Wrap comments with titles and author information,
+;; in their own divs with author-specific ids allowing for
+;; css coloring of comments based on the author.
+;;
+;;; Adding new blocks
+;;
+;; When adding a new block type first define a formatting function
+;; along the same lines as `org-export-blocks-format-dot' and then use
+;; `org-export-blocks-add-block' to add your block type to
+;; `org-export-blocks'.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'find-func)
+(require 'org-compat)
+
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-remove-indentation "org" (code &optional n))
+
+(defvar org-protecting-blocks nil) ; From org.el
+
+(defun org-export-blocks-set (var value)
+ "Set the value of `org-export-blocks' and install fontification."
+ (set var value)
+ (mapc (lambda (spec)
+ (if (nth 2 spec)
+ (setq org-protecting-blocks
+ (delete (symbol-name (car spec))
+ org-protecting-blocks))
+ (add-to-list 'org-protecting-blocks
+ (symbol-name (car spec)))))
+ value))
+
+(defcustom org-export-blocks
+ '((export-comment org-export-blocks-format-comment t)
+ (ditaa org-export-blocks-format-ditaa nil)
+ (dot org-export-blocks-format-dot nil))
+ "Use this alist to associate block types with block exporting functions.
+The type of a block is determined by the text immediately
+following the '#+BEGIN_' portion of the block header. Each block
+export function should accept three arguments."
+ :group 'org-export-general
+ :type '(repeat
+ (list
+ (symbol :tag "Block name")
+ (function :tag "Block formatter")
+ (boolean :tag "Fontify content as Org syntax")))
+ :set 'org-export-blocks-set)
+
+(defun org-export-blocks-add-block (block-spec)
+ "Add a new block type to `org-export-blocks'.
+BLOCK-SPEC should be a three element list the first element of
+which should indicate the name of the block, the second element
+should be the formatting function called by
+`org-export-blocks-preprocess' and the third element a flag
+indicating whether these types of blocks should be fontified in
+org-mode buffers (see `org-protecting-blocks'). For example the
+BLOCK-SPEC for ditaa blocks is as follows.
+
+ (ditaa org-export-blocks-format-ditaa nil)"
+ (unless (member block-spec org-export-blocks)
+ (setq org-export-blocks (cons block-spec org-export-blocks))
+ (org-export-blocks-set 'org-export-blocks org-export-blocks)))
+
+(defcustom org-export-interblocks
+ '()
+ "Use this a-list to associate block types with block exporting functions.
+The type of a block is determined by the text immediately
+following the '#+BEGIN_' portion of the block header. Each block
+export function should accept three arguments."
+ :group 'org-export-general
+ :type 'alist)
+
+(defcustom org-export-blocks-witheld
+ '(hidden)
+ "List of block types (see `org-export-blocks') which should not be exported."
+ :group 'org-export-general
+ :type 'list)
+
+(defcustom org-export-blocks-postblock-hook nil
+ "Run after blocks have been processed with `org-export-blocks-preprocess'."
+ :group 'org-export-general
+ :version "24.1"
+ :type 'hook)
+
+(defun org-export-blocks-html-quote (body &optional open close)
+ "Protect BODY from org html export.
+The optional OPEN and CLOSE tags will be inserted around BODY."
+ (concat
+ "\n#+BEGIN_HTML\n"
+ (or open "")
+ body (if (string-match "\n$" body) "" "\n")
+ (or close "")
+ "#+END_HTML\n"))
+
+(defun org-export-blocks-latex-quote (body &optional open close)
+ "Protect BODY from org latex export.
+The optional OPEN and CLOSE tags will be inserted around BODY."
+ (concat
+ "\n#+BEGIN_LaTeX\n"
+ (or open "")
+ body (if (string-match "\n$" body) "" "\n")
+ (or close "")
+ "#+END_LaTeX\n"))
+
+(defvar org-src-preserve-indentation) ; From org-src.el
+(defun org-export-blocks-preprocess ()
+ "Export all blocks according to the `org-export-blocks' block export alist.
+Does not export block types specified in specified in BLOCKS
+which defaults to the value of `org-export-blocks-witheld'."
+ (interactive)
+ (save-window-excursion
+ (let ((case-fold-search t)
+ (interblock (lambda (start end)
+ (mapcar (lambda (pair) (funcall (second pair) start end))
+ org-export-interblocks)))
+ matched indentation type types func
+ start end body headers preserve-indent progress-marker)
+ (goto-char (point-min))
+ (setq start (point))
+ (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
+ (while (re-search-forward beg-re nil t)
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (body-start (copy-marker (match-end 0)))
+ (indentation (length (match-string 1)))
+ (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
+ (regexp-quote (downcase (match-string 2)))))
+ (type (intern (downcase (match-string 2))))
+ (headers (save-match-data
+ (org-split-string (match-string 3) "[ \t]+")))
+ (balanced 1)
+ (preserve-indent (or org-src-preserve-indentation
+ (member "-i" headers)))
+ match-end)
+ (while (and (not (zerop balanced))
+ (re-search-forward inner-re nil t))
+ (if (string= (downcase (match-string 1)) "end")
+ (decf balanced)
+ (incf balanced)))
+ (when (not (zerop balanced))
+ (error "Unbalanced begin/end_%s blocks with %S"
+ type (buffer-substring match-start (point))))
+ (setq match-end (copy-marker (match-end 0)))
+ (unless preserve-indent
+ (setq body (save-match-data (org-remove-indentation
+ (buffer-substring
+ body-start (match-beginning 0))))))
+ (unless (memq type types) (setq types (cons type types)))
+ (save-match-data (funcall interblock start match-start))
+ (when (setq func (cadr (assoc type org-export-blocks)))
+ (let ((replacement (save-match-data
+ (if (memq type org-export-blocks-witheld) ""
+ (apply func body headers)))))
+ ;; ;; un-comment this code after the org-element merge
+ ;; (save-match-data
+ ;; (when (and replacement (string= replacement ""))
+ ;; (delete-region
+ ;; (car (org-element-collect-affiliated-keyword))
+ ;; match-start)))
+ (when replacement
+ (delete-region match-start match-end)
+ (goto-char match-start) (insert replacement)
+ (if preserve-indent
+ ;; indent only the code block markers
+ (save-excursion
+ (indent-line-to indentation) ; indent end_block
+ (goto-char match-start)
+ (indent-line-to indentation)) ; indent begin_block
+ ;; indent everything
+ (indent-code-rigidly match-start (point) indentation)))))
+ ;; cleanup markers
+ (set-marker match-start nil)
+ (set-marker body-start nil)
+ (set-marker match-end nil))
+ (setq start (point))))
+ (funcall interblock start (point-max))
+ (run-hooks 'org-export-blocks-postblock-hook))))
+
+;;================================================================================
+;; type specific functions
+
+;;--------------------------------------------------------------------------------
+;; ditaa: create images from ASCII art using the ditaa utility
+(defcustom org-ditaa-jar-path (expand-file-name
+ "ditaa.jar"
+ (file-name-as-directory
+ (expand-file-name
+ "scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../contrib"
+ (file-name-directory (org-find-library-dir "org")))))))
+ "Path to the ditaa jar executable."
+ :group 'org-babel
+ :type 'string)
+
+(defvar org-export-current-backend) ; dynamically bound in org-exp.el
+(defun org-export-blocks-format-ditaa (body &rest headers)
+ "DEPRECATED: use begin_src ditaa code blocks
+
+Pass block BODY to the ditaa utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the ditaa utility as command line arguments."
+ (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
+ (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+ (data-file (make-temp-file "org-ditaa"))
+ (hash (progn
+ (set-text-properties 0 (length body) nil body)
+ (sha1 (prin1-to-string (list body args)))))
+ (raw-out-file (if headers (car headers)))
+ (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
+ (cons (match-string 1 raw-out-file)
+ (match-string 2 raw-out-file))
+ (cons raw-out-file "png")))
+ (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
+ (unless (file-exists-p org-ditaa-jar-path)
+ (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
+ (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
+ body
+ (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
+ (org-split-string body "\n")
+ "\n")))
+ (prog1
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
+ (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
+
+;;--------------------------------------------------------------------------------
+;; dot: create graphs using the dot graphing language
+;; (require the dot executable to be in your path)
+(defun org-export-blocks-format-dot (body &rest headers)
+ "DEPRECATED: use \"#+begin_src dot\" code blocks
+
+Pass block BODY to the dot graphing utility creating an image.
+Specify the path at which the image should be saved as the first
+element of headers, any additional elements of headers will be
+passed to the dot utility as command line arguments. Don't
+forget to specify the output type for the dot command, so if you
+are exporting to a file with a name like 'image.png' you should
+include a '-Tpng' argument, and your block should look like the
+following.
+
+#+begin_dot models.png -Tpng
+digraph data_relationships {
+ \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
+ \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
+ \"data_requirement\" -> \"data_product\"
+}
+#+end_dot"
+ (message "begin_dot blocks are DEPRECATED, use begin_src blocks")
+ (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
+ (data-file (make-temp-file "org-ditaa"))
+ (hash (progn
+ (set-text-properties 0 (length body) nil body)
+ (sha1 (prin1-to-string (list body args)))))
+ (raw-out-file (if headers (car headers)))
+ (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
+ (cons (match-string 1 raw-out-file)
+ (match-string 2 raw-out-file))
+ (cons raw-out-file "png")))
+ (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
+ (prog1
+ (cond
+ ((member org-export-current-backend '(html latex docbook))
+ (unless (file-exists-p out-file)
+ (mapc ;; remove old hashed versions of this file
+ (lambda (file)
+ (when (and (string-match (concat (regexp-quote (car out-file-parts))
+ "_\\([[:alnum:]]+\\)\\."
+ (regexp-quote (cdr out-file-parts)))
+ file)
+ (= (length (match-string 1 out-file)) 40))
+ (delete-file (expand-file-name file
+ (file-name-directory out-file)))))
+ (directory-files (or (file-name-directory out-file)
+ default-directory)))
+ (with-temp-file data-file (insert body))
+ (message (concat "dot " data-file " " args " -o " out-file))
+ (shell-command (concat "dot " data-file " " args " -o " out-file)))
+ (format "\n[[file:%s]]\n" out-file))
+ (t (concat
+ "\n#+BEGIN_EXAMPLE\n"
+ body (if (string-match "\n$" body) "" "\n")
+ "#+END_EXAMPLE\n")))
+ (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
+
+;;--------------------------------------------------------------------------------
+;; comment: export comments in author-specific css-stylable divs
+(defun org-export-blocks-format-comment (body &rest headers)
+ "Format comment BODY by OWNER and return it formatted for export.
+Currently, this only does something for HTML export, for all
+other backends, it converts the comment into an EXAMPLE segment."
+ (let ((owner (if headers (car headers)))
+ (title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
+ (cond
+ ((eq org-export-current-backend 'html) ;; We are exporting to HTML
+ (concat "#+BEGIN_HTML\n"
+ "<div class=\"org-comment\""
+ (if owner (format " id=\"org-comment-%s\" " owner))
+ ">\n"
+ (if owner (concat "<b>" owner "</b> ") "")
+ (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
+ "<p>\n"
+ "#+END_HTML\n"
+ body
+ "\n#+BEGIN_HTML\n"
+ "</p>\n"
+ "</div>\n"
+ "#+END_HTML\n"))
+ (t ;; This is not HTML, so just make it an example.
+ (concat "#+BEGIN_EXAMPLE\n"
+ (if title (concat "Title:" title "\n") "")
+ (if owner (concat "By:" owner "\n") "")
+ body
+ (if (string-match "\n\\'" body) "" "\n")
+ "#+END_EXAMPLE\n")))))
+
+(provide 'org-exp-blocks)
+
+;;; org-exp-blocks.el ends here