summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-10 00:22:09 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-02-10 23:50:45 +0100
commit9738da473277712804e0d004899388ad71c6b791 (patch)
treea5c162f6191a0b3bc5d7cc63c987af67592356d3
parentbd30a581027f867b1f1f1eb5638036cad43bb9d6 (diff)
downloadorg-mode-9738da473277712804e0d004899388ad71c6b791.tar.gz
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.
-rw-r--r--contrib/lisp/org-eldoc.el22
-rw-r--r--lisp/ob-core.el145
-rw-r--r--lisp/ob-exp.el35
-rw-r--r--testing/examples/babel.org2
-rw-r--r--testing/lisp/test-ob.el2
5 files changed, 95 insertions, 111 deletions
diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el
index 5583cb8..3b112a6 100644
--- a/contrib/lisp/org-eldoc.el
+++ b/contrib/lisp/org-eldoc.el
@@ -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,
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 99ef61a..0c98987 100644
--- a/lisp/ob-core.el
+++ b/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
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index d6ea362..dac00a9 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -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)
diff --git a/testing/examples/babel.org b/testing/examples/babel.org
index 80a43c4..4560db5 100644
--- a/testing/examples/babel.org
+++ b/testing/examples/babel.org
@@ -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.
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index cdbf375..07a69bb 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -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)