diff --git a/lisp/ox.el b/lisp/ox.el index 8f5bbc299..2465555a3 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -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.