ox: Add arguments to `org-export-to-file' and `org-export-to-buffer'

* lisp/ox.el (org-export-to-buffer): Add two arguments: one to trigger
  asynchronous export and the other to do extra processing from within
  the buffer.
(org-export-to-file): Add two arguments: one to trigger asynchronous
  export and the other to do extra processing on the output file.
(org-export-async-start): Small clean up.
This commit is contained in:
Nicolas Goaziou 2013-08-07 10:15:23 +02:00
parent d1d918100e
commit 6f55864f20
1 changed files with 258 additions and 207 deletions

View File

@ -2805,15 +2805,9 @@ Return the updated communication channel."
;;; Core functions
;;
;; This is the room for the main function, `org-export-as', along with
;; its derivatives, `org-export-to-buffer', `org-export-to-file' and
;; `org-export-string-as'. They differ either by the way they output
;; the resulting code (for the first two) or by the input type (for
;; the latter). `org-export--copy-to-kill-ring-p' determines if
;; output of these function should be added to kill ring.
;;
;; `org-export-output-file-name' is an auxiliary function meant to be
;; used with `org-export-to-file'. With a given extension, it tries
;; to provide a canonical file name to write export output to.
;; its derivative, `org-export-string-as'.
;; `org-export--copy-to-kill-ring-p' determines if output of these
;; function should be added to kill ring.
;;
;; Note that `org-export-as' doesn't really parse the current buffer,
;; but a copy of it (with the same buffer-local variables and
@ -3063,68 +3057,6 @@ Return code as a string."
(funcall template full-body info))
info))))))))
;;;###autoload
(defun org-export-to-buffer
(backend buffer &optional subtreep visible-only body-only ext-plist)
"Call `org-export-as' with output to a specified buffer.
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end.
BUFFER is the output buffer. If it already exists, it will be
erased first, otherwise, it will be created.
Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
EXT-PLIST are similar to those used in `org-export-as', which
see.
Depending on `org-export-copy-to-kill-ring', add buffer contents
to kill ring. Return buffer."
(let ((out (org-export-as backend subtreep visible-only body-only ext-plist))
(buffer (get-buffer-create buffer)))
(with-current-buffer buffer
(erase-buffer)
(insert out)
(goto-char (point-min)))
;; Maybe add buffer contents to kill ring.
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
(org-kill-new out))
;; Return buffer.
buffer))
;;;###autoload
(defun org-export-to-file
(backend file &optional subtreep visible-only body-only ext-plist)
"Call `org-export-as' with output to a specified file.
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end. FILE is the name of the output file, as
a string.
Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
EXT-PLIST are similar to those used in `org-export-as', which
see.
Depending on `org-export-copy-to-kill-ring', add file contents
to kill ring. Return output file's name."
;; Checks for FILE permissions. `write-file' would do the same, but
;; we'd rather avoid needless transcoding of parse tree.
(unless (file-writable-p file) (error "Output file not writable"))
;; Insert contents to a temporary buffer and write it to FILE.
(let ((coding buffer-file-coding-system)
(out (org-export-as backend subtreep visible-only body-only ext-plist)))
(with-temp-buffer
(insert out)
(let ((coding-system-for-write (or org-export-coding-system coding)))
(write-file file)))
;; Maybe add file contents to kill ring.
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
(org-kill-new out)))
;; Return full path.
file)
;;;###autoload
(defun org-export-string-as (string backend &optional body-only ext-plist)
"Transcode STRING into BACKEND code.
@ -3264,61 +3196,6 @@ locally for the subtree through node properties."
(car key)
(if (org-string-nw-p val) (format " %s" val) "")))))))))
(defun org-export-output-file-name (extension &optional subtreep pub-dir)
"Return output file's name according to buffer specifications.
EXTENSION is a string representing the output file extension,
with the leading dot.
With a non-nil optional argument SUBTREEP, try to determine
output file's name by looking for \"EXPORT_FILE_NAME\" property
of subtree at point.
When optional argument PUB-DIR is set, use it as the publishing
directory.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
;; File name may come from EXPORT_FILE_NAME subtree
;; property, assuming point is at beginning of said
;; sub-tree.
(file-name-sans-extension
(or (and subtreep
(org-entry-get
(save-excursion
(ignore-errors (org-back-to-heading) (point)))
"EXPORT_FILE_NAME" t))
;; File name may be extracted from buffer's associated
;; file, if any.
(and visited-file (file-name-nondirectory visited-file))
;; Can't determine file name on our own: Ask user.
(let ((read-file-name-function
(and org-completion-use-ido 'ido-read-file-name)))
(read-file-name
"Output file: " pub-dir nil nil nil
(lambda (name)
(string= (file-name-extension name t) extension)))))))
(output-file
;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has
;; precedence over any provided path.
(cond
(pub-dir
(concat (file-name-as-directory pub-dir)
(file-name-nondirectory base-name)
extension))
((file-name-absolute-p base-name) (concat base-name extension))
(t (concat (file-name-as-directory ".") base-name extension)))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
(if (and visited-file (org-file-equal-p visited-file output-file))
(concat output-file extension)
output-file)))
(defun org-export-expand-include-keyword (&optional included dir)
"Expand every include keyword in buffer.
Optional argument INCLUDED is a list of included file names along
@ -5551,6 +5428,13 @@ to `:default' encoding. If it fails, return S."
;; evaluates a command there. It then applies a function on the
;; returned results in the current process.
;;
;; At a higher level, `org-export-to-buffer' and `org-export-to-file'
;; allow to export to a buffer or a file, asynchronously or not.
;;
;; `org-export-output-file-name' is an auxiliary function meant to be
;; used with `org-export-to-file'. With a given extension, it tries
;; to provide a canonical file name to write export output to.
;;
;; Asynchronously generated results are never displayed directly.
;; Instead, they are stored in `org-export-stack-contents'. They can
;; then be retrieved by calling `org-export-stack'.
@ -5561,7 +5445,7 @@ to `:default' encoding. If it fails, return S."
;;`org-export-stack-clear'.
;;
;; For back-ends, `org-export-add-to-stack' add a new source to stack.
;; It should used whenever `org-export-async-start' is called.
;; It should be used whenever `org-export-async-start' is called.
(defmacro org-export-async-start (fun &rest body)
"Call function FUN on the results returned by BODY evaluation.
@ -5570,93 +5454,260 @@ BODY evaluation happens in an asynchronous process, from a buffer
which is an exact copy of the current one.
Use `org-export-add-to-stack' in FUN in order to register results
in the stack. Examples for, respectively a temporary buffer and
a file are:
in the stack.
\(org-export-async-start
\(lambda (output)
\(with-current-buffer (get-buffer-create \"*Org BACKEND Export*\")
\(erase-buffer)
\(insert output)
\(goto-char (point-min))
\(org-export-add-to-stack (current-buffer) 'backend)))
`(org-export-as 'backend ,subtreep ,visible-only ,body-only ',ext-plist))
and
\(org-export-async-start
\(lambda (f) (org-export-add-to-stack f 'backend))
`(expand-file-name
\(org-export-to-file
'backend ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))"
This is a low level function. See also `org-export-to-buffer'
and `org-export-to-file' for more specialized functions."
(declare (indent 1) (debug t))
(org-with-gensyms (process temp-file copy-fun proc-buffer handler coding)
(org-with-gensyms (process temp-file copy-fun proc-buffer coding)
;; Write the full sexp evaluating BODY in a copy of the current
;; buffer to a temporary file, as it may be too long for program
;; args in `start-process'.
`(with-temp-message "Initializing asynchronous export process"
(let ((,copy-fun (org-export--generate-copy-script (current-buffer)))
(,temp-file (make-temp-file "org-export-process"))
(,coding buffer-file-coding-system))
(with-temp-file ,temp-file
(insert
;; Null characters (from variable values) are inserted
;; within the file. As a consequence, coding system for
;; buffer contents will not be recognized properly. So,
;; we make sure it is the same as the one used to display
;; the original buffer.
(format ";; -*- coding: %s; -*-\n%S"
,coding
`(with-temp-buffer
,(when org-export-async-debug '(setq debug-on-error t))
;; Ignore `kill-emacs-hook' and code evaluation
;; queries from Babel as we need a truly
;; non-interactive process.
(setq kill-emacs-hook nil
org-babel-confirm-evaluate-answer-no t)
;; Initialize export framework.
(require 'ox)
;; Re-create current buffer there.
(funcall ,,copy-fun)
(restore-buffer-modified-p nil)
;; Sexp to evaluate in the buffer.
(print (progn ,,@body))))))
;; Start external process.
(let* ((process-connection-type nil)
(,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
(,process
(start-process
"org-export-process" ,proc-buffer
(expand-file-name invocation-name invocation-directory)
"-Q" "--batch"
"-l" org-export-async-init-file
"-l" ,temp-file)))
;; Register running process in stack.
(org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
;; Set-up sentinel in order to catch results.
(set-process-sentinel
,process
(let ((handler ',fun))
`(lambda (p status)
(let ((proc-buffer (process-buffer p)))
(when (eq (process-status p) 'exit)
(unwind-protect
(if (zerop (process-exit-status p))
(unwind-protect
(let ((results
(with-current-buffer proc-buffer
(goto-char (point-max))
(backward-sexp)
(read (current-buffer)))))
(funcall ,handler results))
(unless org-export-async-debug
(and (get-buffer proc-buffer)
(kill-buffer proc-buffer))))
(org-export-add-to-stack proc-buffer nil p)
(ding)
(message "Process '%s' exited abnormally" p))
(unless org-export-async-debug
(delete-file ,,temp-file)))))))))))))
(,temp-file (make-temp-file "org-export-process"))
(,coding buffer-file-coding-system))
(with-temp-file ,temp-file
(insert
;; Null characters (from variable values) are inserted
;; within the file. As a consequence, coding system for
;; buffer contents will not be recognized properly. So,
;; we make sure it is the same as the one used to display
;; the original buffer.
(format ";; -*- coding: %s; -*-\n%S"
,coding
`(with-temp-buffer
(when org-export-async-debug '(setq debug-on-error t))
;; Ignore `kill-emacs-hook' and code evaluation
;; queries from Babel as we need a truly
;; non-interactive process.
(setq kill-emacs-hook nil
org-babel-confirm-evaluate-answer-no t)
;; Initialize export framework.
(require 'ox)
;; Re-create current buffer there.
(funcall ,,copy-fun)
(restore-buffer-modified-p nil)
;; Sexp to evaluate in the buffer.
(print (progn ,,@body))))))
;; Start external process.
(let* ((process-connection-type nil)
(,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
(,process
(start-process
"org-export-process" ,proc-buffer
(expand-file-name invocation-name invocation-directory)
"-Q" "--batch"
"-l" org-export-async-init-file
"-l" ,temp-file)))
;; Register running process in stack.
(org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
;; Set-up sentinel in order to catch results.
(let ((handler ,fun))
(set-process-sentinel
,process
`(lambda (p status)
(let ((proc-buffer (process-buffer p)))
(when (eq (process-status p) 'exit)
(unwind-protect
(if (zerop (process-exit-status p))
(unwind-protect
(let ((results
(with-current-buffer proc-buffer
(goto-char (point-max))
(backward-sexp)
(read (current-buffer)))))
(funcall ,handler results))
(unless org-export-async-debug
(and (get-buffer proc-buffer)
(kill-buffer proc-buffer))))
(org-export-add-to-stack proc-buffer nil p)
(ding)
(message "Process '%s' exited abnormally" p))
(unless org-export-async-debug
(delete-file ,,temp-file)))))))))))))
;;;###autoload
(defun org-export-to-buffer
(backend buffer
&optional async subtreep visible-only body-only ext-plist
post-process)
"Call `org-export-as' with output to a specified buffer.
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end.
BUFFER is the name of the output buffer. If it already exists,
it will be erased first, otherwise, it will be created.
A non-nil optional argument ASYNC means the process should happen
asynchronously. The resulting buffer should then be accessible
through the `org-export-stack' interface. When ASYNC is nil, the
buffer is displayed if `org-export-show-temporary-export-buffer'
is non-nil.
Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
EXT-PLIST are similar to those used in `org-export-as', which
see.
Optional argument POST-PROCESS is a function which should accept
no argument. It is called within the current process, from
BUFFER, with point at its beginning. Export back-ends can use it
to set a major mode there, e.g,
\(defun org-latex-export-as-latex
\(&optional async subtreep visible-only body-only ext-plist)
\(interactive)
\(org-export-to-buffer 'latex \"*Org LATEX Export*\"
async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
This function returns BUFFER."
(declare (indent 2))
(if async
(org-export-async-start
`(lambda (output)
(with-current-buffer (get-buffer-create ,buffer)
(erase-buffer)
(setq buffer-file-coding-system ',buffer-file-coding-system)
(insert output)
(goto-char (point-min))
(org-export-add-to-stack (current-buffer) ',backend)
(ignore-errors (funcall ,post-process))))
`(org-export-as
',backend ,subtreep ,visible-only ,body-only ',ext-plist))
(let ((output
(org-export-as backend subtreep visible-only body-only ext-plist))
(buffer (get-buffer-create buffer))
(encoding buffer-file-coding-system))
(when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p))
(org-kill-new output))
(with-current-buffer buffer
(erase-buffer)
(setq buffer-file-coding-system encoding)
(insert output)
(goto-char (point-min))
(and (functionp post-process) (funcall post-process)))
(when org-export-show-temporary-export-buffer
(switch-to-buffer-other-window buffer))
buffer)))
;;;###autoload
(defun org-export-to-file
(backend file &optional async subtreep visible-only body-only ext-plist
post-process)
"Call `org-export-as' with output to a specified file.
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end. FILE is the name of the output file, as
a string.
A non-nil optional argument ASYNC means the process should happen
asynchronously. The resulting buffer file then be accessible
through the `org-export-stack' interface.
Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
EXT-PLIST are similar to those used in `org-export-as', which
see.
Optional argument POST-PROCESS is called with FILE as its
argument, in the asynchronous process. It has to return a file
name, or nil. Export back-ends can use this to send the output
file through additional processing, e.g,
\(defun org-latex-export-to-latex
\(&optional async subtreep visible-only body-only ext-plist)
\(interactive)
\(let ((outfile (org-export-output-file-name \".tex\" subtreep)))
\(org-export-to-file 'latex outfile
async subtreep visible-only body-only ext-plist
\(lambda (file) (org-latex-compile file)))
The function returns either a file name returned by POST-PROCESS,
or FILE."
(declare (indent 2))
(if (not (file-writable-p file)) (error "Output file not writable")
(let ((encoding (or org-export-coding-system buffer-file-coding-system)))
(if async
(org-export-async-start
`(lambda (file)
(org-export-add-to-stack (expand-file-name file) ',backend))
`(let ((output
(org-export-as
',backend ,subtreep ,visible-only ,body-only
',ext-plist)))
(with-temp-buffer
(insert output)
(let ((coding-system-for-write ',encoding))
(write-file ,file)))
(or (ignore-errors (funcall ',post-process ,file)) ,file)))
(let ((output (org-export-as
backend subtreep visible-only body-only ext-plist)))
(with-temp-buffer
(insert output)
(let ((coding-system-for-write encoding))
(write-file file)))
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
(org-kill-new output))
;; Get proper return value.
(or (and (functionp post-process) (funcall post-process file))
file))))))
(defun org-export-output-file-name (extension &optional subtreep pub-dir)
"Return output file's name according to buffer specifications.
EXTENSION is a string representing the output file extension,
with the leading dot.
With a non-nil optional argument SUBTREEP, try to determine
output file's name by looking for \"EXPORT_FILE_NAME\" property
of subtree at point.
When optional argument PUB-DIR is set, use it as the publishing
directory.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
;; File name may come from EXPORT_FILE_NAME subtree
;; property, assuming point is at beginning of said
;; sub-tree.
(file-name-sans-extension
(or (and subtreep
(org-entry-get
(save-excursion
(ignore-errors (org-back-to-heading) (point)))
"EXPORT_FILE_NAME" t))
;; File name may be extracted from buffer's associated
;; file, if any.
(and visited-file (file-name-nondirectory visited-file))
;; Can't determine file name on our own: Ask user.
(let ((read-file-name-function
(and org-completion-use-ido 'ido-read-file-name)))
(read-file-name
"Output file: " pub-dir nil nil nil
(lambda (name)
(string= (file-name-extension name t) extension)))))))
(output-file
;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has
;; precedence over any provided path.
(cond
(pub-dir
(concat (file-name-as-directory pub-dir)
(file-name-nondirectory base-name)
extension))
((file-name-absolute-p base-name) (concat base-name extension))
(t (concat (file-name-as-directory ".") base-name extension)))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
(if (and visited-file (org-file-equal-p visited-file output-file))
(concat output-file extension)
output-file)))
(defun org-export-add-to-stack (source backend &optional process)
"Add a new result to export stack if not present already.