summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-06-16 22:16:41 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-06-16 23:15:01 +0200
commitdbb375fdfcf27ea447f0da004949200824c29e64 (patch)
treeffacb8c79ed2c9515af68fd41febc18184f7c858
parenta04752d38cde7e6bc7596aebb0f178816e746cbd (diff)
downloadorg-mode-dbb375fdfcf27ea447f0da004949200824c29e64.tar.gz
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.
-rw-r--r--lisp/ob-exp.el30
-rw-r--r--lisp/ob-lob.el139
-rw-r--r--testing/examples/ob-header-arg-defaults.org6
-rw-r--r--testing/lisp/test-ob-header-arg-defaults.el6
-rw-r--r--testing/lisp/test-ob-lob.el24
5 files changed, 94 insertions, 111 deletions
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 5b46114..6a0c554 100644
--- a/lisp/ob-exp.el
+++ b/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
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
index c713d9a..7d68092 100644
--- a/lisp/ob-lob.el
+++ b/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)
diff --git a/testing/examples/ob-header-arg-defaults.org b/testing/examples/ob-header-arg-defaults.org
index 997152e..23306c2 100644
--- a/testing/examples/ob-header-arg-defaults.org
+++ b/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
diff --git a/testing/lisp/test-ob-header-arg-defaults.el b/testing/lisp/test-ob-header-arg-defaults.el
index 07b2bea..604738f 100644
--- a/testing/lisp/test-ob-header-arg-defaults.el
+++ b/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 ()
diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el
index 9df26e1..cf7cde2 100644
--- a/testing/lisp/test-ob-lob.el
+++ b/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)