Merge branch 'maint'

lisp/ob-core.el

@@ -38,7 +38,9 @@
 (defvar org-babel-call-process-region-original nil)
 (defvar org-src-lang-modes)
 (defvar org-babel-library-of-babel)
+
 (declare-function outline-show-all "outline" ())
+(declare-function org-get-indentation "org" (&optional line))
 (declare-function org-remove-indentation "org" (code &optional n))
 (declare-function org-mark-ring-push "org" (&optional pos buffer))
 (declare-function tramp-compat-make-temp-file "tramp-compat"
@@ -96,6 +98,7 @@
 (declare-function org-element-context "org-element" (&optional element))
 (declare-function org-element-type "org-element" (element))
 (declare-function org-element-at-point "org-element" ())
+(declare-function org-element-normalize-string "org-element" (s))
 (declare-function org-element-property "org-element" (property element))
 (declare-function org-macro-escape-arguments "org-macro" (&rest args))
 
@@ -1705,13 +1708,17 @@ to the table for reinsertion to org-mode."
             (org-babel-put-colnames table colnames) table))
     table))
 
-(defun org-babel-where-is-src-block-head ()
+(defun org-babel-where-is-src-block-head (&optional src-block)
   "Find where the current source block begins.
+
+If optional argument SRC-BLOCK is `src-block' type element, find
+its current beginning instead.
+
 Return the point at the beginning of the current source block.
 Specifically at the beginning of the #+BEGIN_SRC line.  Also set
 match-data relatively to `org-babel-src-block-regexp', which see.
 If the point is not on a source block then return nil."
-  (let ((element (org-element-at-point)))
+  (let ((element (or src-block (org-element-at-point))))
     (when (eq (org-element-type element) 'src-block)
       (let ((end (org-element-property :end element)))
 	(org-with-wide-buffer
@@ -2492,12 +2499,30 @@ file's directory then expand relative links."
 
 (defun org-babel-update-block-body (new-body)
   "Update the body of the current code block to NEW-BODY."
-  (if (not (org-babel-where-is-src-block-head))
-      (error "Not in a source block")
-    (save-match-data
-      (replace-match (concat (org-babel-trim (org-remove-indentation new-body))
-			     "\n") nil t nil 5))
-    (indent-rigidly (match-beginning 5) (match-end 5) 2)))
+  (let ((element (org-element-at-point)))
+    (unless (eq (org-element-type element) 'src-block)
+      (error "Not in a source block"))
+    (goto-char (org-babel-where-is-src-block-head element))
+    (let* ((ind (org-get-indentation))
+	   (body-start (line-beginning-position 2))
+	   (body (org-element-normalize-string
+		  (if (or org-src-preserve-indentation
+			  (org-element-property :preserve-indent element))
+		      new-body
+		    (with-temp-buffer
+		      (insert (org-remove-indentation new-body))
+		      (indent-rigidly
+		       (point-min)
+		       (point-max)
+		       (+ ind org-edit-src-content-indentation))
+		      (buffer-string))))))
+      (delete-region body-start
+		     (org-with-wide-buffer
+		      (goto-char (org-element-property :end element))
+		      (skip-chars-backward " \t\n")
+		      (line-beginning-position)))
+      (goto-char body-start)
+      (insert body))))
 
 (defun org-babel-merge-params (&rest plists)
   "Combine all parameter association lists in PLISTS.

lisp/ob-tangle.el

@@ -29,10 +29,13 @@
 (require 'org-src)
 
 (declare-function make-directory "files" (dir &optional parents))
+(declare-function org-at-heading-p "org" (&optional ignored))
 (declare-function org-babel-update-block-body "org" (new-body))
 (declare-function org-back-to-heading "org" (invisible-ok))
 (declare-function org-before-first-heading-p "org" ())
 (declare-function org-edit-special "org" (&optional arg))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-type "org-element" (element))
 (declare-function org-fill-template "org" (template alist))
 (declare-function org-heading-components "org" ())
 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
@@ -545,7 +548,7 @@ which enable the original code blocks to be found."
       (prog1 counter (message "Detangled %d code blocks" counter)))))
 
 (defun org-babel-tangle-jump-to-org ()
-  "Jump from a tangled code file to the related Org-mode file."
+  "Jump from a tangled code file to the related Org mode file."
   (interactive)
   (let ((mid (point))
 	start body-start end done
@@ -554,9 +557,8 @@ which enable the original code blocks to be found."
       (save-excursion
 	(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
 		    (not ; ever wider searches until matching block comments
-		     (and (setq start (point-at-eol))
-			  (setq body-start (save-excursion
-					     (forward-line 2) (point-at-bol)))
+		     (and (setq start (line-beginning-position))
+			  (setq body-start (line-beginning-position 2))
 			  (setq link (match-string 0))
 			  (setq path (match-string 3))
 			  (setq block-name (match-string 5))
@@ -565,29 +567,33 @@ which enable the original code blocks to be found."
 			      (re-search-forward
 			       (concat " " (regexp-quote block-name)
 				       " ends here") nil t)
-			      (setq end (point-at-bol))))))))
+			      (setq end (line-beginning-position))))))))
 	(unless (and start (< start mid) (< mid end))
 	  (error "Not in tangled code"))
-        (setq body (org-babel-trim (buffer-substring start end))))
+        (setq body (buffer-substring body-start end)))
       (when (string-match "::" path)
         (setq path (substring path 0 (match-beginning 0))))
-      (find-file path) (setq target-buffer (current-buffer))
-      (goto-char start) (org-open-link-from-string link)
+      (find-file path)
+      (setq target-buffer (current-buffer))
+      ;; Go to the beginning of the relative block in Org file.
+      (org-open-link-from-string link)
       (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
-          (org-babel-next-src-block
-           (string-to-number (match-string 1 block-name)))
+          (let ((n (string-to-number (match-string 1 block-name))))
+	    (if (org-before-first-heading-p) (goto-char (point-min))
+	      (org-back-to-heading t))
+	    ;; Do not skip the first block if it begins at point min.
+	    (cond ((or (org-at-heading-p)
+		       (not (eq (org-element-type (org-element-at-point))
+				'src-block)))
+		   (org-babel-next-src-block n))
+		  ((= n 1))
+		  (t (org-babel-next-src-block (1- n)))))
         (org-babel-goto-named-src-block block-name))
-      ;; position at the beginning of the code block body
       (goto-char (org-babel-where-is-src-block-head))
+      ;; Preserve location of point within the source code in tangled
+      ;; code file.
       (forward-line 1)
-      ;; Use org-edit-special to isolate the code.
-      (org-edit-special)
-      ;; Then move forward the correct number of characters in the
-      ;; code buffer.
       (forward-char (- mid body-start))
-      ;; And return to the Org-mode buffer with the point in the right
-      ;; place.
-      (org-edit-src-exit)
       (setq target-char (point)))
     (org-src-switch-to-buffer target-buffer t)
     (prog1 body (goto-char target-char))))

testing/lisp/test-ob-tangle.el

@@ -36,17 +36,17 @@
 ;;       (org-narrow-to-subtree)
 ;;       (org-babel-tangle target-file))
 ;;     (let ((tang (with-temp-buffer
-;; 		  (insert-file-contents target-file)
-;; 		  (buffer-string))))
+;;                (insert-file-contents target-file)
+;;                (buffer-string))))
 ;;       (flet ((exp-p (arg)
-;; 		    (and
-;; 		     (string-match
-;; 		      (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
-;; 		      tang)
-;; 		     (string-match "expanded" (match-string 1 tang)))))
-;; 	(should (exp-p "yes"))
-;; 	(should-not (exp-p "no"))
-;; 	(should (exp-p "tangle"))))))
+;;                  (and
+;;                   (string-match
+;;                    (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+;;                    tang)
+;;                   (string-match "expanded" (match-string 1 tang)))))
+;;      (should (exp-p "yes"))
+;;      (should-not (exp-p "no"))
+;;      (should (exp-p "tangle"))))))
 
 (ert-deftest ob-tangle/no-excessive-id-insertion-on-tangle ()
   "Don't add IDs to headings without tangling code blocks."
@@ -60,13 +60,13 @@
   "Test that the :noweb-ref header argument is used correctly."
   (org-test-at-id "54d68d4b-1544-4745-85ab-4f03b3cbd8a0"
     (let ((tangled
-	   "df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
+           "df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
       (org-narrow-to-subtree)
       (org-babel-tangle)
       (with-temp-buffer
-	(insert-file-contents "babel.sh")
-	(goto-char (point-min))
-	(should (re-search-forward (regexp-quote tangled) nil t)))
+        (insert-file-contents "babel.sh")
+        (goto-char (point-min))
+        (should (re-search-forward (regexp-quote tangled) nil t)))
       (delete-file "babel.sh"))))
 
 (ert-deftest ob-tangle/expand-headers-as-noweb-references ()
@@ -78,21 +78,21 @@
       (should (string-match (regexp-quote "length 14") expanded)))))
 
 (ert-deftest ob-tangle/comment-links-at-left-margin ()
-    "Test commenting of links at left margin."
+  "Test commenting of links at left margin."
   (should
    (string-match
     (regexp-quote "# [[http://orgmode.org][Org mode]]")
     (org-test-with-temp-text-in-file
-	"[[http://orgmode.org][Org mode]]
+        "[[http://orgmode.org][Org mode]]
 #+header: :comments org :tangle \"test-ob-tangle.sh\"
 #+begin_src sh
 echo 1
 #+end_src"
       (unwind-protect
-	  (progn (org-babel-tangle)
-		 (with-temp-buffer (insert-file-contents "test-ob-tangle.sh")
-				   (buffer-string)))
-	(delete-file "test-ob-tangle.sh"))))))
+          (progn (org-babel-tangle)
+                 (with-temp-buffer (insert-file-contents "test-ob-tangle.sh")
+                                   (buffer-string)))
+        (delete-file "test-ob-tangle.sh"))))))
 
 (ert-deftest ob-tangle/comment-links-numbering ()
   "Test numbering of source blocks when commenting with links."
@@ -109,16 +109,92 @@ echo 1
 2
 #+end_src"
      (unwind-protect
-	 (progn
-	   (org-babel-tangle)
-	   (with-temp-buffer
-	     (insert-file-contents "test-ob-tangle.el")
-	     (buffer-string)
-	     (goto-char (point-min))
-	     (and (search-forward "[H:1]]" nil t)
-		  (search-forward "[H:2]]" nil t))))
+         (progn
+           (org-babel-tangle)
+           (with-temp-buffer
+             (insert-file-contents "test-ob-tangle.el")
+             (buffer-string)
+             (goto-char (point-min))
+             (and (search-forward "[H:1]]" nil t)
+                  (search-forward "[H:2]]" nil t))))
        (delete-file "test-ob-tangle.el")))))
 
+(ert-deftest ob-tangle/jump-to-org ()
+  "Test `org-babel-tangle-jump-to-org' specifications."
+  ;; Standard test.
+  (should
+   (equal
+    "* H\n#+begin_src emacs-lisp\n1\n#+end_src"
+    (org-test-with-temp-text-in-file
+        "* H\n#+begin_src emacs-lisp\n1\n#+end_src"
+      (let ((file (buffer-file-name)))
+        (org-test-with-temp-text
+            (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+                    (file-name-nondirectory file))
+          (org-babel-tangle-jump-to-org)
+          (buffer-string))))))
+  ;; Multiple blocks in the same section.
+  (should
+   (equal
+    "2"
+    (org-test-with-temp-text-in-file
+        "* H
+
+first block
+
+#+begin_src emacs-lisp
+1
+#+end_src
+
+another block
+
+#+begin_src emacs-lisp
+2
+#+end_src
+"
+      (let ((file (buffer-file-name)))
+        (org-test-with-temp-text
+            (format ";; [[file:%s][H:2]]\n<point>2\n;; H:2 ends here\n"
+                    (file-name-nondirectory file))
+          (org-babel-tangle-jump-to-org)
+          (buffer-substring (line-beginning-position)
+                            (line-end-position)))))))
+  ;; Preserve position within the source code.
+  (should
+   (equal
+    "1)"
+    (org-test-with-temp-text-in-file
+        "* H\n#+begin_src emacs-lisp\n(+ 1 1)\n#+end_src"
+      (let ((file (buffer-file-name)))
+        (org-test-with-temp-text
+            (format ";; [[file:%s][H:1]]\n(+ 1 <point>1)\n;; H:1 ends here\n"
+                    (file-name-nondirectory file))
+          (org-babel-tangle-jump-to-org)
+          (buffer-substring-no-properties (point) (line-end-position)))))))
+  ;; Blocks before first heading.
+  (should
+   (equal
+    "Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+    (org-test-with-temp-text-in-file
+        "Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+      (let ((file (buffer-file-name)))
+        (org-test-with-temp-text
+            (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+                    (file-name-nondirectory file))
+          (org-babel-tangle-jump-to-org)
+          (buffer-string))))))
+  ;; Special case: buffer starts with a source block.
+  (should
+   (equal
+    "#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+    (org-test-with-temp-text-in-file
+        "#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+      (let ((file (buffer-file-name)))
+        (org-test-with-temp-text
+            (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+                    (file-name-nondirectory file))
+          (org-babel-tangle-jump-to-org)
+          (buffer-string)))))))
 
 (provide 'test-ob-tangle)
 

testing/lisp/test-ob.el

@@ -1513,6 +1513,60 @@ echo \"$data\"
 	(message (car pair))
 	(should (eq (org-test-babel-confirm-evaluate (car pair)) (cdr pair)))))))
 
+(defun org-test-ob/update-block-body ()
+  "Test `org-babel-update-block-body' specifications."
+  (should
+   (equal "#+begin_src elisp\n  2\n#+end_src"
+	  (let ((org-edit-src-content-indentation 2))
+	    (org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
+	      (org-babel-update-block-body "2")
+	      (buffer-string)))))
+  ;; Preserve block indentation.
+  (should
+   (equal "  #+begin_src elisp\n   2\n  #+end_src"
+	  (let ((org-edit-src-content-indentation 1))
+	    (org-test-with-temp-text
+		"  #+begin_src elisp\n  (+ 1 1)\n  #+end_src"
+	      (org-babel-update-block-body "2")
+	      (buffer-string)))))
+  ;; Ignore NEW-BODY global indentation.
+  (should
+   (equal "#+begin_src elisp\n  2\n#+end_src"
+	  (let ((org-edit-src-content-indentation 2))
+	    (org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
+	      (org-babel-update-block-body "      2")
+	      (buffer-string)))))
+  ;; When indentation should be preserved ignore the two rules above.
+  (should
+   (equal "  #+begin_src elisp\n2\n  #+end_src"
+	  (let ((org-edit-src-content-indentation 1)
+		(org-src-preserve-indentation t))
+	    (org-test-with-temp-text
+		"  #+begin_src elisp\n  (+ 1 1)\n  #+end_src"
+	      (org-babel-update-block-body "2")
+	      (buffer-string)))))
+  (should
+   (equal "  #+begin_src elisp -i\n2\n  #+end_src"
+	  (let ((org-edit-src-content-indentation 1))
+	    (org-test-with-temp-text
+		"  #+begin_src elisp -i\n  (+ 1 1)\n  #+end_src"
+	      (org-babel-update-block-body "2")
+	      (buffer-string)))))
+  (should
+   (equal "#+begin_src elisp\n      2\n#+end_src"
+	  (let ((org-edit-src-content-indentation 2)
+		(org-src-preserve-indentation t))
+	    (org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
+	      (org-babel-update-block-body "      2")
+	      (buffer-string)))))
+  (should
+   (equal "#+begin_src elisp -i\n      2\n#+end_src"
+	  (let ((org-edit-src-content-indentation 2)
+		(org-src-preserve-indentation t))
+	    (org-test-with-temp-text "#+begin_src elisp -i\n(+ 1 1)\n#+end_src"
+	      (org-babel-update-block-body "      2")
+	      (buffer-string))))))
+
 (provide 'test-ob)
 
 ;;; test-ob ends here