瀏覽代碼

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
Eric Schulte 14 年之前
父節點
當前提交
9931dae20a
共有 4 個文件被更改,包括 108 次插入90 次删除
  1. 71 85
      lisp/ob-exp.el
  2. 7 5
      lisp/ob.el
  3. 19 0
      testing/examples/babel.org
  4. 11 0
      testing/lisp/test-ob-exp.el

+ 71 - 85
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)
 

+ 7 - 5
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)

+ 19 - 0
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

+ 11 - 0
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