tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

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.
This commit is contained in:
Nicolas Goaziou 2016-06-16 22:16:41 +02:00
parent a04752d38c
commit dbb375fdfc
5 changed files with 93 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lisp/ob-exp.el
View File

@ -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

137
lisp/ob-lob.el
View File

@ -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)))))
(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)))))
(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
(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)

6
testing/examples/ob-header-arg-defaults.org
View File

@ -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

6
testing/lisp/test-ob-header-arg-defaults.el
View File

@ -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 ()

24
testing/lisp/test-ob-lob.el
View File

@ -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)