From dbb375fdfcf27ea447f0da004949200824c29e64 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 16 Jun 2016 22:16:41 +0200 Subject: [PATCH] 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. --- lisp/ob-exp.el | 30 ++--- lisp/ob-lob.el | 137 +++++++++++--------- testing/examples/ob-header-arg-defaults.org | 6 +- testing/lisp/test-ob-header-arg-defaults.el | 6 +- testing/lisp/test-ob-lob.el | 24 +--- 5 files changed, 93 insertions(+), 110 deletions(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 5b4611425..6a0c554c1 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 c713d9a45..7d680920f 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))))) + (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) diff --git a/testing/examples/ob-header-arg-defaults.org b/testing/examples/ob-header-arg-defaults.org index 997152ef5..23306c227 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 07b2beab1..604738fdb 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 9df26e181..cf7cde2cc 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 +#+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 +#+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)