ob: Rewrite `org-babel-get-src-block-info' using parser

* lisp/ob-core.el (org-babel-get-src-block-info): Rewrite function.
  Change signature.
(org-babel-parse-src-block-match):
(org-babel-parse-inline-src-block-match): Remove functions.
(org-babel-execute-src-block): Remove useless function call.

* lisp/ob-exp.el (org-babel-exp-process-buffer): Make use of signature
  change.
(org-babel-exp-results): Use new return value from
`org-babel-get-src-block-info'.  Tiny refactoring.

* testing/lisp/test-ob.el (test-ob/nested-code-block): Fix test.
* contrib/lisp/org-eldoc.el (org-eldoc-get-src-lang): Use parser instead
  of removed function.

* testing/examples/babel.org: Fix test environment.
This commit is contained in:
Nicolas Goaziou 2016-02-10 00:22:09 +01:00
parent bd30a58102
commit 9738da4732
5 changed files with 95 additions and 111 deletions

View file

@ -38,6 +38,10 @@
(require 'ob-core) (require 'ob-core)
(require 'eldoc) (require 'eldoc)
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(defgroup org-eldoc nil "" :group 'org) (defgroup org-eldoc nil "" :group 'org)
(defcustom org-eldoc-breadcrumb-separator "/" (defcustom org-eldoc-breadcrumb-separator "/"
@ -87,13 +91,17 @@
(defun org-eldoc-get-src-lang () (defun org-eldoc-get-src-lang ()
"Return value of lang for the current block if in block body and nil otherwise." "Return value of lang for the current block if in block body and nil otherwise."
(let ((case-fold-search t)) (let ((element (save-match-data (org-element-at-point))))
(save-match-data (and (eq (org-element-type element) 'src-block)
(when (org-between-regexps-p ".*#\\+begin_src" (>= (line-beginning-position)
".*#\\+end_src") (org-element-property :post-affiliated element))
(save-excursion (<=
(goto-char (org-babel-where-is-src-block-head)) (line-end-position)
(car (org-babel-parse-src-block-match))))))) (org-with-wide-buffer
(goto-char (org-element-property :end element))
(skip-chars-backward " \t\n")
(line-end-position)))
(org-element-property :language element))))
(defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal) (defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal)
"Cache of major-mode's eldoc-documentation-functions, "Cache of major-mode's eldoc-documentation-functions,

View file

@ -245,39 +245,73 @@ Returns non-nil if match-data set"
t t
nil))) nil)))
(defun org-babel-get-src-block-info (&optional light) (defun org-babel-get-src-block-info (&optional light datum)
"Get information on the current source block. "Extract information from a source block or inline source block.
Optional argument LIGHT does not resolve remote variable Optional argument LIGHT does not resolve remote variable
references; a process which could likely result in the execution references; a process which could likely result in the execution
of other code blocks. of other code blocks.
Returns a list By default, consider the block at point. However, when optional
(language body header-arguments-alist switches name block-head)." argument DATUM is provided, extract information from that parsed
(let ((case-fold-search t) head info name indent) object instead.
;; full code block
(if (setq head (org-babel-where-is-src-block-head)) Return nil if point is not on a source block. Otherwise, return
(save-excursion a list with the following pattern:
(goto-char head)
(setq info (org-babel-parse-src-block-match)) \(language body header-arguments-alist switches name block-head)"
(while (and (= 0 (forward-line -1)) (let* ((datum (or datum (org-element-context)))
(looking-at org-babel-multi-line-header-regexp)) (type (org-element-type datum))
(setf (nth 2 info) (inline (eq type 'inline-src-block)))
(org-babel-merge-params (when (memq type '(inline-src-block src-block))
(nth 2 info) (let* ((lang (org-element-property :language datum))
(org-babel-parse-header-arguments (match-string 1))))) (lang-headers (intern
(when (looking-at (org-babel-named-src-block-regexp-for-name)) (concat "org-babel-default-header-args:" lang)))
(setq name (org-match-string-no-properties 9)))) (name (org-element-property :name datum))
;; inline source block (info
(when (org-babel-get-inline-src-block-matches) (list
(setq head (match-beginning 0)) lang
(setq info (org-babel-parse-inline-src-block-match)))) ;; Normalize contents. In particular, remove spurious
;; resolve variable references and add summary parameters ;; indentation and final newline character.
(when (and info (not light)) (let* ((value (org-element-property :value datum))
(body (if (and (> (length value) 1)
(string-match-p "\n\\'" value))
(substring value 0 -1)
value)))
(cond (inline
;; Newline characters and indentation in an
;; inline src-block are not meaningful, since
;; they could come from some paragraph
;; filling. Treat them as a white space.
(replace-regexp-in-string "\n[ \t]*" " " body))
((or org-src-preserve-indentation
(org-element-property :preserve-indent datum))
body)
(t (org-remove-indentation body))))
(apply #'org-babel-merge-params
(if inline org-babel-default-inline-header-args
org-babel-default-header-args)
(and (boundp lang-headers) (symbol-value lang-headers))
(append
;; If DATUM is provided, make sure we get node
;; properties applicable to its location within
;; the document.
(org-with-wide-buffer
(when datum
(goto-char (org-element-property :begin datum)))
(org-babel-params-from-properties lang))
(mapcar #'org-babel-parse-header-arguments
(cons
(org-element-property :parameters datum)
(org-element-property :header datum)))))
(or (org-element-property :switches datum) "")
name
(org-element-property (if inline :begin :post-affiliated)
datum))))
(unless light
(setf (nth 2 info) (org-babel-process-params (nth 2 info)))) (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
(when info (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
(setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))) info))))
(when info (append info (list name head)))))
(defvar org-babel-exp-reference-buffer nil (defvar org-babel-exp-reference-buffer nil
"Buffer containing original contents of the exported buffer. "Buffer containing original contents of the exported buffer.
@ -642,13 +676,8 @@ block."
(let* ((org-babel-current-src-block-location (let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location (or org-babel-current-src-block-location
(nth 5 info) (nth 5 info)
(org-babel-where-is-src-block-head) (org-babel-where-is-src-block-head)))
;; inline src block (info (if info (copy-tree info) (org-babel-get-src-block-info))))
(and (org-babel-get-inline-src-block-matches)
(match-beginning 0))))
(info (if info
(copy-tree info)
(org-babel-get-src-block-info))))
(cl-callf org-babel-merge-params (nth 2 info) params) (cl-callf org-babel-merge-params (nth 2 info) params)
(when (org-babel-check-evaluate info) (when (org-babel-check-evaluate info)
(cl-callf org-babel-process-params (nth 2 info)) (cl-callf org-babel-process-params (nth 2 info))
@ -1456,52 +1485,6 @@ specified in the properties of the current outline entry."
(concat "header-args:" lang) (concat "header-args:" lang)
'inherit)))))) 'inherit))))))
(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
(defun org-babel-parse-src-block-match ()
"Parse the results from a match of the `org-babel-src-block-regexp'."
(let* ((lang (org-match-string-no-properties 2))
(lang-headers (intern (concat "org-babel-default-header-args:" lang)))
(switches (match-string 3))
(body (let* ((body (org-match-string-no-properties 5))
(sub-length (- (length body) 1)))
(if (and (> sub-length 0)
(string= "\n" (substring body sub-length)))
(substring body 0 sub-length)
(or body ""))))
(preserve-indentation (or org-src-preserve-indentation
(save-match-data
(string-match "-i\\>" switches)))))
(list lang
;; get block body less properties, protective commas, and indentation
(with-temp-buffer
(save-match-data
(insert (org-unescape-code-in-string body))
(unless preserve-indentation (org-do-remove-indentation))
(buffer-string)))
(apply #'org-babel-merge-params
org-babel-default-header-args
(when (boundp lang-headers) (eval lang-headers))
(append
(org-babel-params-from-properties lang)
(list (org-babel-parse-header-arguments
(org-no-properties (or (match-string 4) ""))))))
switches)))
(defun org-babel-parse-inline-src-block-match ()
"Parse the results from a match of the `org-babel-inline-src-block-regexp'."
(let* ((lang (org-no-properties (match-string 2)))
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-unescape-code-in-string (org-no-properties (match-string 5)))
(apply #'org-babel-merge-params
org-babel-default-inline-header-args
(if (boundp lang-headers) (eval lang-headers) nil)
(append
(org-babel-params-from-properties lang)
(list (org-babel-parse-header-arguments
(org-no-properties (or (match-string 4) ""))))))
nil)))
(defun org-babel-balanced-split (string alts) (defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS. "Split STRING on instances of ALTS.
ALTS is a cons of two character options where each option may be ALTS is a cons of two character options where each option may be

View file

@ -186,9 +186,7 @@ may make them unreachable."
(point))))) (point)))))
(case type (case type
(inline-src-block (inline-src-block
(let* ((head (match-beginning 0)) (let* ((info (org-babel-get-src-block-info nil element))
(info (append (org-babel-parse-inline-src-block-match)
(list nil nil head)))
(params (nth 2 info))) (params (nth 2 info)))
(setf (nth 1 info) (setf (nth 1 info)
(if (and (cdr (assoc :noweb params)) (if (and (cdr (assoc :noweb params))
@ -402,7 +400,7 @@ inhibit insertion of results into the buffer."
(nth 1 info))) (nth 1 info)))
(info (copy-sequence info)) (info (copy-sequence info))
(org-babel-current-src-block-location (point-marker))) (org-babel-current-src-block-location (point-marker)))
;; skip code blocks which we can't evaluate ;; Skip code blocks which we can't evaluate.
(when (fboundp (intern (concat "org-babel-execute:" lang))) (when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer) (org-babel-eval-wipe-error-buffer)
(prog1 nil (prog1 nil
@ -413,18 +411,15 @@ inhibit insertion of results into the buffer."
(org-babel-merge-params (org-babel-merge-params
(nth 2 info) (nth 2 info)
`((:results . ,(if silent "silent" "replace"))))))) `((:results . ,(if silent "silent" "replace")))))))
(cond (pcase type
((equal type 'block) (`block (org-babel-execute-src-block nil info))
(`inline
;; Position the point on the inline source block
;; allowing `org-babel-insert-result' to check that the
;; block is inline.
(goto-char (nth 5 info))
(org-babel-execute-src-block nil info)) (org-babel-execute-src-block nil info))
((equal type 'inline) (`lob
;; position the point on the inline source block allowing
;; `org-babel-insert-result' to check that the block is
;; inline
(re-search-backward "[ \f\t\n\r\v]" nil t)
(re-search-forward org-babel-inline-src-block-regexp nil t)
(re-search-backward "src_" nil t)
(org-babel-execute-src-block nil info))
((equal type 'lob)
(save-excursion (save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t) (re-search-backward org-babel-lob-one-liner-regexp nil t)
(let (org-confirm-babel-evaluate) (let (org-confirm-babel-evaluate)

View file

@ -193,7 +193,6 @@ an = sign.
* inline source block * inline source block
:PROPERTIES: :PROPERTIES:
:results: silent
:ID: 54cb8dc3-298c-4883-a933-029b3c9d4b18 :ID: 54cb8dc3-298c-4883-a933-029b3c9d4b18
:END: :END:
Here is one in the middle src_sh{echo 1} of a line. Here is one in the middle src_sh{echo 1} of a line.
@ -203,7 +202,6 @@ src_sh{echo 3} Here is one at the beginning of a line.
* exported inline source block * exported inline source block
:PROPERTIES: :PROPERTIES:
:ID: cd54fc88-1b6b-45b6-8511-4d8fa7fc8076 :ID: cd54fc88-1b6b-45b6-8511-4d8fa7fc8076
:results: silent
:exports: code :exports: code
:END: :END:
Here is one in the middle src_sh{echo 1} of a line. Here is one in the middle src_sh{echo 1} of a line.

View file

@ -536,7 +536,7 @@ duplicate results block."
(string= "#+begin_src emacs-lisp\n 'foo\n#+end_src" (string= "#+begin_src emacs-lisp\n 'foo\n#+end_src"
(org-test-with-temp-text "#+begin_src org :results silent (org-test-with-temp-text "#+begin_src org :results silent
,#+begin_src emacs-lisp ,#+begin_src emacs-lisp
, 'foo 'foo
,#+end_src ,#+end_src
#+end_src" #+end_src"
(let ((org-edit-src-content-indentation 2) (let ((org-edit-src-content-indentation 2)