Here's a hook that modifies the source blocks to wrap their
output in #+BEGIN/END_METAPOST tags if the ConTeXt backend is used,
before Org Babel gets to them, but otherwise leaves them alone.
I wonder if anyone has any better ideas of how to do this. I'm
modifying the Org source with the hook before the document gets parsed
so that it can be more backend-agnostic but it seems like it would
be better if there was a way to modify the document parse tree
directly instead. I don't like that I'm effectively parsing and
rebuilding (hopefully) the same string in order to change the :result
type.
I also don't like that I don't really have a clean way of turning
the hook on and off with document keywords. This is kind of a nasty
thing to do to a document and users should probably have to explicitly
opt in.
I also found an old answer that describes how to add captions
to figures generated by source blocks:
https://www.mail-archive.com/emacs-orgmode@gnu.org/msg68100.html
Probably not news to many other people on this list but myself :)
#+TITLE: Metapost Handler
This is a basic handler for METAPOST that exports as raw code
when the ConTeXt exporter is used but otherwise does whatever you
tell it to.
#+NAME: hooks
#+BEGIN_SRC emacs-lisp :exports none :results none
(defun format-src-block-arguments (arguments)
"Returns a formatted plist of header arguments"
(mapconcat
(lambda (argument)
(let ((kw (car argument))
(vals (cdr argument)))
(concat (format "%s" kw)
" "
(format "%s" vals))))
arguments
" "))
(defun metapost-process-hook (backend)
"If BACKEND is `context', change metapost code blocks to output
raw code wrapped in #+BEGIN_METAPOST/#+END_METAPOST tags."
;; TODO This should be controlled by a flag.
;; TODO Check buffer info to see if we are allowed to do this.
(when (string= backend "context")
(goto-char (point-min))
(let ((case-fold-search t)
;; Search for source code with a regex
(regexp "^[ \t]*#\\+BEGIN_SRC"))
(while (re-search-forward regexp nil t)
(let* ((objectp (match-end 1))
(tree (org-element-parse-buffer))
;; Get the buffer info plist (need this to export a caption)
(info (org-combine-plists
(org-export--get-export-attributes)
(org-export-get-environment)))
(info (progn
(org-export--prune-tree tree info)
(org-export--remove-uninterpreted-data tree info)
(org-combine-plists info
(org-export--collect-tree-properties
tree info))))
;; Get a code element
(element
(save-match-data
(if objectp (org-element-context) (org-element-at-point))))
(caption (org-element-property :caption element))
(type (org-element-type element))
(begin (copy-marker (org-element-property :begin element)))
(end (copy-marker
(save-excursion
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(point))))
(block-info (org-babel-get-src-block-info t))
(language (nth 0 block-info))
(body (nth 1 block-info))
(arguments (nth 2 block-info))
(arguments (delq (assoc :file arguments) arguments))
(switches (nth 3 block-info))
(name (nth 4 block-info))
(start (nth 5 block-info))
(coderef (nth 6 block-info)))
(when (or t (string= (downcase language) "metapost"))
;; Remove "file" from `results' setting
(setf (alist-get :results arguments)
(mapconcat
#'identity
(seq-filter
(lambda (a) (not (string= a "file")) )
(split-string (alist-get :results arguments)))
" "))
;; Add a wrap argument to wrap in a METAPOST special block
(setf (alist-get :wrap arguments) "METAPOST")
(pcase type
(`src-block
(progn
(delete-region begin end)
(goto-char begin)
(insert
(concat
;; Captions and names got deleted; add them back
(when (org-string-nw-p name)
(format "#+NAME: %s \n" name))
(when caption
(format "#+CAPTION: %s\n"
(org-string-nw-p
(org-trim
(org-export-data
(or
(org-export-get-caption element t)
(org-export-get-caption element))
info)))))
;; Add the (modified) header arguments back
(format "#+BEGIN_SRC metapost %s\n%s\n#+END_SRC"
(format-src-block-arguments arguments)
body)
"\n"))))))))
(goto-char (point-min)))))
(remove-hook 'org-export-before-processing-hook 'metapost-process-hook)
(add-hook 'org-export-before-processing-hook 'metapost-process-hook)
#+END_SRC
#+NAME: metapost-export
#+BEGIN_SRC emacs-lisp :exports none :results none
(defun org-babel-execute:metapost (body params)
"Execute a block of metapost code with org-babel.
This function is called by `org-babel-execute-src-block'."
(if (cdr (assq :file params))
(let* ((out-file (cdr (assq :file params)))
(cmdline (or (cdr (assq :cmdline params))
(format "-T%s" (file-name-extension out-file))))
(cmd (or (cdr (assq :cmd params)) "mpost"))
(coding-system-for-read 'utf-8) ;use utf-8 with sub-processes
(coding-system-for-write 'utf-8)
(in-file (org-babel-temp-file "metapost-")))
(with-temp-file in-file
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat cmd
" -s 'outputformat=\"svg\"'"
(format " -s 'outputtemplate=\"%s\"'"
(org-babel-process-file-name out-file))
" " (org-babel-process-file-name in-file)) "")
nil)
body))
#+END_SRC
#+NAME: some-name
#+BEGIN_SRC metapost :results file :file foo.svg :exports results
beginfig(1);
draw origin--(100,100)--(200,0)--cycle;
endfig;
end;
#+END_SRC
#+CAPTION: Some caption
#+RESULTS: some-name
[[file:foo.svg]]
