1 ;;; org-exp-blocks.el --- pre-process blocks when exporting org files
3 ;; Copyright (C) 2008 Eric Schulte
5 ;; Author: Eric Schulte
7 ;; This file is not currently part of GNU Emacs.
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.
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.
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.
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.
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
39 ;; #+begin_ditaa blue.png -r -S
49 ;;; Currently Implemented Block Types
51 ;; ditaa :: Convert ascii pictures to actual images using ditaa
52 ;; http://ditaa.sourceforge.net/. To use this set
53 ;; `org-ditaa-jar-path' to the path to ditaa.jar on your
54 ;; system (should be set automatically in most cases) .
56 ;; dot :: Convert graphs defined using the dot graphing language to
57 ;; images using the dot utility. For information on dot see
58 ;; http://www.graphviz.org/
60 ;; comment :: Wrap comments with titles and author information, in
61 ;; their own divs with author-specific ids allowing for css
62 ;; coloring of comments based on the author.
64 ;; R :: Implements Sweave type exporting, evaluates blocks of R code,
65 ;; and also replaces \R{} chunks in the file with their result
66 ;; when passed to R. This require the `R' command which is
67 ;; provided by ESS (Emacs Speaks Statistics).
71 ;; When adding a new block type first define a formatting function
72 ;; along the same lines as `org-export-blocks-format-dot' and then use
73 ;; `org-export-blocks-add-block' to add your block type to
74 ;; `org-export-blocks'.
78 (defun org-exp-blocks-set (var value
)
79 "Set the value of `org-export-blocks' and install fontification."
83 (setq org-protecting-blocks
84 (delete (symbol-name (car spec
))
85 org-protecting-blocks
))
86 (add-to-list 'org-protecting-blocks
87 (symbol-name (car spec
)))))
90 (defun org-export-blocks-add-block (block-spec)
91 "Add a new block type to `org-export-blocks'. BLOCK-SPEC
92 should be a three element list the first element of which should
93 indicate the name of the block, the second element should be the
94 formatting function called by `org-export-blocks-preprocess' and
95 the third element a flag indicating whether these types of blocks
96 should be fontified in org-mode buffers (see
97 `org-protecting-blocks'). For example the BLOCK-SPEC for ditaa
98 blocks is as follows...
100 (ditaa org-export-blocks-format-ditaa nil)"
101 (unless (member block-spec org-export-blocks
)
102 (setq org-export-blocks
(cons block-spec org-export-blocks
))
103 (org-export-blocks-set 'org-export-blocks
)))
105 (defcustom org-export-blocks
106 '((comment org-export-blocks-format-comment t
)
107 (ditaa org-export-blocks-format-ditaa nil
)
108 (dot org-export-blocks-format-dot nil
)
109 (r org-export-blocks-format-R nil
)
110 (R org-export-blocks-format-R nil
))
111 "Use this a-list to associate block types with block exporting
112 functions. The type of a block is determined by the text
113 immediately following the '#+BEGIN_' portion of the block header.
114 Each block export function should accept three argumets..."
115 :group
'org-export-general
118 (symbol :tag
"Block name")
119 (function :tag
"Block formatter")
120 (boolean :tag
"Fontify content as Org syntax")))
121 :set
'org-exp-blocks-set
)
123 (defcustom org-export-interblocks
124 '((r org-export-interblocks-format-R
)
125 (R org-export-interblocks-format-R
))
126 "Use this a-list to associate block types with block exporting
127 functions. The type of a block is determined by the text
128 immediately following the '#+BEGIN_' portion of the block header.
129 Each block export function should accept three argumets..."
130 :group
'org-export-general
133 (defcustom org-export-blocks-witheld
135 "List of block types (see `org-export-blocks') which should not
137 :group
'org-export-general
140 (defvar org-export-blocks-postblock-hooks nil
"")
142 (defun org-export-blocks-html-quote (body &optional open close
)
143 "Protext BODY from org html export. The optional OPEN and
144 CLOSE tags will be inserted around BODY."
148 body
(if (string-match "\n$" body
) "" "\n")
152 (defun org-export-blocks-latex-quote (body &optional open close
)
153 "Protext BODY from org latex export. The optional OPEN and
154 CLOSE tags will be inserted around BODY."
158 body
(if (string-match "\n$" body
) "" "\n")
162 (defun org-export-blocks-preprocess ()
163 "Export all blocks acording to the `org-export-blocks' block
164 exportation alist. Does not export block types specified in
165 specified in BLOCKS which default to the value of
166 `org-export-blocks-witheld'."
168 (save-window-excursion
170 (blocks org-export-blocks-witheld
)
174 (flet ((interblock (start end type
)
176 (when (setf func
(cadr (assoc type org-export-interblocks
)))
177 (funcall func start end
)))))
178 (goto-char (point-min))
180 (while (re-search-forward
181 "^#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)#\\+end_\\S-+.*" nil t
)
182 (save-match-data (setf type
(intern (match-string 1))))
183 (unless (memq type types
) (setf types
(cons type types
)))
184 (setf end
(save-match-data (match-beginning 0)))
185 (interblock start end type
)
186 (if (setf func
(cadr (assoc type org-export-blocks
)))
187 (replace-match (save-match-data
188 (if (memq type blocks
)
190 (apply func
(match-string 3) (split-string (match-string 2) " ")))) t t
))
191 (setf start
(save-match-data (match-end 0))))
192 (mapcar (lambda (type)
193 (interblock start
(point-max) type
))
196 (add-hook 'org-export-preprocess-hook
'org-export-blocks-preprocess
)
198 ;;================================================================================
199 ;; type specific functions
201 ;;--------------------------------------------------------------------------------
202 ;; ditaa: create images from ASCII art using the ditaa utility
203 (defvar org-ditaa-jar-path
(expand-file-name
205 (file-name-as-directory
208 (file-name-as-directory
211 (file-name-directory (or load-file-name buffer-file-name
)))))))
212 "Path to the ditaa jar executable")
214 (defun org-export-blocks-format-ditaa (body &rest headers
)
215 "Pass block BODY to the ditaa utility creating an image.
216 Specify the path at which the image should be saved as the first
217 element of headers, any additional elements of headers will be
218 passed to the ditaa utility as command line arguments."
219 (message "ditaa-formatting...")
220 (let ((out-file (if headers
(car headers
)))
221 (args (if (cdr headers
) (mapconcat 'identity
(cdr headers
) " ")))
222 (data-file (make-temp-file "org-ditaa")))
223 (unless (file-exists-p org-ditaa-jar-path
)
224 (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path
)))
225 (setq body
(if (string-match "^\\([^:\\|:[^ ]\\)" body
)
227 (mapconcat (lambda (x) (substring x
(if (> (length x
) 1) 2 1)))
228 (org-split-string body
"\n")
231 ((or htmlp latexp docbookp
)
232 (with-temp-file data-file
(insert body
))
233 (message (concat "java -jar " org-ditaa-jar-path
" " args
" " data-file
" " out-file
))
234 (shell-command (concat "java -jar " org-ditaa-jar-path
" " args
" " data-file
" " out-file
))
235 (format "\n[[file:%s]]\n" out-file
))
237 "\n#+BEGIN_EXAMPLE\n"
238 body
(if (string-match "\n$" body
) "" "\n")
239 "#+END_EXAMPLE\n")))))
241 ;;--------------------------------------------------------------------------------
242 ;; dot: create graphs using the dot graphing language
243 ;; (require the dot executable to be in your path)
244 (defun org-export-blocks-format-dot (body &rest headers
)
245 "Pass block BODY to the dot graphing utility creating an image.
246 Specify the path at which the image should be saved as the first
247 element of headers, any additional elements of headers will be
248 passed to the dot utility as command line arguments. Don't
249 forget to specify the output type for the dot command, so if you
250 are exporting to a file with a name like 'image.png' you should
251 include a '-Tpng' argument, and your block should look like the
254 #+begin_dot models.png -Tpng
255 digraph data_relationships {
256 \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
257 \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
258 \"data_requirement\" -> \"data_product\"
261 (message "dot-formatting...")
262 (let ((out-file (if headers
(car headers
)))
263 (args (if (cdr headers
) (mapconcat 'identity
(cdr headers
) " ")))
264 (data-file (make-temp-file "org-ditaa")))
266 ((or htmlp latexp docbookp
)
267 (with-temp-file data-file
(insert body
))
268 (message (concat "dot " data-file
" " args
" -o " out-file
))
269 (shell-command (concat "dot " data-file
" " args
" -o " out-file
))
270 (format "\n[[file:%s]]\n" out-file
))
272 "\n#+BEGIN_EXAMPLE\n"
273 body
(if (string-match "\n$" body
) "" "\n")
274 "#+END_EXAMPLE\n")))))
276 ;;--------------------------------------------------------------------------------
277 ;; comment: export comments in author-specific css-stylable divs
278 (defun org-export-blocks-format-comment (body &rest headers
)
279 "Format comment BODY by OWNER and return it formatted for export.
280 Currently, this only does something for HTML export, for all
281 other backends, it converts the comment into an EXAMPLE segment."
282 (let ((owner (if headers
(car headers
)))
283 (title (if (cdr headers
) (mapconcat 'identity
(cdr headers
) " "))))
285 (htmlp ;; We are exporting to HTML
286 (concat "#+BEGIN_HTML\n"
287 "<div class=\"org-comment\""
288 (if owner
(format " id=\"org-comment-%s\" " owner
))
290 (if owner
(concat "<b>" owner
"</b> ") "")
291 (if (and title
(> (length title
) 0)) (concat " -- " title
"</br>\n") "</br>\n")
299 (t ;; This is not HTML, so just make it an example.
300 (concat "#+BEGIN_EXAMPLE\n"
301 (if title
(concat "Title:" title
"\n") "")
302 (if owner
(concat "By:" owner
"\n") "")
304 (if (string-match "\n\\'" body
) "" "\n")
305 "#+END_EXAMPLE\n")))))
307 ;;--------------------------------------------------------------------------------
308 ;; R: Sweave-type functionality
309 (defvar interblock-R-buffer nil
310 "Holds the buffer for the current R process")
312 (defun org-export-blocks-format-R (body &rest headers
)
313 "Process R blocks and replace \R{} forms outside the blocks
314 with their values as determined by R."
316 (message "R processing...")
317 (let ((image-path (or (and (car headers
)
318 (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers
))
319 (match-string 1 (car headers
)))
320 (and (> (length (car headers
)) 0)
322 ;; create the default filename
323 (format "Rplot-%03d" count
)))
324 (plot (string-match "plot" body
))
326 (setf count
(+ count
1))
327 (interblock-initiate-R-buffer)
328 (setf R-proc
(get-buffer-process interblock-R-buffer
))
329 ;; send strings to the ESS process using `comint-send-string'
330 (setf body
(mapconcat (lambda (line)
331 (interblock-R-input-command line
) (concat "> " line
))
332 (butlast (split-string body
"[\r\n]"))
334 ;; if there is a plot command, then create the images
336 (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path
)))
338 (htmlp (org-export-blocks-html-quote body
339 (format "<div id=\"R-%d\">\n<pre>\n" count
)
341 (latexp (org-export-blocks-latex-quote body
342 "\\begin{Schunk}\n\\begin{Sinput}\n"
343 "\\end{Sinput}\n\\end{Schunk}\n"))
344 (t (insert ;; default export
345 "#+begin_R " (mapconcat 'identity headers
" ") "\n"
346 body
(if (string-match "\n$" body
) "" "\n")
349 (format "[[file:%s.eps]]\n" image-path
)
352 (defun org-export-interblocks-format-R (start end
)
353 "This is run over parts of the org-file which are between R
354 blocks. It's main use is to expand the \R{stuff} chunks for
358 (interblock-initiate-R-buffer)
359 (let (code replacement
)
360 (while (and (< (point) end
) (re-search-forward "\\\\R{\\(.*\\)}" end t
))
361 (save-match-data (setf code
(match-string 1)))
362 (setf replacement
(interblock-R-command-to-string code
))
363 (setf replacement
(cond
367 (setf end
(+ end
(- (length replacement
) (length code
))))
368 (replace-match replacement t t
)))))
370 (defun interblock-initiate-R-buffer ()
371 "If there is not a current R process then create one."
372 (unless (and (buffer-live-p interblock-R-buffer
) (get-buffer interblock-R-buffer
))
375 (setf interblock-R-buffer
(current-buffer))
376 (interblock-R-wait-for-output)
377 (interblock-R-input-command ""))))
379 (defun interblock-R-command-to-string (command)
380 "Send a command to R, and return the results as a string."
381 (interblock-R-input-command command
)
382 (interblock-R-last-output))
384 (defun interblock-R-input-command (command)
385 "Pass COMMAND to the R process running in `interblock-R-buffer'."
388 (set-buffer interblock-R-buffer
)
389 (goto-char (process-mark (get-buffer-process (current-buffer))))
392 (interblock-R-wait-for-output))))
394 (defun interblock-R-wait-for-output ()
395 "Wait until output arrives"
398 (set-buffer interblock-R-buffer
)
400 (goto-char comint-last-input-end
)
401 (not (re-search-forward comint-prompt-regexp nil t
)))
402 (accept-process-output (get-buffer-process (current-buffer)))))))
404 (defun interblock-R-last-output ()
405 "Return the last R output as a string"
408 (set-buffer interblock-R-buffer
)
409 (goto-char (process-mark (get-buffer-process (current-buffer))))
411 (let ((raw (buffer-substring comint-last-input-end
(- (point) 1))))
412 (if (string-match "\n" raw
)
414 (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw
)
416 (message (match-string 1 raw
))
417 (match-string 1 raw
)))))))
419 (provide 'org-exp-blocks
)
421 ;;; org-exp-blocks.el ends here