From e2ac979d9ef57256d8219c8b116e4b10f79a8df3 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Sat, 2 Jan 2016 17:05:00 +0100
Subject: [PATCH] ob-tangle: Fix commented links
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* 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>
---
 lisp/ob-tangle.el              | 26 ++++++++++++++------------
 testing/lisp/test-ob-tangle.el | 26 ++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 591da4c1c..6bcb08170 100644
--- a/lisp/ob-tangle.el
+++ b/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
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 9367f03a5..dac4dd072 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/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