Commit | Line | Data |
---|---|---|
c8d0cf5c CD |
1 | ;;; org-exp-blocks.el --- pre-process blocks when exporting org files |
2 | ||
3ab2c837 BG |
3 | ;; Copyright (C) 2009, 2010 |
4 | ;; Free Software Foundation, Inc. | |
c8d0cf5c CD |
5 | |
6 | ;; Author: Eric Schulte | |
3ab2c837 | 7 | ;; Version: 7.7 |
c8d0cf5c CD |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ;; | |
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | ;;; Commentary: | |
25 | ;; | |
26 | ;; This is a utility for pre-processing blocks in org files before | |
27 | ;; export using the `org-export-preprocess-hook'. It can be used for | |
28 | ;; exporting new types of blocks from org-mode files and also for | |
29 | ;; changing the default export behavior of existing org-mode blocks. | |
30 | ;; The `org-export-blocks' and `org-export-interblocks' variables can | |
31 | ;; be used to control how blocks and the spaces between blocks | |
32 | ;; respectively are processed upon export. | |
33 | ;; | |
34 | ;; The type of a block is defined as the string following =#+begin_=, | |
35 | ;; so for example the following block would be of type ditaa. Note | |
36 | ;; that both upper or lower case are allowed in =#+BEGIN_= and | |
37 | ;; =#+END_=. | |
38 | ;; | |
39 | ;; #+begin_ditaa blue.png -r -S | |
40 | ;; +---------+ | |
41 | ;; | cBLU | | |
42 | ;; | | | |
43 | ;; | +----+ | |
44 | ;; | |cPNK| | |
45 | ;; | | | | |
46 | ;; +----+----+ | |
47 | ;; #+end_ditaa | |
48 | ;; | |
49 | ;;; Currently Implemented Block Types | |
50 | ;; | |
3ab2c837 BG |
51 | ;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert |
52 | ;; ascii pictures to actual images using ditaa | |
c8d0cf5c CD |
53 | ;; http://ditaa.sourceforge.net/. To use this set |
54 | ;; `org-ditaa-jar-path' to the path to ditaa.jar on your | |
55 | ;; system (should be set automatically in most cases) . | |
56 | ;; | |
3ab2c837 BG |
57 | ;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert |
58 | ;; graphs defined using the dot graphing language to images | |
59 | ;; using the dot utility. For information on dot see | |
c8d0cf5c CD |
60 | ;; http://www.graphviz.org/ |
61 | ;; | |
62 | ;; comment :: Wrap comments with titles and author information, in | |
63 | ;; their own divs with author-specific ids allowing for css | |
64 | ;; coloring of comments based on the author. | |
65 | ;; | |
c8d0cf5c CD |
66 | ;;; Adding new blocks |
67 | ;; | |
68 | ;; When adding a new block type first define a formatting function | |
69 | ;; along the same lines as `org-export-blocks-format-dot' and then use | |
70 | ;; `org-export-blocks-add-block' to add your block type to | |
71 | ;; `org-export-blocks'. | |
72 | ||
86fbb8ca CD |
73 | ;;; Code: |
74 | ||
c8d0cf5c CD |
75 | (eval-when-compile |
76 | (require 'cl)) | |
77 | (require 'org) | |
78 | ||
c8d0cf5c CD |
79 | (defun org-export-blocks-set (var value) |
80 | "Set the value of `org-export-blocks' and install fontification." | |
81 | (set var value) | |
82 | (mapc (lambda (spec) | |
83 | (if (nth 2 spec) | |
84 | (setq org-protecting-blocks | |
85 | (delete (symbol-name (car spec)) | |
86 | org-protecting-blocks)) | |
87 | (add-to-list 'org-protecting-blocks | |
88 | (symbol-name (car spec))))) | |
89 | value)) | |
90 | ||
91 | (defcustom org-export-blocks | |
92 | '((comment org-export-blocks-format-comment t) | |
93 | (ditaa org-export-blocks-format-ditaa nil) | |
8bfe682a | 94 | (dot org-export-blocks-format-dot nil)) |
86fbb8ca CD |
95 | "Use this alist to associate block types with block exporting functions. |
96 | The type of a block is determined by the text immediately | |
97 | following the '#+BEGIN_' portion of the block header. Each block | |
98 | export function should accept three arguments." | |
c8d0cf5c CD |
99 | :group 'org-export-general |
100 | :type '(repeat | |
101 | (list | |
102 | (symbol :tag "Block name") | |
103 | (function :tag "Block formatter") | |
104 | (boolean :tag "Fontify content as Org syntax"))) | |
105 | :set 'org-export-blocks-set) | |
106 | ||
107 | (defun org-export-blocks-add-block (block-spec) | |
86fbb8ca CD |
108 | "Add a new block type to `org-export-blocks'. |
109 | BLOCK-SPEC should be a three element list the first element of | |
110 | which should indicate the name of the block, the second element | |
111 | should be the formatting function called by | |
112 | `org-export-blocks-preprocess' and the third element a flag | |
113 | indicating whether these types of blocks should be fontified in | |
114 | org-mode buffers (see `org-protecting-blocks'). For example the | |
115 | BLOCK-SPEC for ditaa blocks is as follows. | |
c8d0cf5c CD |
116 | |
117 | (ditaa org-export-blocks-format-ditaa nil)" | |
118 | (unless (member block-spec org-export-blocks) | |
119 | (setq org-export-blocks (cons block-spec org-export-blocks)) | |
120 | (org-export-blocks-set 'org-export-blocks org-export-blocks))) | |
121 | ||
122 | (defcustom org-export-interblocks | |
8bfe682a | 123 | '() |
86fbb8ca CD |
124 | "Use this a-list to associate block types with block exporting functions. |
125 | The type of a block is determined by the text immediately | |
126 | following the '#+BEGIN_' portion of the block header. Each block | |
127 | export function should accept three arguments." | |
c8d0cf5c CD |
128 | :group 'org-export-general |
129 | :type 'alist) | |
130 | ||
131 | (defcustom org-export-blocks-witheld | |
132 | '(hidden) | |
86fbb8ca | 133 | "List of block types (see `org-export-blocks') which should not be exported." |
c8d0cf5c CD |
134 | :group 'org-export-general |
135 | :type 'list) | |
136 | ||
86fbb8ca CD |
137 | (defcustom org-export-blocks-postblock-hook nil |
138 | "Run after blocks have been processed with `org-export-blocks-preprocess'." | |
139 | :group 'org-export-general | |
140 | :type 'hook) | |
c8d0cf5c CD |
141 | |
142 | (defun org-export-blocks-html-quote (body &optional open close) | |
86fbb8ca CD |
143 | "Protect BODY from org html export. |
144 | The optional OPEN and CLOSE tags will be inserted around BODY." | |
145 | ||
c8d0cf5c CD |
146 | (concat |
147 | "\n#+BEGIN_HTML\n" | |
148 | (or open "") | |
149 | body (if (string-match "\n$" body) "" "\n") | |
150 | (or close "") | |
151 | "#+END_HTML\n")) | |
152 | ||
153 | (defun org-export-blocks-latex-quote (body &optional open close) | |
86fbb8ca CD |
154 | "Protect BODY from org latex export. |
155 | The optional OPEN and CLOSE tags will be inserted around BODY." | |
c8d0cf5c CD |
156 | (concat |
157 | "\n#+BEGIN_LaTeX\n" | |
158 | (or open "") | |
159 | body (if (string-match "\n$" body) "" "\n") | |
160 | (or close "") | |
161 | "#+END_LaTeX\n")) | |
162 | ||
163 | (defun org-export-blocks-preprocess () | |
86fbb8ca CD |
164 | "Export all blocks according to the `org-export-blocks' block export alist. |
165 | Does not export block types specified in specified in BLOCKS | |
166 | which defaults to the value of `org-export-blocks-witheld'." | |
c8d0cf5c CD |
167 | (interactive) |
168 | (save-window-excursion | |
8bfe682a | 169 | (let ((case-fold-search t) |
c8d0cf5c | 170 | (types '()) |
3ab2c837 BG |
171 | matched indentation type func |
172 | start end body headers preserve-indent progress-marker) | |
8bfe682a CD |
173 | (flet ((interblock (start end) |
174 | (mapcar (lambda (pair) (funcall (second pair) start end)) | |
175 | org-export-interblocks))) | |
c8d0cf5c | 176 | (goto-char (point-min)) |
8bfe682a | 177 | (setq start (point)) |
3ab2c837 BG |
178 | (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) |
179 | (while (re-search-forward beg-re nil t) | |
180 | (let* ((match-start (match-beginning 0)) | |
181 | (body-start (match-end 0)) | |
182 | (indentation (length (match-string 1))) | |
183 | (inner-re (format "[\r\n]*[ \t]*#\\+\\(begin\\|end\\)_%s" | |
184 | (regexp-quote (downcase (match-string 2))))) | |
185 | (type (intern (downcase (match-string 2)))) | |
186 | (headers (save-match-data | |
187 | (org-split-string (match-string 3) "[ \t]+"))) | |
188 | (balanced 1) | |
189 | (preserve-indent (or org-src-preserve-indentation | |
190 | (member "-i" headers))) | |
191 | match-end) | |
192 | (while (and (not (zerop balanced)) | |
193 | (re-search-forward inner-re nil t)) | |
194 | (if (string= (downcase (match-string 1)) "end") | |
195 | (decf balanced) | |
196 | (incf balanced))) | |
197 | (when (not (zerop balanced)) | |
198 | (error "unbalanced begin/end_%s blocks with %S" | |
199 | type (buffer-substring match-start (point)))) | |
200 | (setq match-end (match-end 0)) | |
201 | (unless preserve-indent | |
202 | (setq body (save-match-data (org-remove-indentation | |
203 | (buffer-substring | |
204 | body-start (match-beginning 0)))))) | |
205 | (unless (memq type types) (setq types (cons type types))) | |
206 | (save-match-data (interblock start match-start)) | |
207 | (when (setq func (cadr (assoc type org-export-blocks))) | |
208 | (let ((replacement (save-match-data | |
209 | (if (memq type org-export-blocks-witheld) "" | |
210 | (apply func body headers))))) | |
211 | (when replacement | |
212 | (delete-region match-start match-end) | |
213 | (goto-char match-start) (insert replacement) | |
214 | (unless preserve-indent | |
215 | (indent-code-rigidly match-start (point) indentation)))))) | |
216 | (setq start (point)))) | |
86fbb8ca CD |
217 | (interblock start (point-max)) |
218 | (run-hooks 'org-export-blocks-postblock-hook))))) | |
c8d0cf5c | 219 | |
c8d0cf5c CD |
220 | ;;================================================================================ |
221 | ;; type specific functions | |
222 | ||
223 | ;;-------------------------------------------------------------------------------- | |
224 | ;; ditaa: create images from ASCII art using the ditaa utility | |
225 | (defvar org-ditaa-jar-path (expand-file-name | |
226 | "ditaa.jar" | |
227 | (file-name-as-directory | |
228 | (expand-file-name | |
229 | "scripts" | |
230 | (file-name-as-directory | |
231 | (expand-file-name | |
232 | "../contrib" | |
233 | (file-name-directory (or load-file-name buffer-file-name))))))) | |
86fbb8ca | 234 | "Path to the ditaa jar executable.") |
c8d0cf5c | 235 | |
3ab2c837 | 236 | (defvar org-export-current-backend) ; dynamically bound in org-exp.el |
c8d0cf5c | 237 | (defun org-export-blocks-format-ditaa (body &rest headers) |
3ab2c837 BG |
238 | "DEPRECATED: use begin_src ditaa code blocks |
239 | ||
240 | Pass block BODY to the ditaa utility creating an image. | |
c8d0cf5c CD |
241 | Specify the path at which the image should be saved as the first |
242 | element of headers, any additional elements of headers will be | |
243 | passed to the ditaa utility as command line arguments." | |
3ab2c837 | 244 | (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks") |
5dec9555 CD |
245 | (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) |
246 | (data-file (make-temp-file "org-ditaa")) | |
86fbb8ca CD |
247 | (hash (progn |
248 | (set-text-properties 0 (length body) nil body) | |
249 | (sha1 (prin1-to-string (list body args))))) | |
250 | (raw-out-file (if headers (car headers))) | |
251 | (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) | |
252 | (cons (match-string 1 raw-out-file) | |
253 | (match-string 2 raw-out-file)) | |
254 | (cons raw-out-file "png"))) | |
255 | (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) | |
c8d0cf5c CD |
256 | (unless (file-exists-p org-ditaa-jar-path) |
257 | (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) | |
258 | (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) | |
259 | body | |
260 | (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) | |
261 | (org-split-string body "\n") | |
262 | "\n"))) | |
3ab2c837 | 263 | (prog1 |
c8d0cf5c | 264 | (cond |
3ab2c837 | 265 | ((member org-export-current-backend '(html latex docbook)) |
5dec9555 CD |
266 | (unless (file-exists-p out-file) |
267 | (mapc ;; remove old hashed versions of this file | |
268 | (lambda (file) | |
269 | (when (and (string-match (concat (regexp-quote (car out-file-parts)) | |
270 | "_\\([[:alnum:]]+\\)\\." | |
271 | (regexp-quote (cdr out-file-parts))) | |
272 | file) | |
273 | (= (length (match-string 1 out-file)) 40)) | |
274 | (delete-file (expand-file-name file | |
275 | (file-name-directory out-file))))) | |
276 | (directory-files (or (file-name-directory out-file) | |
277 | default-directory))) | |
278 | (with-temp-file data-file (insert body)) | |
279 | (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) | |
280 | (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) | |
c8d0cf5c CD |
281 | (format "\n[[file:%s]]\n" out-file)) |
282 | (t (concat | |
283 | "\n#+BEGIN_EXAMPLE\n" | |
284 | body (if (string-match "\n$" body) "" "\n") | |
3ab2c837 BG |
285 | "#+END_EXAMPLE\n"))) |
286 | (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) | |
c8d0cf5c CD |
287 | |
288 | ;;-------------------------------------------------------------------------------- | |
289 | ;; dot: create graphs using the dot graphing language | |
290 | ;; (require the dot executable to be in your path) | |
291 | (defun org-export-blocks-format-dot (body &rest headers) | |
3ab2c837 BG |
292 | "DEPRECATED: use \"#+begin_src dot\" code blocks |
293 | ||
294 | Pass block BODY to the dot graphing utility creating an image. | |
c8d0cf5c CD |
295 | Specify the path at which the image should be saved as the first |
296 | element of headers, any additional elements of headers will be | |
297 | passed to the dot utility as command line arguments. Don't | |
298 | forget to specify the output type for the dot command, so if you | |
299 | are exporting to a file with a name like 'image.png' you should | |
300 | include a '-Tpng' argument, and your block should look like the | |
301 | following. | |
302 | ||
303 | #+begin_dot models.png -Tpng | |
304 | digraph data_relationships { | |
305 | \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] | |
306 | \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] | |
307 | \"data_requirement\" -> \"data_product\" | |
308 | } | |
309 | #+end_dot" | |
3ab2c837 | 310 | (message "begin_dot blocks are DEPRECATED, use begin_src blocks") |
5dec9555 CD |
311 | (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) |
312 | (data-file (make-temp-file "org-ditaa")) | |
86fbb8ca CD |
313 | (hash (progn |
314 | (set-text-properties 0 (length body) nil body) | |
315 | (sha1 (prin1-to-string (list body args))))) | |
316 | (raw-out-file (if headers (car headers))) | |
317 | (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) | |
318 | (cons (match-string 1 raw-out-file) | |
319 | (match-string 2 raw-out-file)) | |
320 | (cons raw-out-file "png"))) | |
321 | (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) | |
3ab2c837 | 322 | (prog1 |
c8d0cf5c | 323 | (cond |
3ab2c837 | 324 | ((member org-export-current-backend '(html latex docbook)) |
5dec9555 | 325 | (unless (file-exists-p out-file) |
3ab2c837 BG |
326 | (mapc ;; remove old hashed versions of this file |
327 | (lambda (file) | |
328 | (when (and (string-match (concat (regexp-quote (car out-file-parts)) | |
329 | "_\\([[:alnum:]]+\\)\\." | |
330 | (regexp-quote (cdr out-file-parts))) | |
331 | file) | |
332 | (= (length (match-string 1 out-file)) 40)) | |
333 | (delete-file (expand-file-name file | |
334 | (file-name-directory out-file))))) | |
335 | (directory-files (or (file-name-directory out-file) | |
336 | default-directory))) | |
337 | (with-temp-file data-file (insert body)) | |
338 | (message (concat "dot " data-file " " args " -o " out-file)) | |
339 | (shell-command (concat "dot " data-file " " args " -o " out-file))) | |
c8d0cf5c CD |
340 | (format "\n[[file:%s]]\n" out-file)) |
341 | (t (concat | |
342 | "\n#+BEGIN_EXAMPLE\n" | |
343 | body (if (string-match "\n$" body) "" "\n") | |
3ab2c837 BG |
344 | "#+END_EXAMPLE\n"))) |
345 | (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) | |
c8d0cf5c CD |
346 | |
347 | ;;-------------------------------------------------------------------------------- | |
348 | ;; comment: export comments in author-specific css-stylable divs | |
349 | (defun org-export-blocks-format-comment (body &rest headers) | |
350 | "Format comment BODY by OWNER and return it formatted for export. | |
351 | Currently, this only does something for HTML export, for all | |
352 | other backends, it converts the comment into an EXAMPLE segment." | |
353 | (let ((owner (if headers (car headers))) | |
354 | (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) | |
355 | (cond | |
3ab2c837 | 356 | ((eq org-export-current-backend 'html) ;; We are exporting to HTML |
c8d0cf5c CD |
357 | (concat "#+BEGIN_HTML\n" |
358 | "<div class=\"org-comment\"" | |
359 | (if owner (format " id=\"org-comment-%s\" " owner)) | |
360 | ">\n" | |
361 | (if owner (concat "<b>" owner "</b> ") "") | |
3ab2c837 | 362 | (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n") |
c8d0cf5c CD |
363 | "<p>\n" |
364 | "#+END_HTML\n" | |
365 | body | |
3ab2c837 | 366 | "\n#+BEGIN_HTML\n" |
c8d0cf5c CD |
367 | "</p>\n" |
368 | "</div>\n" | |
369 | "#+END_HTML\n")) | |
370 | (t ;; This is not HTML, so just make it an example. | |
371 | (concat "#+BEGIN_EXAMPLE\n" | |
372 | (if title (concat "Title:" title "\n") "") | |
373 | (if owner (concat "By:" owner "\n") "") | |
374 | body | |
375 | (if (string-match "\n\\'" body) "" "\n") | |
376 | "#+END_EXAMPLE\n"))))) | |
377 | ||
c8d0cf5c CD |
378 | (provide 'org-exp-blocks) |
379 | ||
5b409b39 | 380 | |
c8d0cf5c | 381 | ;;; org-exp-blocks.el ends here |