From: Jason Ross <jasonross1024@gmail.com>
To: Ihor Radchenko <yantar92@gmail.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: Best way to include METAPOST in ConTeXt exporter
Date: Tue, 5 Oct 2021 12:50:35 -0700 [thread overview]
Message-ID: <db14bc26-0fd1-8a8c-92a3-8a63e23d51e5@gmail.com> (raw)
In-Reply-To: <CABcgBKJmR4yCTFW996efrmBE1D2pb6=2D68yKXByCS6bnqGG4A@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1044 bytes --]
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 :)
[-- Attachment #2: metapost-handler.org --]
[-- Type: text/plain, Size: 5796 bytes --]
#+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]]
next prev parent reply other threads:[~2021-10-05 19:52 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-10-03 17:53 Best way to include METAPOST in ConTeXt exporter Jason Ross
2021-10-04 8:41 ` Ihor Radchenko
2021-10-04 15:41 ` Jason Ross
2021-10-04 16:46 ` Ihor Radchenko
2021-10-05 14:40 ` Jason Ross
2021-10-05 19:50 ` Jason Ross [this message]
2021-10-13 6:51 ` Ihor Radchenko
2021-10-13 6:54 ` Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=db14bc26-0fd1-8a8c-92a3-8a63e23d51e5@gmail.com \
--to=jasonross1024@gmail.com \
--cc=emacs-orgmode@gnu.org \
--cc=yantar92@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).