]> code.delx.au - gnu-emacs/blobdiff - lisp/org/ob-exp.el
etags.el fix for compressed files
[gnu-emacs] / lisp / org / ob-exp.el
index 0fceb184c5e72df840a8bd9dbf6b000345df6d01..c62a6a8211d6fcd1053c5ca148fd04a023048575 100644 (file)
@@ -1,12 +1,11 @@
 ;;; ob-exp.el --- Exportation of org-babel source blocks
 
-;; Copyright (C) 2009-201 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
 
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
 ;;     Dan Davison
 ;; Keywords: literate programming, reproducible research
 ;; Homepage: http://orgmode.org
-;; Version: 7.7
 
 ;; This file is part of GNU Emacs.
 
 (defvar org-current-export-file)
 (defvar org-babel-lob-one-liner-regexp)
 (defvar org-babel-ref-split-regexp)
+(defvar org-list-forbidden-blocks)
+
 (declare-function org-babel-lob-get-info "ob-lob" ())
 (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
-(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks))
-(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners))
-(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup)
+(declare-function org-heading-components "org" ())
+(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-in-verbatim-emphasis "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
 
+(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
 (org-export-blocks-add-block '(src org-babel-exp-src-block nil))
 
 (defcustom org-export-babel-evaluate t
 When set to nil no code will be evaluated as part of the export
 process."
   :group 'org-babel
+  :version "24.1"
   :type 'boolean)
 (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
 
+(defun org-babel-exp-get-export-buffer ()
+  "Return the current export buffer if possible."
+  (cond
+   ((bufferp org-current-export-file) org-current-export-file)
+   (org-current-export-file (get-file-buffer org-current-export-file))
+   ('otherwise
+    (error "Requested export buffer when `org-current-export-file' is nil"))))
+
 (defmacro org-babel-exp-in-export-file (lang &rest body)
   (declare (indent 1))
   `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
          (heading (nth 4 (ignore-errors (org-heading-components))))
-         (link (when org-current-export-file
-                 (org-make-link-string
-                  (if heading
-                      (concat org-current-export-file "::" heading)
-                    org-current-export-file))))
-         (export-buffer (current-buffer)) results)
-     (when link
+         (export-buffer (current-buffer))
+         (original-buffer (org-babel-exp-get-export-buffer)) results)
+     (when original-buffer
        ;; resolve parameters in the original file so that
        ;; headline and file-wide parameters are included, attempt
        ;; to go to the same heading in the original file
-       (set-buffer (get-file-buffer org-current-export-file))
+       (set-buffer original-buffer)
        (save-restriction
-        (condition-case nil
-            (let ((org-link-search-inhibit-query t))
-              (org-open-link-from-string link))
-          (error (when heading
-                   (goto-char (point-min))
-                   (re-search-forward (regexp-quote heading) nil t))))
+        (when heading
+          (condition-case nil
+              (let ((org-link-search-inhibit-query t))
+                (org-link-search heading))
+            (error (when heading
+                     (goto-char (point-min))
+                     (re-search-forward (regexp-quote heading) nil t)))))
         (setq results ,@body))
        (set-buffer export-buffer)
        results)))
+(def-edebug-spec org-babel-exp-in-export-file (form body))
 
 (defun org-babel-exp-src-block (body &rest headers)
   "Process source block for export.
@@ -105,137 +117,168 @@ none ----- do not display either code or results upon export"
                  (org-babel-process-params
                   (org-babel-merge-params
                    org-babel-default-header-args
-                   (org-babel-params-from-buffer)
                    (org-babel-params-from-properties lang)
                    (if (boundp lang-headers) (eval lang-headers) nil)
                    raw-params))))
          (setf hash (org-babel-sha1-hash info)))
-       ;; expand noweb references in the original file
-       (setf (nth 1 info)
-             (if (and (cdr (assoc :noweb (nth 2 info)))
-                      (string= "yes" (cdr (assoc :noweb (nth 2 info)))))
-                 (org-babel-expand-noweb-references
-                  info (get-file-buffer org-current-export-file))
-               (nth 1 info)))
        (org-babel-exp-do-export info 'block hash)))))
 
-(defun org-babel-exp-inline-src-blocks (start end)
-  "Process inline source blocks between START and END for export.
-See `org-babel-exp-src-block' for export options, currently the
-options and are taken from `org-babel-default-inline-header-args'."
+(defcustom org-babel-exp-call-line-template
+  ""
+  "Template used to export call lines.
+This template may be customized to include the call line name
+with any export markup.  The template is filled out using
+`org-fill-template', and the following %keys may be used.
+
+ line --- call line
+
+An example value would be \"\\n: call: %line\" to export the call line
+wrapped in a verbatim environment.
+
+Note: the results are inserted separately after the contents of
+this template."
+  :group 'org-babel
+  :type 'string)
+
+(defvar org-babel-default-lob-header-args)
+(defun org-babel-exp-non-block-elements (start end)
+  "Process inline source and call lines between START and END for export."
   (interactive)
   (save-excursion
     (goto-char start)
-    (while (and (< (point) end)
-                (re-search-forward org-babel-inline-src-block-regexp end t))
-      (let* ((info (save-match-data (org-babel-parse-inline-src-block-match)))
-            (params (nth 2 info)) code-replacement)
-       (save-match-data
-         (goto-char (match-beginning 2))
-         (when (not (org-babel-in-example-or-verbatim))
-           ;; expand noweb references in the original file
-           (setf (nth 1 info)
-                 (if (and (cdr (assoc :noweb params))
-                          (string= "yes" (cdr (assoc :noweb params))))
-                     (org-babel-expand-noweb-references
-                      info (get-file-buffer org-current-export-file))
-                   (nth 1 info)))
-           (setq code-replacement (org-babel-exp-do-export info 'inline))))
-       (if code-replacement
-           (replace-match code-replacement nil nil nil 1)
-         (org-babel-examplize-region (match-beginning 1) (match-end 1))
-         (forward-char 2))))))
-
-(defun org-exp-res/src-name-cleanup ()
-  "Clean up #+results and #+srcname lines for export.
-This function should only be called after all block processing
-has taken place."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (while (org-re-search-forward-unprotected
-           (concat
-            "\\("org-babel-src-name-regexp"\\|"org-babel-result-regexp"\\)")
-           nil t)
-      (delete-region
-       (progn (beginning-of-line) (point))
-       (progn (end-of-line) (+ 1 (point)))))))
+    (unless (markerp end)
+      (let ((m (make-marker)))
+       (set-marker m end (current-buffer))
+       (setq end m)))
+    (let ((rx (concat "\\("  org-babel-inline-src-block-regexp
+                     "\\|" org-babel-lob-one-liner-regexp "\\)")))
+      (while (and (< (point) (marker-position end))
+                 (re-search-forward rx end t))
+       (if (save-excursion
+             (goto-char (match-beginning 0))
+             (looking-at org-babel-inline-src-block-regexp))
+           (progn
+             (forward-char 1)
+             (let* ((info (save-match-data
+                            (org-babel-parse-inline-src-block-match)))
+                    (params (nth 2 info)))
+               (save-match-data
+                 (goto-char (match-beginning 2))
+                 (unless (org-babel-in-example-or-verbatim)
+                   ;; expand noweb references in the original file
+                   (setf (nth 1 info)
+                         (if (and (cdr (assoc :noweb params))
+                                  (string= "yes" (cdr (assoc :noweb params))))
+                             (org-babel-expand-noweb-references
+                              info (org-babel-exp-get-export-buffer))
+                           (nth 1 info)))
+                   (let ((code-replacement (save-match-data
+                                             (org-babel-exp-do-export
+                                              info 'inline))))
+                     (if code-replacement
+                         (progn (replace-match code-replacement nil nil nil 1)
+                                (delete-char 1))
+                       (org-babel-examplize-region (match-beginning 1)
+                                                   (match-end 1))
+                       (forward-char 2)))))))
+         (unless (org-babel-in-example-or-verbatim)
+           (let* ((lob-info (org-babel-lob-get-info))
+                  (inlinep (match-string 11))
+                  (inline-start (match-end 11))
+                  (inline-end (match-end 0))
+                  (results (save-match-data
+                             (org-babel-exp-do-export
+                              (list "emacs-lisp" "results"
+                                    (org-babel-merge-params
+                                     org-babel-default-header-args
+                                     org-babel-default-lob-header-args
+                                     (org-babel-params-from-properties)
+                                     (org-babel-parse-header-arguments
+                                      (org-no-properties
+                                       (concat ":var results="
+                                               (mapconcat #'identity
+                                                          (butlast lob-info)
+                                                          " ")))))
+                                    "" nil (car (last lob-info)))
+                              'lob)))
+                  (rep (org-fill-template
+                        org-babel-exp-call-line-template
+                        `(("line"  . ,(nth 0 lob-info))))))
+             (if inlinep
+                 (save-excursion
+                   (goto-char inline-start)
+                   (delete-region inline-start inline-end)
+                   (insert rep))
+               (replace-match rep t t)))))))))
 
 (defun org-babel-in-example-or-verbatim ()
   "Return true if point is in example or verbatim code.
 Example and verbatim code include escaped portions of
 an org-mode buffer code that should be treated as normal
 org-mode text."
-  (or (org-in-indented-comment-line) 
-      (save-match-data
+  (or (save-match-data
        (save-excursion
          (goto-char (point-at-bol))
          (looking-at "[ \t]*:[ \t]")))
       (org-in-verbatim-emphasis)
-      (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
-
-(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-lob-one-liners (start end)
-  "Process Library of Babel calls between START and END for export.
-See `org-babel-exp-src-block' for export options. Currently the
-options are taken from `org-babel-default-header-args'."
-  (interactive)
-  (save-excursion
-    (goto-char start)
-    (while (and (< (point) end)
-               (re-search-forward org-babel-lob-one-liner-regexp nil t))
-      (unless (and (match-string 12) (org-babel-in-example-or-verbatim))
-       (let* ((lob-info (org-babel-lob-get-info))
-              (inlinep (match-string 11))
-              (inline-start (match-end 11))
-              (inline-end (match-end 0))
-              (rep (let ((lob-info (org-babel-lob-get-info)))
-                     (save-match-data
-                       (org-babel-exp-do-export
-                        (list "emacs-lisp" "results"
-                              (org-babel-merge-params
-                               org-babel-default-header-args
-                               org-babel-default-lob-header-args
-                               (org-babel-params-from-buffer)
-                               (org-babel-params-from-properties)
-                               (org-babel-parse-header-arguments
-                                (org-babel-clean-text-properties
-                                 (concat ":var results="
-                                         (mapconcat #'identity
-                                                    (butlast lob-info) " ")))))
-                              "" nil (car (last lob-info)))
-                        'lob)))))
-         (setq end (+ end (- (length rep)
-                             (- (length (match-string 0))
-                                (length (or (match-string 11) ""))))))
-         (if inlinep
-             (save-excursion
-               (goto-char inline-start)
-               (delete-region inline-start inline-end)
-               (insert rep))
-           (replace-match rep t t)))))))
+      (org-in-block-p org-list-forbidden-blocks)
+      (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
 
 (defun org-babel-exp-do-export (info type &optional hash)
   "Return a string with the exported content of a code block.
 The function respects the value of the :exports header argument."
-  (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
-                       (when (not (and session (equal "none" session)))
-                         (org-babel-exp-results info type 'silent))))
-        (clean () (unless (eq type 'inline) (org-babel-remove-result info))))
+  (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
+                              (when (not (and session (equal "none" session)))
+                                (org-babel-exp-results info type 'silent)))))
+       (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
     (case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
-      ('none (silently) (clean) "")
-      ('code (silently) (clean) (org-babel-exp-code info))
+      ('none (funcall silently) (funcall clean) "")
+      ('code (funcall silently) (funcall clean) (org-babel-exp-code info))
       ('results (org-babel-exp-results info type nil hash) "")
       ('both (org-babel-exp-results info type nil hash)
             (org-babel-exp-code info)))))
 
+(defcustom org-babel-exp-code-template
+  "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+  "Template used to export the body of code blocks.
+This template may be customized to include additional information
+such as the code block name, or the values of particular header
+arguments.  The template is filled out using `org-fill-template',
+and the following %keys may be used.
+
+ lang ------ the language of the code block
+ name ------ the name of the code block
+ body ------ the body of the code block
+ flags ----- the flags passed to the code block
+
+In addition to the keys mentioned above, every header argument
+defined for the code block may be used as a key and will be
+replaced with its value."
+  :group 'org-babel
+  :type 'string)
+
 (defun org-babel-exp-code (info)
   "Return the original code block formatted for export."
+  (setf (nth 1 info)
+       (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
+           (replace-regexp-in-string
+            (org-babel-noweb-wrap) "" (nth 1 info))
+         (if (org-babel-noweb-p (nth 2 info) :export)
+             (org-babel-expand-noweb-references
+              info (org-babel-exp-get-export-buffer))
+           (nth 1 info))))
   (org-fill-template
-   "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC\n"
+   org-babel-exp-code-template
    `(("lang"  . ,(nth 0 info))
+     ("body"  . ,(if (string= (nth 0 info) "org")
+                    (replace-regexp-in-string "^" "," (nth 1 info))
+                  (nth 1 info)))
+     ,@(mapcar (lambda (pair)
+                (cons (substring (symbol-name (car pair)) 1)
+                      (format "%S" (cdr pair))))
+              (nth 2 info))
      ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
-     ("body"  . ,(nth 1 info)))))
+     ("name"  . ,(or (nth 4 info) "")))))
 
 (defun org-babel-exp-results (info type &optional silent hash)
   "Evaluate and return the results of the current code block for export.
@@ -246,11 +289,16 @@ inhibit insertion of results into the buffer."
   (when (and org-export-babel-evaluate
             (not (and hash (equal hash (org-babel-current-result-hash)))))
     (let ((lang (nth 0 info))
-         (body (nth 1 info)))
+         (body (if (org-babel-noweb-p (nth 2 info) :eval)
+                   (org-babel-expand-noweb-references
+                    info (org-babel-exp-get-export-buffer))
+                 (nth 1 info)))
+         (info (copy-sequence info)))
       ;; skip code blocks which we can't evaluate
       (when (fboundp (intern (concat "org-babel-execute:" lang)))
        (org-babel-eval-wipe-error-buffer)
        (prog1 nil
+         (setf (nth 1 info) body)
          (setf (nth 2 info)
                (org-babel-exp-in-export-file lang
                  (org-babel-process-params
@@ -258,7 +306,15 @@ inhibit insertion of results into the buffer."
                    (nth 2 info)
                    `((:results . ,(if silent "silent" "replace")))))))
          (cond
-          ((or (equal type 'block) (equal type 'inline))
+          ((equal type 'block)
+           (org-babel-execute-src-block nil info))
+          ((equal type 'inline)
+           ;; position the point on the inline source block allowing
+           ;; `org-babel-insert-result' to check that the block is
+           ;; inline
+           (re-search-backward "[ \f\t\n\r\v]" nil t)
+           (re-search-forward org-babel-inline-src-block-regexp nil t)
+           (re-search-backward "src_" nil t)
            (org-babel-execute-src-block nil info))
           ((equal type 'lob)
            (save-excursion