From 9738da473277712804e0d004899388ad71c6b791 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 10 Feb 2016 00:22:09 +0100 Subject: [PATCH] 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. --- contrib/lisp/org-eldoc.el | 22 ++++--- lisp/ob-core.el | 145 ++++++++++++++++++++------------------------- lisp/ob-exp.el | 35 +++++------ testing/examples/babel.org | 2 - testing/lisp/test-ob.el | 2 +- 5 files changed, 95 insertions(+), 111 deletions(-) diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el index 5583cb8f8..3b112a66a 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 99ef61ab3..0c98987c5 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 d6ea362de..dac00a9be 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 80a43c4c3..4560db533 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 cdbf375fe..07a69bbf3 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) -- 2.11.4.GIT