Browse Source

ob-tangle: Fix commented links

* lisp/ob-tangle.el (org-babel-spec-to-string):
(org-babel-tangle-collect-blocks): Fix numbering and relative path of
commented links.

* testing/lisp/test-ob-tangle.el (ob-tangle/comment-links-numbering):
  New test.

Reported-by: Tobias Müller <mllertobias@gmx.de>
<http://permalink.gmane.org/gmane.emacs.orgmode/103861>
Nicolas Goaziou 5 years ago
parent
commit
e2ac979d9e
2 changed files with 40 additions and 12 deletions
  1. 14 12
      lisp/ob-tangle.el
  2. 26 0
      testing/lisp/test-ob-tangle.el

+ 14 - 12
lisp/ob-tangle.el

@@ -336,23 +336,25 @@ that the appropriate major-mode is set.  SPEC has the form:
 
   (start-line file link source-name params body comment)"
   (let* ((start-line (nth 0 spec))
+	 (info (nth 4 spec))
 	 (file (if org-babel-tangle-use-relative-file-links
 		   (file-relative-name (nth 1 spec))
 		 (nth 1 spec)))
 	 (link (let ((link (nth 2 spec)))
 		 (if org-babel-tangle-use-relative-file-links
-		     (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
-		       (let* ((type (match-string 1 link))
-			      (path (match-string 2 link))
-			      (origpath path)
-			      (case-fold-search nil))
-			 (setq path (file-relative-name path))
-			 (concat type path)))
+		     (when (string-match org-link-types-re link)
+		       (let ((type (match-string 0 link))
+			     (link (substring link (match-end 0))))
+			 (concat
+			  type
+			  (file-relative-name
+			   link
+			   (file-name-directory (cdr (assq :tangle info)))))))
 		   link)))
 	 (source-name (nth 3 spec))
 	 (body (nth 5 spec))
 	 (comment (nth 6 spec))
-	 (comments (cdr (assoc :comments (nth 4 spec))))
+	 (comments (cdr (assq :comments info)))
 	 (link-p (or (string= comments "both") (string= comments "link")
 		     (string= comments "yes") (string= comments "noweb")))
 	 (link-data (mapcar (lambda (el)
@@ -403,14 +405,14 @@ can be used to limit the collected code blocks by target file."
       (let ((current-heading-pos
 	     (org-with-wide-buffer
 	      (org-with-limited-levels (outline-previous-heading)))))
-	(cond ((eq last-heading-pos current-heading-pos) (incf counter))
-	      ((= counter 1))
-	      (t (setq counter 1))))
+	(if (eq last-heading-pos current-heading-pos) (incf counter)
+	  (setq counter 1)
+	  (setq last-heading-pos current-heading-pos)))
       (unless (org-in-commented-heading-p)
 	(let* ((info (org-babel-get-src-block-info 'light))
 	       (src-lang (nth 0 info))
 	       (src-tfile (cdr (assq :tangle (nth 2 info)))))
-	  (unless (or (string= (cdr (assq :tangle (nth 2 info))) "no")
+	  (unless (or (string= src-tfile "no")
 		      (and tangle-file (not (equal tangle-file src-tfile)))
 		      (and language (not (string= language src-lang))))
 	    ;; Add the spec for this block to blocks under its

+ 26 - 0
testing/lisp/test-ob-tangle.el

@@ -94,6 +94,32 @@ echo 1
 				   (buffer-string)))
 	(delete-file "test-ob-tangle.sh"))))))
 
+(ert-deftest ob-tangle/comment-links-numbering ()
+  "Test numbering of source blocks when commenting with links."
+  (should
+   (org-test-with-temp-text-in-file
+       "* H
+#+header: :tangle \"test-ob-tangle.el\" :comments link
+#+begin_src emacs-lisp
+1
+#+end_src
+
+#+header: :tangle \"test-ob-tangle.el\" :comments link
+#+begin_src emacs-lisp
+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))))
+       (delete-file "test-ob-tangle.el")))))
+
+
 (provide 'test-ob-tangle)
 
 ;;; test-ob-tangle.el ends here