Browse Source

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 years ago
parent
commit
9931dae20a
4 changed files with 108 additions and 90 deletions
  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
 `org-babel-function-def-export-name' for the definition of a
 source block function.")
 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)
 (defun org-babel-exp-src-blocks (body &rest headers)
   "Process source block for export.
   "Process source block for export.
 Depending on the 'export' headers argument in replace the source
 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))
     (goto-char (match-beginning 0))
     (let* ((info (org-babel-get-src-block-info 'light))
     (let* ((info (org-babel-get-src-block-info 'light))
 	   (lang (nth 0 info))
 	   (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
       ;; bail if we couldn't get any info from the block
       (when info
       (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
 	;; expand noweb references in the original file
 	(setf (nth 1 info)
 	(setf (nth 1 info)
 	      (if (and (cdr (assoc :noweb (nth 2 info)))
 	      (if (and (cdr (assoc :noweb (nth 2 info)))
@@ -244,9 +249,7 @@ The code block is not evaluated."
         (body (nth 1 info))
         (body (nth 1 info))
         (switches (nth 3 info))
         (switches (nth 3 info))
         (name (nth 4 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
     (case type
       ('inline (format "=%s=" body))
       ('inline (format "=%s=" body))
       ('block
       ('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
 This function is called by `org-babel-exp-do-export'.  The code
 block will be evaluated.  Optional argument SILENT can be used to
 block will be evaluated.  Optional argument SILENT can be used to
 inhibit insertion of results into the buffer."
 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
 	       (save-excursion
 		 (re-search-backward org-babel-lob-one-liner-regexp nil t)
 		 (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)
 (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))
 	 (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
 	 params)))
 	 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)
 (defun org-babel-get-src-block-info (&optional light)
   "Get information on the current source block.
   "Get information on the current source block.
 
 
@@ -191,11 +197,7 @@ Returns a list
 	(setq info (org-babel-parse-inline-src-block-match))))
 	(setq info (org-babel-parse-inline-src-block-match))))
     ;; resolve variable references
     ;; resolve variable references
     (when (and info (not light))
     (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)))))
     (when info (append info (list name indent)))))
 
 
 (defun org-babel-confirm-evaluate (info)
 (defun org-babel-confirm-evaluate (info)

+ 19 - 0
testing/examples/babel.org

@@ -110,3 +110,22 @@
 #+results: i-have-a-name
 #+results: i-have-a-name
 : 42
 : 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 "no"))
       (should-not (exp-p "tangle")))))
       (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)
 (provide 'test-ob-exp)
 
 
 ;;; test-ob-exp.el ends here
 ;;; test-ob-exp.el ends here