Browse Source

ob-lob: now working with the new variable resolution setup

* lisp/ob-lob.el (org-babel-lob-execute): now expanding variable
  references before execution

* lisp/ob.el (org-babel-merge-params): better indentation, and finally
  sorted out the proper replacement of conflicting variable
  definitions
Eric Schulte 9 years ago
parent
commit
fd97cb9386
4 changed files with 93 additions and 74 deletions
  1. 9 8
      lisp/ob-lob.el
  2. 54 66
      lisp/ob.el
  3. 10 0
      testing/examples/babel.org
  4. 20 0
      testing/lisp/test-ob-lob.el

+ 9 - 8
lisp/ob-lob.el

@@ -101,14 +101,15 @@ if so then run the appropriate source block from the Library."
   
 (defun org-babel-lob-execute (info)
   "Execute the lob call specified by INFO."
-  (let ((params (org-babel-merge-params
-		 org-babel-default-header-args
-		 (org-babel-params-from-buffer)
-                 (org-babel-params-from-properties)
-		 (org-babel-parse-header-arguments
-		  (org-babel-clean-text-properties
-		   (concat ":var results="
-			   (mapconcat #'identity (butlast info) " ")))))))
+  (let ((params (org-babel-expand-variables
+		 (org-babel-merge-params
+		  org-babel-default-header-args
+		  (org-babel-params-from-buffer)
+		  (org-babel-params-from-properties)
+		  (org-babel-parse-header-arguments
+		   (org-babel-clean-text-properties
+		    (concat ":var results="
+			    (mapconcat #'identity (butlast info) " "))))))))
     (org-babel-execute-src-block
      nil (list "emacs-lisp" "results" params nil nil (nth 2 info)))))
 

+ 54 - 66
lisp/ob.el

@@ -1543,72 +1543,60 @@ parameters when merging lists."
                              new-params))
                      result-params)
                output)))
-      (mapc (lambda (plist)
-              (mapc (lambda (pair)
-                      (case (car pair)
-                        (:var
-			 (let ((name (if (listp (cdr pair))
-					 (cadr pair)
-				       (and
-					(string-match
-					 "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
-					 (cdr pair))
-					(intern (match-string 1 (cdr pair)))))))
-			   (when name
-			     (setq vars
-				   (cons
-				    pair
-				    (if (member name (mapcar #'car vars))
-					(delq nil
-					      (mapcar
-					       (lambda (p)
-						 (unless (equal (car p) name)
-						   p))
-					       vars))
-				      vars))))))
-                        (:results
-                         (setq results
-			       (e-merge results-exclusive-groups
-                                        results (split-string (cdr pair)))))
-			(:file
-			 (when (cdr pair)
-			   (setq results (e-merge results-exclusive-groups
-                                                  results '("file")))
-			   (unless (or (member "both" exports)
-                                       (member "none" exports)
-                                       (member "code" exports))
-			     (setq exports (e-merge exports-exclusive-groups
-                                                    exports '("results"))))
-			   (setq params
-                                 (cons pair
-                                       (assq-delete-all (car pair) params)))))
-                        (:exports
-                         (setq exports
-                               (e-merge exports-exclusive-groups
-                                        exports (split-string (cdr pair)))))
-                        (:tangle ;; take the latest -- always overwrite
-                         (setq tangle (or (list (cdr pair)) tangle)))
-                        (:noweb
-                         (setq noweb
-                               (e-merge '(("yes" "no")) noweb
-                                        (split-string (or (cdr pair) "")))))
-                        (:cache
-                         (setq cache
-                               (e-merge '(("yes" "no")) cache
-                                        (split-string (or (cdr pair) "")))))
-                        (:shebang ;; take the latest -- always overwrite
-                         (setq shebang (or (list (cdr pair)) shebang)))
-                        (:comments
-                         (setq comments
-                               (e-merge '(("yes" "no")) comments
-                                        (split-string (or (cdr pair) "")))))
-                        (t ;; replace: this covers e.g. :session
-                         (setq params
-                               (cons pair
-                                     (assq-delete-all (car pair) params))))))
-                    plist))
-            plists))
-    (while vars (setq params (cons (cons :var (cdr (pop vars))) params)))
+      (mapc
+       (lambda (plist)
+	 (mapc
+	  (lambda (pair)
+	    (case (car pair)
+	      (:var
+	       (let ((name (if (listp (cdr pair))
+			       (cadr pair)
+			     (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
+						(cdr pair))
+				  (intern (match-string 1 (cdr pair)))))))
+		 (when name
+		   (setq vars
+			 (cons (cons name pair)
+			       (if (member name (mapcar #'car vars))
+				   (delq nil
+					 (mapcar
+					  (lambda (p) (unless (equal (car p) name) p))
+					  vars))
+				 vars))))))
+	      (:results
+	       (setq results (e-merge results-exclusive-groups
+				      results (split-string (cdr pair)))))
+	      (:file
+	       (when (cdr pair)
+		 (setq results (e-merge results-exclusive-groups
+					results '("file")))
+		 (unless (or (member "both" exports)
+			     (member "none" exports)
+			     (member "code" exports))
+		   (setq exports (e-merge exports-exclusive-groups
+					  exports '("results"))))
+		 (setq params (cons pair (assq-delete-all (car pair) params)))))
+	      (:exports
+	       (setq exports (e-merge exports-exclusive-groups
+				      exports (split-string (cdr pair)))))
+	      (:tangle ;; take the latest -- always overwrite
+	       (setq tangle (or (list (cdr pair)) tangle)))
+	      (:noweb
+	       (setq noweb (e-merge '(("yes" "no")) noweb
+				    (split-string (or (cdr pair) "")))))
+	      (:cache
+	       (setq cache (e-merge '(("yes" "no")) cache
+				    (split-string (or (cdr pair) "")))))
+	      (:shebang ;; take the latest -- always overwrite
+	       (setq shebang (or (list (cdr pair)) shebang)))
+	      (:comments
+	       (setq comments (e-merge '(("yes" "no")) comments
+				       (split-string (or (cdr pair) "")))))
+	      (t ;; replace: this covers e.g. :session
+	       (setq params (cons pair (assq-delete-all (car pair) params))))))
+	  plist))
+       plists))
+    (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
     (cons (cons :comments (mapconcat 'identity comments " "))
           (cons (cons :shebang (mapconcat 'identity shebang " "))
                 (cons (cons :cache (mapconcat 'identity cache " "))

+ 10 - 0
testing/examples/babel.org

@@ -138,3 +138,13 @@
 #+begin_src emacs-lisp :var n=9
   (sqrt n)
 #+end_src
+* executing an lob call line
+  :PROPERTIES:
+  :results:  silent
+  :END:
+
+69fbe856-ca9c-4f20-9146-826d2f488c1d
+#+call: echo(input="testing")
+#+call: echo(input="testing") :results vector
+#+call: echo() :var input="testing"
+#+call: echo() :var input="testing" :results vector

+ 20 - 0
testing/lisp/test-ob-lob.el

@@ -26,6 +26,26 @@
   (should (< 0 (org-babel-lob-ingest
 		(expand-file-name "babel.org" org-test-example-dir)))))
 
+(ert-deftest test-ob-lob/call-with-header-arguments ()
+  "Test the evaluation of a library of babel #+call: line."
+  (org-test-at-marker
+      (expand-file-name "babel.org" org-test-example-dir)
+      "69fbe856-ca9c-4f20-9146-826d2f488c1d"
+    (move-beginning-of-line 1)
+    (forward-line 1)
+    (message (buffer-substring (point-at-bol) (point-at-eol)))
+    (should (string= "testing" (org-babel-lob-execute
+				(org-babel-lob-get-info))))
+    (forward-line 1)
+    (should (string= "testing" (caar (org-babel-lob-execute
+				      (org-babel-lob-get-info)))))
+    (forward-line 1)
+    (should (string= "testing" (org-babel-lob-execute
+    				(org-babel-lob-get-info))))
+    (forward-line 1)
+    (should (string= "testing" (caar (org-babel-lob-execute
+				      (org-babel-lob-get-info)))))))
+
 (provide 'test-ob-lob)
 
 ;;; test-ob-lob.el ends here