Forráskód Böngészése

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.
Nicolas Goaziou 11 éve
szülő
commit
6f55864f20
1 módosított fájl, 259 hozzáadás és 208 törlés
  1. 259 208
      lisp/ox.el

+ 259 - 208
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:
-
-  \(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)))"
+in the stack.
+
+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.