Browse Source

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 years ago
parent
commit
9738da4732
5 changed files with 95 additions and 111 deletions
  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 '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))
-    (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)
 (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,

+ 64 - 81
lisp/ob-core.el

@@ -245,39 +245,73 @@ Returns non-nil if match-data set"
 	t
 	t
       nil)))
       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
 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
- (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
 (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)
-	      ;; 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)
     (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

+ 15 - 20
lisp/ob-exp.el

@@ -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))
-			(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)))
 			(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,22 +411,19 @@ 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
-	   ((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)
 (provide 'ob-exp)

+ 0 - 2
testing/examples/babel.org

@@ -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.

+ 1 - 1
testing/lisp/test-ob.el

@@ -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)