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
Dan Davison
parent
9ba9ef99a6
commit
9931dae20a
156
lisp/ob-exp.el
156
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)
|
||||
|
||||
|
|
|
|||
12
lisp/ob.el
12
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue