forked from mirrors/org-mode
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:
parent
bd30a58102
commit
9738da4732
|
@ -38,6 +38,10 @@
|
|||
(require 'ob-core)
|
||||
(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)
|
||||
|
||||
(defcustom org-eldoc-breadcrumb-separator "/"
|
||||
|
@ -87,13 +91,17 @@
|
|||
|
||||
(defun org-eldoc-get-src-lang ()
|
||||
"Return value of lang for the current block if in block body and nil otherwise."
|
||||
(let ((case-fold-search t))
|
||||
(save-match-data
|
||||
(when (org-between-regexps-p ".*#\\+begin_src"
|
||||
".*#\\+end_src")
|
||||
(save-excursion
|
||||
(goto-char (org-babel-where-is-src-block-head))
|
||||
(car (org-babel-parse-src-block-match)))))))
|
||||
(let ((element (save-match-data (org-element-at-point))))
|
||||
(and (eq (org-element-type element) 'src-block)
|
||||
(>= (line-beginning-position)
|
||||
(org-element-property :post-affiliated element))
|
||||
(<=
|
||||
(line-end-position)
|
||||
(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)
|
||||
"Cache of major-mode's eldoc-documentation-functions,
|
||||
|
|
145
lisp/ob-core.el
145
lisp/ob-core.el
|
@ -245,39 +245,73 @@ Returns non-nil if match-data set"
|
|||
t
|
||||
nil)))
|
||||
|
||||
(defun org-babel-get-src-block-info (&optional light)
|
||||
"Get information on the current source block.
|
||||
(defun org-babel-get-src-block-info (&optional light datum)
|
||||
"Extract information from a source block or inline source block.
|
||||
|
||||
Optional argument LIGHT does not resolve remote variable
|
||||
references; a process which could likely result in the execution
|
||||
of other code blocks.
|
||||
|
||||
Returns a list
|
||||
(language body header-arguments-alist switches name block-head)."
|
||||
(let ((case-fold-search t) head info name indent)
|
||||
;; full code block
|
||||
(if (setq head (org-babel-where-is-src-block-head))
|
||||
(save-excursion
|
||||
(goto-char head)
|
||||
(setq info (org-babel-parse-src-block-match))
|
||||
(while (and (= 0 (forward-line -1))
|
||||
(looking-at org-babel-multi-line-header-regexp))
|
||||
(setf (nth 2 info)
|
||||
(org-babel-merge-params
|
||||
(nth 2 info)
|
||||
(org-babel-parse-header-arguments (match-string 1)))))
|
||||
(when (looking-at (org-babel-named-src-block-regexp-for-name))
|
||||
(setq name (org-match-string-no-properties 9))))
|
||||
;; inline source block
|
||||
(when (org-babel-get-inline-src-block-matches)
|
||||
(setq head (match-beginning 0))
|
||||
(setq info (org-babel-parse-inline-src-block-match))))
|
||||
;; resolve variable references and add summary parameters
|
||||
(when (and info (not light))
|
||||
(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))))
|
||||
(when info (append info (list name head)))))
|
||||
By default, consider the block at point. However, when optional
|
||||
argument DATUM is provided, extract information from that parsed
|
||||
object instead.
|
||||
|
||||
Return nil if point is not on a source block. Otherwise, return
|
||||
a list with the following pattern:
|
||||
|
||||
\(language body header-arguments-alist switches name block-head)"
|
||||
(let* ((datum (or datum (org-element-context)))
|
||||
(type (org-element-type datum))
|
||||
(inline (eq type 'inline-src-block)))
|
||||
(when (memq type '(inline-src-block src-block))
|
||||
(let* ((lang (org-element-property :language datum))
|
||||
(lang-headers (intern
|
||||
(concat "org-babel-default-header-args:" lang)))
|
||||
(name (org-element-property :name datum))
|
||||
(info
|
||||
(list
|
||||
lang
|
||||
;; Normalize contents. In particular, remove spurious
|
||||
;; indentation and final newline character.
|
||||
(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-generate-file-param name (nth 2 info)))
|
||||
info))))
|
||||
|
||||
(defvar org-babel-exp-reference-buffer nil
|
||||
"Buffer containing original contents of the exported buffer.
|
||||
|
@ -642,13 +676,8 @@ block."
|
|||
(let* ((org-babel-current-src-block-location
|
||||
(or org-babel-current-src-block-location
|
||||
(nth 5 info)
|
||||
(org-babel-where-is-src-block-head)
|
||||
;; inline src block
|
||||
(and (org-babel-get-inline-src-block-matches)
|
||||
(match-beginning 0))))
|
||||
(info (if info
|
||||
(copy-tree info)
|
||||
(org-babel-get-src-block-info))))
|
||||
(org-babel-where-is-src-block-head)))
|
||||
(info (if info (copy-tree info) (org-babel-get-src-block-info))))
|
||||
(cl-callf org-babel-merge-params (nth 2 info) params)
|
||||
(when (org-babel-check-evaluate 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)
|
||||
'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)
|
||||
"Split STRING on instances of ALTS.
|
||||
ALTS is a cons of two character options where each option may be
|
||||
|
|
|
@ -186,9 +186,7 @@ may make them unreachable."
|
|||
(point)))))
|
||||
(case type
|
||||
(inline-src-block
|
||||
(let* ((head (match-beginning 0))
|
||||
(info (append (org-babel-parse-inline-src-block-match)
|
||||
(list nil nil head)))
|
||||
(let* ((info (org-babel-get-src-block-info nil element))
|
||||
(params (nth 2 info)))
|
||||
(setf (nth 1 info)
|
||||
(if (and (cdr (assoc :noweb params))
|
||||
|
@ -402,7 +400,7 @@ inhibit insertion of results into the buffer."
|
|||
(nth 1 info)))
|
||||
(info (copy-sequence info))
|
||||
(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)))
|
||||
(org-babel-eval-wipe-error-buffer)
|
||||
(prog1 nil
|
||||
|
@ -413,22 +411,19 @@ inhibit insertion of results into the buffer."
|
|||
(org-babel-merge-params
|
||||
(nth 2 info)
|
||||
`((:results . ,(if silent "silent" "replace")))))))
|
||||
(cond
|
||||
((equal type 'block)
|
||||
(org-babel-execute-src-block nil info))
|
||||
((equal type 'inline)
|
||||
;; 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
|
||||
(re-search-backward org-babel-lob-one-liner-regexp nil t)
|
||||
(let (org-confirm-babel-evaluate)
|
||||
(org-babel-execute-src-block nil info))))))))))
|
||||
(pcase type
|
||||
(`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))
|
||||
(`lob
|
||||
(save-excursion
|
||||
(re-search-backward org-babel-lob-one-liner-regexp nil t)
|
||||
(let (org-confirm-babel-evaluate)
|
||||
(org-babel-execute-src-block nil info))))))))))
|
||||
|
||||
|
||||
(provide 'ob-exp)
|
||||
|
|
|
@ -193,7 +193,6 @@ an = sign.
|
|||
|
||||
* inline source block
|
||||
:PROPERTIES:
|
||||
:results: silent
|
||||
:ID: 54cb8dc3-298c-4883-a933-029b3c9d4b18
|
||||
:END:
|
||||
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
|
||||
:PROPERTIES:
|
||||
:ID: cd54fc88-1b6b-45b6-8511-4d8fa7fc8076
|
||||
:results: silent
|
||||
:exports: code
|
||||
:END:
|
||||
Here is one in the middle src_sh{echo 1} of a line.
|
||||
|
|
|
@ -536,7 +536,7 @@ duplicate results block."
|
|||
(string= "#+begin_src emacs-lisp\n 'foo\n#+end_src"
|
||||
(org-test-with-temp-text "#+begin_src org :results silent
|
||||
,#+begin_src emacs-lisp
|
||||
, 'foo
|
||||
'foo
|
||||
,#+end_src
|
||||
#+end_src"
|
||||
(let ((org-edit-src-content-indentation 2)
|
||||
|
|
Loading…
Reference in a new issue