瀏覽代碼

Fix `org-babel-where-is-src-block-result'

* lisp/ob-core.el (org-babel--insert-results-keyword):
(org-babel--clear-results-maybe): New functions.
(org-babel-where-is-src-block-result): Rewrite function.  Improve
accuracy, in particular when RESULTS is not the closest affiliated
keyword from the results.

* testing/lisp/test-ob.el (test-ob/where-is-src-block-result): New test.
Nicolas Goaziou 9 年之前
父節點
當前提交
e079c02016
共有 2 個文件被更改,包括 229 次插入94 次删除
  1. 117 94
      lisp/ob-core.el
  2. 112 0
      testing/lisp/test-ob.el

+ 117 - 94
lisp/ob-core.el

@@ -1917,103 +1917,126 @@ region is not active then the point is demarcated."
 			(funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")))
 	(goto-char start) (move-end-of-line 1)))))
 
-(defvar org-babel-lob-one-liner-regexp)
-(defun org-babel-where-is-src-block-result (&optional insert info hash)
+(defun org-babel--insert-results-keyword (name hash)
+  "Insert RESULTS keyword with NAME value at point.
+If NAME is nil, results are anonymous.  HASH is a string used as
+the results hash, or nil.  Leave point before the keyword."
+  (save-excursion (insert "\n"))	;open line to indent.
+  (org-indent-line)
+  (delete-char 1)
+  (insert (concat "#+" org-babel-results-keyword
+		  (cond ((not hash) nil)
+			(org-babel-hash-show-time
+			 (format "[%s %s]"
+				 (format-time-string "<%Y-%m-%d %H:%M:%S>")
+				 hash))
+			(t (format "[%s]" hash)))
+		  ":"
+		  (when name (concat " " name))
+		  "\n\n"))
+  (beginning-of-line -1)
+  (when hash (org-babel-hide-hash)))
+
+(defun org-babel--clear-results-maybe (hash)
+  "Clear results when hash doesn't match HASH.
+
+When results hash does not match HASH, remove RESULTS keyword at
+point, along with related contents.  Do nothing if HASH is nil.
+
+Return a non-nil value if results were cleared.  In this case,
+leave point where new results should be inserted."
+  (when hash
+    (looking-at org-babel-result-regexp)
+    (unless (string= (match-string 1) hash)
+      (let* ((e (org-element-at-point))
+	     (post (copy-marker (org-element-property :post-affiliated e))))
+	;; Delete contents.
+	(delete-region post
+		       (save-excursion
+			 (goto-char (org-element-property :end e))
+			 (skip-chars-backward " \t\n")
+			 (line-beginning-position 2)))
+	;; Delete RESULT keyword.  However, if RESULTS keyword is
+	;; orphaned, ignore this part.  The deletion above already
+	;; took care of it.
+	(unless (= (point) post)
+	  (delete-region (line-beginning-position)
+			 (line-beginning-position 2)))
+	(goto-char post)
+	(set-marker post nil)))
+    t))
+
+(defun org-babel-where-is-src-block-result (&optional insert _info hash)
   "Find where the current source block results begin.
+
 Return the point at the beginning of the result of the current
-source block.  Specifically at the beginning of the results line.
-If no result exists for this block then create a results line
-following the source block."
-  (save-excursion
-    (let* ((case-fold-search t)
-	   (on-lob-line (save-excursion
-			  (beginning-of-line 1)
-			  (looking-at org-babel-lob-one-liner-regexp)))
-	   (inlinep (when (org-babel-get-inline-src-block-matches)
-		      (match-end 0)))
-	   (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
-	   (head (unless on-lob-line (org-babel-where-is-src-block-head)))
-	   found beg end ind)
-      (when head (goto-char head))
+source block, specifically at the beginning of the results line.
+
+If no result exists for this block return nil, unless optional
+argument INSERT is non-nil.  In this case, create a results line
+following the source block and return the position at its
+beginning.
+
+If optional argument HASH is a string, remove contents related to
+RESULTS keyword if its hash is different.  Then update the latter
+to HASH."
+  (let ((context (org-element-context)))
+    (catch :found
       (org-with-wide-buffer
-       (setq
-	found ;; was there a result (before we potentially insert one)
-	(or
-	 inlinep
-	 ;; named results:
-	 ;; - if it does not need to be rebuilt, then don't set END
-	 ;; - if it does need to be rebuilt then do set END
-	 (and
-	  name
-	  (setq beg (org-babel-find-named-result name))
-	  (prog1 beg
-	    (goto-char beg)
-	    (setq ind (org-get-indentation))
-	    (when hash
-	      (looking-at org-babel-result-regexp)
-	      (unless (string= (match-string 1) hash)
-		(setq end beg)
-		(let ((element (org-element-at-point)))
-		  (delete-region
-		   (org-element-property :begin element)
-		   (progn (goto-char (org-element-property :end element))
-			  (skip-chars-backward " \t\n")
-			  (line-beginning-position 2))))))))
-	 (and
-	  ;; unnamed results:
-	  ;; - return t if it is found, else return nil
-	  ;; - if it is found, and the hash doesn't match, delete and set end
-	  (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
-	  (progn (end-of-line 1)
-		 (if (eobp) (insert "\n") (forward-char 1))
-		 (setq end (point))
-		 (and
-		  (not name)
-		  (progn ;; unnamed results line already exists
-		    (catch 'non-comment
-		      (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
-			(beginning-of-line 1)
-			(cond
-			 ((looking-at (concat org-babel-result-regexp "\n"))
-			  (setq ind (org-get-indentation))
-			  (throw 'non-comment t))
-			 ((and (looking-at "^[ \t]*#")
-			       (not (looking-at
-				     org-babel-lob-one-liner-regexp)))
-			  (end-of-line 1))
-			 (t (throw 'non-comment nil))))))
-		  (let ((this-hash (match-string 1)))
-		    (prog1 (point)
-		      ;; must remove and rebuild if hash!=old-hash
-		      (if (and hash (not (string= hash this-hash)))
-			  (progn
-			    (setq end (point-at-bol))
-			    (forward-line 1)
-			    (delete-region end (org-babel-result-end))
-			    (setq beg end))
-			(setq end nil))))))))))
-      (if (not (and insert end)) found
-	(goto-char end)
-	(unless beg
-	  (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
-	(if ind (indent-to ind)
-	  ;; Open line to properly indent.
-	  (save-excursion (insert "\n"))
-	  (org-indent-line)
-	  (delete-char 1))
-	(insert (concat
-		 "#+" org-babel-results-keyword
-		 (when hash
-		   (if org-babel-hash-show-time
-		       (concat
-			"["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]")
-		     (concat "["hash"]")))
-		 ":"
-		 (when name (concat " " name)) "\n"))
-	(unless beg (insert "\n") (backward-char))
-	(beginning-of-line 0)
-	(when hash (org-babel-hide-hash))
-	(point)))))
+       (pcase (org-element-type context)
+	 ((or `inline-babel-call `inline-src-block)
+	  ;; Results for inline objects are located right after them.
+	  ;; There is no RESULTS line to insert either.
+	  (goto-char (org-element-property :end context))
+	  (skip-chars-backward " \t")
+	  (throw :found (point)))
+	 ((or `babel-call `src-block)
+	  (let* ((name (org-element-property :name context))
+		 (named-results (and name (org-babel-find-named-result name))))
+	    (goto-char (or named-results (org-element-property :end context)))
+	    (cond
+	     ;; Existing results named after the current source.
+	     (named-results
+	      (when (org-babel--clear-results-maybe hash)
+		(org-babel--insert-results-keyword name hash))
+	      (throw :found (point)))
+	     ;; Named results expect but none to be found.
+	     (name)
+	     ;; No possible anonymous results at the very end of
+	     ;; buffer.
+	     ((eobp))
+	     ;; Check if next element is an anonymous result below
+	     ;; the current block.
+	     ((let* ((next (org-element-at-point))
+		     (end (save-excursion
+			    (goto-char
+			     (org-element-property :post-affiliated next))
+			    (line-end-position)))
+		     (empty-result-re (concat org-babel-result-regexp "$"))
+		     (case-fold-search t))
+		(re-search-forward empty-result-re end t))
+	      (beginning-of-line)
+	      (when (org-babel--clear-results-maybe hash)
+		(org-babel--insert-results-keyword nil hash))
+	      (throw :found (point))))))
+	 ;; Ignore other elements.
+	 (_ (throw :found nil))))
+      ;; No result found.  Insert a RESULTS keyword below element, if
+      ;; appropriate.  In this case, ensure there is an empty line
+      ;; after the previous element.
+      (when insert
+	(save-excursion
+	  (goto-char (min (org-element-property :end context) (point-max)))
+	  (skip-chars-backward " \t\n")
+	  (forward-line)
+	  (cond ((not (bolp)) (insert "\n\n"))
+		((or (eobp)
+		     (= (org-element-property :post-blank context) 0))
+		 (insert "\n"))
+		(t (forward-line)))
+	  (org-babel--insert-results-keyword
+	   (org-element-property :name context) hash)
+	  (point))))))
 
 (defun org-babel-read-element (element)
   "Read ELEMENT into emacs-lisp.

+ 112 - 0
testing/lisp/test-ob.el

@@ -1592,6 +1592,118 @@ echo \"$data\"
    (org-test-with-temp-text "#+results: foo"
      (org-babel-find-named-result "foo"))))
 
+(ert-deftest test-ob/where-is-src-block-result ()
+  "Test `org-babel-where-is-src-block-result' specifications."
+  ;; Find anonymous results.
+  (should
+   (equal "#+RESULTS:"
+	  (org-test-with-temp-text
+	      "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC\n\n#+RESULTS:\n: 2"
+	    (goto-char (org-babel-where-is-src-block-result))
+	    (buffer-substring-no-properties (point) (line-end-position)))))
+  ;; Find named results.  Those have priority over anonymous ones.
+  (should
+   (equal "#+RESULTS: example"
+	  (org-test-with-temp-text
+	      "
+<point>#+NAME: example
+#+BEGIN_SRC emacs-lisp
+\(+ 1 1)
+#+END_SRC
+
+#+RESULTS: example
+: 2"
+	    (goto-char (org-babel-where-is-src-block-result))
+	    (buffer-substring-no-properties (point) (line-end-position)))))
+  (should
+   (equal "#+RESULTS: example"
+	  (org-test-with-temp-text
+	      "
+<point>#+NAME: example
+#+BEGIN_SRC emacs-lisp
+\(+ 1 1)
+#+END_SRC
+
+#+RESULTS:
+: fake
+
+#+RESULTS: example
+: 2"
+	    (goto-char (org-babel-where-is-src-block-result))
+	    (buffer-substring-no-properties (point) (line-end-position)))))
+  ;; Return nil when no result is found.
+  (should-not
+   (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+     (org-babel-where-is-src-block-result)))
+  ;; When optional argument INSERT is non-nil, add RESULTS keyword
+  ;; whenever no RESULTS can be found.
+  (should
+   (equal
+    "#+RESULTS:"
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result t)))
+      (buffer-substring-no-properties (point) (line-end-position)))))
+  ;; Insert a named RESULTS keyword if possible.
+  (should
+   (equal
+    "#+RESULTS: e"
+    (org-test-with-temp-text
+	"#+NAME: e\n#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result t)))
+      (buffer-substring-no-properties (point) (line-end-position)))))
+  ;; When optional argument HASH is provided, clear RESULTS keyword
+  ;; and related contents if they do not match it.
+  (should
+   (equal
+    "#+RESULTS[bbbb]:"
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC\n\n#+RESULTS[aaaa]:\n: 3"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result nil nil "bbbb")))
+      (org-trim (buffer-substring-no-properties (point) (point-max))))))
+  (should
+   (equal
+    "#+RESULTS[bbbb]:"
+    (org-test-with-temp-text
+	"#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC\n\n#+RESULTS[aaaa]:"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result nil nil "bbbb")))
+      (org-trim (buffer-substring-no-properties (point) (point-max))))))
+  ;; RESULTS keyword may not be the last affiliated keyword.
+  (should
+   (equal
+    "#+RESULTS[bbbb]:"
+    (org-test-with-temp-text
+	"
+<point>#+BEGIN_SRC emacs-lisp
+\(+ 1 1)
+#+END_SRC
+
+#+RESULTS[aaaa]:
+#+NAME: e
+: 3"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result nil nil "bbbb")))
+      (org-trim (buffer-substring-no-properties (point) (point-max))))))
+  ;; HASH does nothing if no RESULTS can be found.  However, if INSERT
+  ;; is also non-nil, RESULTS keyword is inserted along with the
+  ;; expected hash.
+  (should
+   (equal
+    "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (org-babel-where-is-src-block-result nil nil "bbbb")
+      (buffer-string))))
+  (should
+   (equal
+    "#+RESULTS[bbbb]:"
+    (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n(+ 1 1)\n#+END_SRC"
+      (let ((org-babel-results-keyword "RESULTS"))
+	(goto-char (org-babel-where-is-src-block-result t nil "bbbb")))
+      (org-trim (buffer-substring-no-properties (point) (point-max)))))))
+
 (provide 'test-ob)
 
 ;;; test-ob ends here