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
This commit is contained in:
Eric Schulte 2010-10-15 18:00:57 -06:00 committed by Dan Davison
parent 9ba9ef99a6
commit 9931dae20a
4 changed files with 108 additions and 90 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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