Browse Source

Simplify Babel calls evaluation

* lisp/ob-lob.el (org-babel-default-lob-header-args): Merge value with
  `org-babel-default-header-args' since this variable is meant to
  replace the latter.
(org-babel-lob-ingest): Make sure `org-babel-default-lob-header-args' is
used instead of `org-babel-default-header-args'.
(org-babel-lob--src-info): New function.
(org-babel-lob-get-info): Use new function.  Make return value
a replacement for `org-babel-get-src-block-info'.
(org-babel-lob-execute): Use `org-babel-execute-src-block' instead of
duplicating functionalities.
* lisp/ob-exp.el (org-babel-exp-process-buffer): Apply changes to
  `org-babel-lob-get-info' return value.

* testing/examples/ob-header-arg-defaults.org:
* testing/lisp/test-ob-header-arg-defaults.el (test-ob-header-arg-defaults/tree/accumulate/call):
(test-ob-header-arg-defaults/tree/complex/call):
(test-ob-header-arg-defaults/tree/overwrite/call):
* testing/lisp/test-ob-lob.el (test-ob-lob/caching-call-line):
(test-ob-lob/named-caching-call-line): Update tests.

The purpose of this commit is to make Babel calls more
predictable (e.g., wrt property inheritance) and to remove code
duplication.  Also, Babel calls results are no longer treated as Emacs
Lisp values.
Nicolas Goaziou 5 years ago
parent
commit
dbb375fdfc

+ 8 - 22
lisp/ob-exp.el

@@ -206,28 +206,14 @@ may make them unreachable."
 			 (delete-region begin end)
 			 (insert replacement)))))
 		  ((babel-call inline-babel-call)
-		   (let* ((lob-info (org-babel-lob-get-info element))
-			  (results
-			   (org-babel-exp-do-export
-			    (list "emacs-lisp" "results"
-				  (apply #'org-babel-merge-params
-					 org-babel-default-header-args
-					 org-babel-default-lob-header-args
-					 (append
-					  (org-babel-params-from-properties)
-					  (list
-					   (org-babel-parse-header-arguments
-					    (org-no-properties
-					     (concat
-					      ":var results="
-					      (mapconcat #'identity
-							 (butlast lob-info 2)
-							 " ")))))))
-				  "" (nth 2 lob-info) (nth 3 lob-info))
-			    'lob))
-			  (rep (org-fill-template
-				org-babel-exp-call-line-template
-				`(("line"  . ,(nth 0 lob-info))))))
+		   (let ((results (org-babel-exp-do-export
+				   (org-babel-lob-get-info element)
+				   'lob))
+			 (rep
+			  (org-fill-template
+			   org-babel-exp-call-line-template
+			   `(("line"  .
+			      ,(org-element-property :value element))))))
 		     ;; If replacement is empty, completely remove the
 		     ;; object/element, including any extra white
 		     ;; space that might have been created when

+ 76 - 63
lisp/ob-lob.el

@@ -27,6 +27,7 @@
 (require 'ob-core)
 (require 'ob-table)
 
+(declare-function org-element-at-point "org-element" ())
 (declare-function org-element-context "org-element" (&optional element))
 (declare-function org-element-property "org-element" (property element))
 (declare-function org-element-type "org-element" (element))
@@ -43,15 +44,24 @@ To add files to this list use the `org-babel-lob-ingest' command."
   :version "24.1"
   :type '(repeat file))
 
-(defvar org-babel-default-lob-header-args '((:exports . "results"))
-  "Default header arguments to use when exporting #+lob/call lines.")
+(defvar org-babel-default-lob-header-args
+  '((:cache . "no")
+    (:exports . "results")
+    (:hlines . "no")
+    (:noweb . "no")
+    (:results . "replace")
+    (:session . "none")
+    (:tangle . "no"))
+  "Default header arguments to use when exporting Babel calls.")
 
 (defun org-babel-lob-ingest (&optional file)
   "Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
   (interactive "fFile: ")
   (let ((lob-ingest-count 0))
     (org-babel-map-src-blocks file
-      (let* ((info (org-babel-get-src-block-info 'light))
+      (let* ((info (let ((org-babel-default-header-args
+			  org-babel-default-lob-header-args))
+		     (org-babel-get-src-block-info 'light)))
 	     (source-name (nth 4 info)))
 	(when source-name
 	  (setq source-name (intern source-name)
@@ -76,73 +86,76 @@ if so then run the appropriate source block from the Library."
       (org-babel-lob-execute info)
       t)))
 
+(defun org-babel-lob--src-info (name)
+  "Return internal representation for Babel data named NAME.
+NAME is a string.  This function looks into the current document
+for a Babel call or source block.  If none is found, it looks
+after NAME in the Library of Babel.  Eventually, if that also
+fails, it Returns nil."
+  ;; During export, look into the pristine copy of the document being
+  ;; exported instead of the current one, which could miss some data.
+  (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
+    (org-with-wide-buffer
+     (goto-char (point-min))
+     (catch :found
+       (let ((case-fold-search t)
+	     (regexp (org-babel-named-data-regexp-for-name name)))
+	 (while (re-search-forward regexp nil t)
+	   (let ((element (org-element-at-point)))
+	     (when (equal name (org-element-property :name element))
+	       (throw :found
+		      (pcase (org-element-type element)
+			(`src-block (let ((org-babel-default-header-args
+					   org-babel-default-lob-header-args))
+				      (org-babel-get-src-block-info t element)))
+			(`babel-call (org-babel-lob-get-info element))
+			;; Non-executable data found.  Since names are
+			;; supposed to be unique throughout a document,
+			;; bail out.
+			(_ nil))))))
+	 ;; No element named NAME in buffer.  Try Library of Babel.
+	 (cdr (assoc-string name org-babel-library-of-babel)))))))
+
 ;;;###autoload
 (defun org-babel-lob-get-info (&optional datum)
-  "Return a Library of Babel function call as a string.
-Return nil when not on an appropriate location.  Build string
-from `inline-babel-call' or `babel-call' DATUM, when provided."
+  "Return internal representation for Library of Babel function call.
+Consider DATUM, when provided, or element at point.  Return nil
+when not on an appropriate location.  Otherwise return a list
+compatible with `org-babel-get-src-block-info', which see."
   (let* ((context (or datum (org-element-context)))
 	 (type (org-element-type context)))
     (when (memq type '(babel-call inline-babel-call))
-      (list (format "%s%s(%s)"
-		    (org-element-property :call context)
-		    (let ((in (org-element-property :inside-header context)))
-		      (if in (format "[%s]" in) ""))
-		    (or (org-element-property :arguments context) ""))
-	    (org-element-property :end-header context)
-	    (org-element-property :name context)
-	    (org-element-property
-	     (if (eq type 'babel-call) :post-affiliated :begin)
-	     datum)))))
-
-(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
+      (pcase (org-babel-lob--src-info (org-element-property :call context))
+	(`(,language ,body ,header ,_ ,_ ,_)
+	 (let ((begin (org-element-property (if (eq type 'inline-babel-call)
+						:begin
+					      :post-affiliated)
+					    context)))
+	   (list language
+		 body
+		 (apply #'org-babel-merge-params
+			header
+			(append
+			 (org-with-wide-buffer
+			  (goto-char begin)
+			  (org-babel-params-from-properties language))
+			 (list
+			  (org-babel-parse-header-arguments
+			   (org-element-property :inside-header context))
+			  (let ((args (org-element-property :arguments context)))
+			    (and args
+				 (mapcar (lambda (ref) (cons :var ref))
+					 (org-babel-ref-split-args args))))
+			  (org-babel-parse-header-arguments
+			   (org-element-property :end-header context)))))
+		 nil
+		 (org-element-property :name context)
+		 begin)))
+	(_ nil)))))
+
 (defun org-babel-lob-execute (info)
   "Execute the lob call specified by INFO."
-  (let* ((mkinfo (lambda (p)
-		   ;; Make plist P compatible with
-		   ;; `org-babel-get-src-block-info'.
-		   (list
-		    "emacs-lisp" "results" p nil (nth 2 info) (nth 3 info))))
-	 (pre-params
-	  (apply #'org-babel-merge-params
-		 org-babel-default-header-args
-		 org-babel-default-header-args:emacs-lisp
-		 (append
-		  (org-babel-params-from-properties)
-		  (list
-		   (org-babel-parse-header-arguments
-		    (org-no-properties
-		     (concat ":var results="
-			     (mapconcat #'identity (butlast info 2) " "))))))))
-	 (pre-info (funcall mkinfo pre-params))
-	 (cache-p (and (cdr (assoc :cache pre-params))
-		       (string= "yes" (cdr (assoc :cache pre-params)))))
-	 (new-hash (when cache-p
-		     (org-babel-sha1-hash
-		      ;; Do *not* pre-process params for call line
-		      ;; hash evaluation, since for a call line :var
-		      ;; extension *is* execution.
-		      (let* ((params (nth 2 pre-info))
-			     (sha1-nth2 (list
-				    (cons
-				     (cons :c-var (cdr (assoc :var params)))
-				     (assq-delete-all :var (copy-tree params)))))
-			     (sha1-info (copy-tree pre-info)))
-			(prog1 sha1-info
-			  (setcar (cddr sha1-info) sha1-nth2))))))
-	 (old-hash (when cache-p (org-babel-current-result-hash pre-info)))
-	 (org-babel-current-src-block-location (point-marker)))
-    (if (and cache-p (equal new-hash old-hash))
-	(save-excursion (goto-char (org-babel-where-is-src-block-result
-				    nil pre-info))
-			(forward-line 1)
-			(message "%S" (org-babel-read-result)))
-      (prog1 (let* ((proc-params (org-babel-process-params pre-params))
-		     org-confirm-babel-evaluate)
-	       (org-babel-execute-src-block nil (funcall mkinfo proc-params)))
-	;; update the hash
-	(when new-hash
-	  (org-babel-set-current-result-hash new-hash pre-info))))))
+  (org-babel-execute-src-block nil info))
 
 (provide 'ob-lob)
 

+ 3 - 3
testing/examples/ob-header-arg-defaults.org

@@ -58,7 +58,7 @@
 | header-args            | --- | --- | --- | --- | --- | --- | th7 | --- | --- |
 | header-args:emacs-lisp | --- | --- | --- | --- | --- | --- | --- | te8 | --- |
 |------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
-| Result #+CALL          | go1 | go2 | go3 | --4 | --5 | --- | th7 | te8 | --9 |
+| Result #+CALL          | ge1 | gh2 | go3 | ge4 | ge5 | to6 | th7 | te8 | --9 |
 | Result noweb           | --1 | --2 | --3 | --4 | --5 | to6 | th7 | te8 | --9 |
 
 #+CALL: showvar() :results silent
@@ -87,7 +87,7 @@
 | header-args+            | --- | th2 | th3 | --- | --- | --- | --- | --- | --- |
 | header-args:emacs-lisp+ | --- | --- | --- | --- | te5 | --- | --- | --- | --- |
 |-------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
-| Result #+CALL           | ge1 | th2 | th3 | ge4 | te5 | --6 | --7 | --8 | --9 |
+| Result #+CALL           | ge1 | th2 | th3 | ge4 | te5 | to6 | --7 | --8 | --9 |
 | Result noweb            | ge1 | th2 | th3 | ge4 | te5 | to6 | --7 | --8 | --9 |
 
 #+CALL: showvar(end=6) :results silent
@@ -117,7 +117,7 @@
 | header-args+           | --- | th2 | --- | --- | --- | --- | --- | --- | --- |
 | header-args:emacs-lisp | --- | --- | --- | --- | te5 | --- | --- | --- | --- |
 |------------------------+-----+-----+-----+-----+-----+-----+-----+-----+-----|
-| Result #+CALL          | gh1 | th2 | go3 | gh4 | te5 | --6 | --7 | --8 | --9 |
+| Result #+CALL          | gh1 | th2 | go3 | gh4 | te5 | to6 | --7 | --8 | --9 |
 | Result noweb           | gh1 | th2 | --3 | gh4 | te5 | to6 | --7 | --8 | --9 |
 
 #+CALL: showvar(end=6) :results silent

+ 3 - 3
testing/lisp/test-ob-header-arg-defaults.el

@@ -37,7 +37,7 @@
   (org-test-at-id "a9cdfeda-9f31-4bb5-b694-2cf452f07dfd"
    (org-babel-next-src-block 1)
    (forward-line -1)
-   (should (equal "go1/go2/go3/--4/--5/--6/th7/te8/--9"
+   (should (equal "ge1/gh2/go3/ge4/ge5/to6/th7/te8/--9"
 		  (org-babel-lob-execute (org-babel-lob-get-info))))))
 
 (ert-deftest test-ob-header-arg-defaults/tree/overwrite/noweb ()
@@ -50,7 +50,7 @@
   (org-test-at-id "1d97d258-fd50-4107-a095-e4625bffc57b"
    (org-babel-next-src-block 1)
    (forward-line -1)
-   (should (equal "ge1/th2/th3/ge4/te5/--6"
+   (should (equal "ge1/th2/th3/ge4/te5/to6"
 		  (org-babel-lob-execute (org-babel-lob-get-info))))))
 
 (ert-deftest test-ob-header-arg-defaults/tree/accumulate/noweb ()
@@ -63,7 +63,7 @@
   (org-test-at-id "fa0e912d-d9b4-47b0-9f9e-1cbb39f7cbc2"
    (org-babel-next-src-block 1)
    (forward-line -1)
-   (should (equal "gh1/th2/go3/gh4/te5/--6"
+   (should (equal "gh1/th2/go3/gh4/te5/to6"
 		  (org-babel-lob-execute (org-babel-lob-get-info))))))
 
 (ert-deftest test-ob-header-arg-defaults/tree/complex/noweb ()

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

@@ -115,20 +115,12 @@ for export
   (setq temporary-value-for-test (+ 1 temporary-value-for-test))
 #+end_src
 
-#+call: call-line-caching-example(\"qux\") :cache yes
+<point>#+call: call-line-caching-example(\"qux\") :cache yes
 "
-      (goto-char (point-max)) (forward-line -1)
       ;; first execution should flip value to t
       (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) 1))
       ;; if cached, second evaluation will retain the t value
-      ;;
-      ;; Note: This instance tests for equality with "1".  We would
-      ;; prefer if the cached result returned was actually 1, however
-      ;; this is not the current behavior so this test is encoding
-      ;; undesired behavior (because the current goal is simply to see
-      ;; that caching is used on call lines).
-      ;;
-      (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) "1")))))
+      (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) 1)))))
 
 (ert-deftest test-ob-lob/named-caching-call-line ()
   (let ((temporary-value-for-test 0))
@@ -139,20 +131,12 @@ for export
 #+end_src
 
 #+name: call-line-caching-called
-#+call: call-line-caching-example(\"qux\") :cache yes
+<point>#+call: call-line-caching-example(\"qux\") :cache yes
 "
-      (goto-char (point-max)) (forward-line -1)
       ;; first execution should flip value to t
       (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) 1))
       ;; if cached, second evaluation will retain the t value
-      ;;
-      ;; Note: This instance tests for equality with "1".  We would
-      ;; prefer if the cached result returned was actually 1, however
-      ;; this is not the current behavior so this test is encoding
-      ;; undesired behavior (because the current goal is simply to see
-      ;; that caching is used on call lines).
-      ;;
-      (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) "1")))))
+      (should (equal (org-babel-lob-execute (org-babel-lob-get-info)) 1)))))
 
 (provide 'test-ob-lob)