Merge branch 'maint'

lisp/ob-tangle.el

@@ -1,6 +1,6 @@
 ;;; ob-tangle.el --- extract source code from org-mode files
 
-;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
 
 ;; Author: Eric Schulte
 ;; Keywords: literate programming, reproducible research
@@ -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

testing/lisp/test-ob-tangle.el

@@ -1,6 +1,6 @@
 ;;; test-ob-tangle.el --- tests for ob-tangle.el
 
-;; Copyright (c) 2010-2014 Eric Schulte
+;; Copyright (c) 2010-2016 Eric Schulte
 ;; Authors: Eric Schulte
 
 ;; This file is not part of GNU Emacs.
@@ -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