summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Schulte <schulte.eric@gmail.com>2010-10-15 18:00:57 -0600
committerDan Davison <davison@stats.ox.ac.uk>2010-10-21 13:05:59 +0100
commit9931dae20adbf91c78289c06c09b145d12fcb4c4 (patch)
treec8e22ef376218ce54713809effd1baf319625bf3
parent9ba9ef99a6a6b2e82dda574e2d63c25d9ded4947 (diff)
downloadorg-mode-9931dae20adbf91c78289c06c09b145d12fcb4c4.tar.gz
babel: exporting now working with the new ob-get-src-block-info schema
includes a simple export test * lisp/ob-exp.el (org-babel-exp-in-export-file): wrapper for collecting information from within the original export file (org-babel-exp-src-blocks): simplified through use of the above macro (org-babel-exp-code): simplified through the use of new functions for parsing header arguments (org-babel-exp-results): simpler high-level organization, also this is now where the expansion of variable references takes place during export * lisp/ob.el (org-babel-expand-variables): broke variable replacement in a parameter list into it's own function (org-babel-get-src-block-info): now using the above function
-rw-r--r--lisp/ob-exp.el156
-rw-r--r--lisp/ob.el12
-rw-r--r--testing/examples/babel.org19
-rw-r--r--testing/lisp/test-ob-exp.el11
4 files changed, 108 insertions, 90 deletions
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 5042473..a377058 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -77,6 +77,30 @@ be indented by this many characters. See
`org-babel-function-def-export-name' for the definition of a
source block function.")
+(defmacro org-babel-exp-in-export-file (&rest body)
+ `(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
+ ;; 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))
+ (save-restriction
+ (condition-case nil
+ (org-open-link-from-string link)
+ (error (when heading
+ (goto-char (point-min))
+ (re-search-forward (regexp-quote heading) nil t))))
+ (setq results ,@body))
+ (set-buffer export-buffer)
+ results)))
+
(defun org-babel-exp-src-blocks (body &rest headers)
"Process source block for export.
Depending on the 'export' headers argument in replace the source
@@ -97,36 +121,17 @@ none ----- do not display either code or results upon export"
(goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
- (raw-params (nth 2 info))
- (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)))
+ (raw-params (nth 2 info)))
;; bail if we couldn't get any info from the block
(when info
- (when link
- ;; 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))
- (save-restriction
- (condition-case nil
- (org-open-link-from-string link)
- (error (when heading
- (goto-char (point-min))
- (re-search-forward (regexp-quote heading) nil t))))
- (setf (nth 2 info)
- (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)))
- (set-buffer export-buffer))
+ (org-babel-exp-in-export-file
+ (setf (nth 2 info)
+ (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)))
;; expand noweb references in the original file
(setf (nth 1 info)
(if (and (cdr (assoc :noweb (nth 2 info)))
@@ -244,9 +249,7 @@ The code block is not evaluated."
(body (nth 1 info))
(switches (nth 3 info))
(name (nth 4 info))
- (args (mapcar
- #'cdr
- (org-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info)))))
+ (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var))))
(case type
('inline (format "=%s=" body))
('block
@@ -278,62 +281,45 @@ Results are prepared in a manner suitable for export by org-mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
- (if org-export-babel-evaluate
- (let ((lang (nth 0 info))
- (body (nth 1 info))
- (params
- ;; lets ensure that we lookup references in the original file
- (mapcar
- (lambda (pair)
- (if (and org-current-export-file
- (eq (car pair) :var)
- (string-match org-babel-ref-split-regexp (cdr pair))
- (equal :ob-must-be-reference
- (org-babel-ref-literal
- (match-string 2 (cdr pair)))))
- `(:var . ,(concat (match-string 1 (cdr pair))
- "=" org-current-export-file
- ":" (match-string 2 (cdr pair))))
- pair))
- (nth 2 info))))
- ;; skip code blocks which we can't evaluate
- (if (fboundp (intern (concat "org-babel-execute:" lang)))
- (case type
- ('inline
- (let ((raw (org-babel-execute-src-block
- nil info '((:results . "silent"))))
- (result-params (split-string
- (cdr (assoc :results params)))))
- (unless silent
- (cond ;; respect the value of the :results header argument
- ((member "file" result-params)
- (org-babel-result-to-file raw))
- ((or (member "raw" result-params)
- (member "org" result-params))
- (format "%s" raw))
- ((member "code" result-params)
- (format "src_%s{%s}" lang raw))
- (t
- (if (stringp raw)
- (if (= 0 (length raw)) "=(no results)="
- (format "%s" raw))
- (format "%S" raw)))))))
- ('block
- (org-babel-execute-src-block
- nil info (org-babel-merge-params
- params
- `((:results . ,(if silent "silent" "replace")))))
- "")
- ('lob
+ (or
+ (when org-export-babel-evaluate
+ (let ((lang (nth 0 info))
+ (body (nth 1 info)))
+ (setf (nth 2 info) (org-babel-exp-in-export-file
+ (org-babel-expand-variables (nth 2 info))))
+ ;; skip code blocks which we can't evaluate
+ (when (fboundp (intern (concat "org-babel-execute:" lang)))
+ (if (equal type 'inline)
+ (let ((raw (org-babel-execute-src-block
+ nil info '((:results . "silent"))))
+ (result-params (split-string
+ (cdr (assoc :results (nth 2 info))))))
+ (unless silent
+ (cond ;; respect the value of the :results header argument
+ ((member "file" result-params)
+ (org-babel-result-to-file raw))
+ ((or (member "raw" result-params)
+ (member "org" result-params))
+ (format "%s" raw))
+ ((member "code" result-params)
+ (format "src_%s{%s}" lang raw))
+ (t
+ (if (stringp raw)
+ (if (= 0 (length raw)) "=(no results)="
+ (format "%s" raw))
+ (format "%S" raw))))))
+ (prog1 nil
+ (setf (nth 2 info)
+ (org-babel-merge-params
+ (nth 2 info)
+ `((:results . ,(if silent "silent" "replace")))))
+ (cond
+ ((equal type 'block) (org-babel-execute-src-block nil info))
+ ((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
- (org-babel-execute-src-block
- nil info (org-babel-merge-params
- params
- `((:results . ,(if silent "silent" "replace")))))
- "")))
- ""))
- ""))
+ (org-babel-execute-src-block nil info)))))))))
+ ""))
(provide 'ob-exp)
diff --git a/lisp/ob.el b/lisp/ob.el
index 089d586..c51f68a 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -152,6 +152,12 @@ not match KEY should be returned."
(lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
params)))
+(defun org-babel-expand-variables (params)
+ "Expand variables in PARAMS."
+ (append (mapcar (lambda (el) (cons :var (org-babel-ref-parse (cdr el))))
+ (org-babel-get-header params :var))
+ (org-babel-get-header params :var 'other)))
+
(defun org-babel-get-src-block-info (&optional light)
"Get information on the current source block.
@@ -191,11 +197,7 @@ Returns a list
(setq info (org-babel-parse-inline-src-block-match))))
;; resolve variable references
(when (and info (not light))
- (setf (nth 2 info)
- (let ((params (nth 2 info)))
- (append (mapcar (lambda (el) (cons :var (org-babel-ref-parse (cdr el))))
- (org-babel-get-header params :var))
- (org-babel-get-header params :var 'other)))))
+ (setf (nth 2 info) (org-babel-expand-variables (nth 2 info))))
(when info (append info (list name indent)))))
(defun org-babel-confirm-evaluate (info)
diff --git a/testing/examples/babel.org b/testing/examples/babel.org
index c632964..4171aee 100644
--- a/testing/examples/babel.org
+++ b/testing/examples/babel.org
@@ -110,3 +110,22 @@
#+results: i-have-a-name
: 42
+* Pascal's Triangle -- export test
+ :PROPERTIES:
+ :ID: 92518f2a-a46a-4205-a3ab-bcce1008a4bb
+ :END:
+
+#+source: pascals-triangle
+#+begin_src emacs-lisp :var n=5 :exports both
+ (defun pascals-triangle (n)
+ (if (= n 0)
+ (list (list 1))
+ (let* ((prev-triangle (pascals-triangle (- n 1)))
+ (prev-row (car (reverse prev-triangle))))
+ (append prev-triangle
+ (list (map 'list #'+
+ (append prev-row '(0))
+ (append '(0) prev-row)))))))
+
+ (pascals-triangle n)
+#+end_src
diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el
index 471453f..1c2214c 100644
--- a/testing/lisp/test-ob-exp.el
+++ b/testing/lisp/test-ob-exp.el
@@ -84,6 +84,17 @@
(should-not (exp-p "no"))
(should-not (exp-p "tangle")))))
+(ert-deftest ob-exp/exports-both ()
+ "Test the :exports both header argument.
+The code block should create both <pre></pre> and <table></table>
+elements in the final html."
+ (let (html)
+ (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb"
+ (org-narrow-to-subtree)
+ (setq html (org-export-as-html nil nil nil 'string))
+ (should (string-match "<pre.*>[^\000]*</pre>" html))
+ (should (string-match "<table.*>[^\000]*</table>" html)))))
+
(provide 'test-ob-exp)
;;; test-ob-exp.el ends here