瀏覽代碼

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.
Nicolas Goaziou 9 年之前
父節點
當前提交
9738da4732
共有 5 個文件被更改,包括 95 次插入111 次删除
  1. 15 7
      contrib/lisp/org-eldoc.el
  2. 64 81
      lisp/ob-core.el
  3. 15 20
      lisp/ob-exp.el
  4. 0 2
      testing/examples/babel.org
  5. 1 1
      testing/lisp/test-ob.el

+ 15 - 7
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,

+ 64 - 81
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

+ 15 - 20
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)

+ 0 - 2
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.

+ 1 - 1
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)