[elpa] externals/org 8a781d35dc: ob-tangle.el: fix ‘:comments noweb’ double linking

[ELPA Syncer]

branch: externals/org
commit 8a781d35dc68f20fa2a5546c98ba3d9b77ee3cda
Author: Hraban Luyat <hraban@0brg.net>
Commit: Ihor Radchenko <yantar92@gmail.com>

    ob-tangle.el: fix ‘:comments noweb’ double linking
    
    * lisp/ob-tangle.el: Refactor the double implementation to a single
    helper function.  This avoids the double link wrapping.
    
    * testing/lisp/test-ob-tangle.el: Add unit tests.
    
    Babel tangle allows inserting comments at the tangled site which link
    back to the source in the org file.  This linking was implemented
    twice, to handle separate cases, but when using ‘:comments noweb’ it
    ended up going through both codepaths.  This resulted in doubly
    wrapped links.
    
    By refactoring all link generation into a single function, this double
    wrapping is avoided.
    
    Example file, /tmp/test.org:
    
        * Inner
        #+name: inner
        #+begin_src emacs-lisp
        2
        #+end_src
    
        * Main
        #+header: :tangle test.el :comments noweb :noweb yes
        #+begin_src emacs-lisp
        1
        <<inner>>
        #+end_src
    
    Before:
    
        ;; [[file:test.org::*Main][Main:1]]
        1
        ;; [[[[file:/tmp/test.org::inner][inner]]][inner]]
        2
        ;; inner ends here
        ;; Main:1 ends here
    
    After:
    
        ;; [[file:test.org::*Main][Main:1]]
        1
        ;; [[file:test.org::inner][inner]]
        2
        ;; inner ends here
        ;; Main:1 ends here
---
 lisp/ob-tangle.el              | 62 +++++++++++++++++++++---------------------
 testing/lisp/test-ob-tangle.el | 56 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 87 insertions(+), 31 deletions(-)

diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 4b8fad6ce6..4db0adda7b 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -469,6 +469,33 @@ code blocks by target file."
     (mapcar (lambda (b) (cons (car b) (nreverse (cdr b))))
            (nreverse blocks))))
 
+(defun org-babel-tangle--unbracketed-link (params)
+  "Get a raw link to the src block at point, without brackets.
+
+The PARAMS are the 3rd element of the info for the same src block."
+  (unless (string= "no" (cdr (assq :comments params)))
+    (save-match-data
+      (let* (;; The created link is transient.  Using ID is not necessary,
+             ;; but could have side-effects if used.  An ID property may
+             ;; be added to existing entries thus creating unexpected file
+             ;; modifications.
+             (org-id-link-to-org-use-id nil)
+             (l (org-no-properties
+                 (cl-letf (((symbol-function 'org-store-link-functions)
+                            (lambda () nil)))
+                   (org-store-link nil))))
+             (bare (and (string-match org-link-bracket-re l)
+                        (match-string 1 l))))
+        (when bare
+          (if (and org-babel-tangle-use-relative-file-links
+                   (string-match org-link-types-re bare)
+                   (string= (match-string 1 bare) "file"))
+              (concat "file:"
+                      (file-relative-name (substring bare (match-end 0))
+                                          (file-name-directory
+                                           (cdr (assq :tangle params)))))
+            bare))))))
+
 (defun org-babel-tangle-single-block (block-counter &optional only-this-block)
   "Collect the tangled source for current block.
 Return the list of block attributes needed by
@@ -485,20 +512,7 @@ non-nil, return the full association list to be used by
         (extra (nth 3 info))
          (coderef (nth 6 info))
         (cref-regexp (org-src-coderef-regexp coderef))
-        (link (if (string= "no" (cdr (assq :comments params))) ""
-                 (let* (
-                        ;; The created link is transient.  Using ID is
-                        ;; not necessary, but could have side-effects if
-                        ;; used.  An ID property may be added to
-                        ;; existing entries thus creating unexpected
-                        ;; file modifications.
-                        (org-id-link-to-org-use-id nil)
-                        (l (org-no-properties
-                            (cl-letf (((symbol-function 
'org-store-link-functions)
-                                       (lambda () nil)))
-                              (org-store-link nil)))))
-                   (and (string-match org-link-bracket-re l)
-                        (match-string 1 l)))))
+        (link (org-babel-tangle--unbracketed-link params))
         (source-name
          (or (nth 4 info)
              (format "%s:%d"
@@ -552,15 +566,7 @@ non-nil, return the full association list to be used by
                (if org-babel-tangle-use-relative-file-links
                    (file-relative-name file)
                  file)
-               (if (and org-babel-tangle-use-relative-file-links
-                        (string-match org-link-types-re link)
-                        (string= (match-string 1 link) "file")
-                         (stringp src-tfile))
-                   (concat "file:"
-                           (file-relative-name (substring link (match-end 0))
-                                               (file-name-directory
-                                                src-tfile)))
-                 link)
+               link
                source-name
                params
                (if org-src-preserve-indentation
@@ -578,18 +584,12 @@ non-nil, return the full association list to be used by
 INFO, when non nil, is the source block information, as returned
 by `org-babel-get-src-block-info'."
   (let ((link-data (pcase (or info (org-babel-get-src-block-info 'light))
-                    (`(,_ ,_ ,_ ,_ ,name ,start ,_)
+                    (`(,_ ,_ ,params ,_ ,name ,start ,_)
                      `(("start-line" . ,(org-with-point-at start
                                           (number-to-string
                                            (line-number-at-pos))))
                        ("file" . ,(buffer-file-name))
-                       ("link" . ,(let (;; The created link is transient.  
Using ID is
-                                         ;; not necessary, but could have 
side-effects if
-                                         ;; used.  An ID property may be added 
to
-                                         ;; existing entries thus creatin 
unexpected file
-                                         ;; modifications.
-                                         (org-id-link-to-org-use-id nil))
-                                     (org-no-properties (org-store-link nil))))
+                       ("link" . ,(org-babel-tangle--unbracketed-link params))
                        ("source-name" . ,name))))))
     (list (org-fill-template org-babel-tangle-comment-format-beg link-data)
          (org-fill-template org-babel-tangle-comment-format-end link-data))))
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 2ed4ba0dac..618e118e08 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -159,6 +159,62 @@ echo 1
             (search-forward (concat "[file:" file) nil t)))
        (delete-file "test-ob-tangle.el")))))
 
+(ert-deftest ob-tangle/comment-noweb-relative ()
+  "Test :comments noweb tangling with relative file paths."
+  (should
+   (org-test-with-temp-text-in-file
+       "* Inner
+#+name: inner
+#+begin_src emacs-lisp
+2
+#+end_src
+
+* Main
+#+header: :tangle \"test-ob-tangle.el\" :comments noweb :noweb yes
+#+begin_src emacs-lisp
+1
+<<inner>>
+#+end_src"
+     (unwind-protect
+        (let ((org-babel-tangle-use-relative-file-links t))
+           (org-babel-tangle)
+           (with-temp-buffer
+             (insert-file-contents "test-ob-tangle.el")
+             (buffer-string)
+             (goto-char (point-min))
+             (and
+              (search-forward (concat ";; [[file:" (file-name-nondirectory 
file) "::inner") nil t)
+              (search-forward ";; inner ends here" nil t))))
+       (delete-file "test-ob-tangle.el")))))
+
+(ert-deftest ob-tangle/comment-noweb-absolute ()
+  "Test :comments noweb tangling with absolute file path."
+  (should
+   (org-test-with-temp-text-in-file
+       "* Inner
+#+name: inner
+#+begin_src emacs-lisp
+2
+#+end_src
+
+* Main
+#+header: :tangle \"test-ob-tangle.el\" :comments noweb :noweb yes
+#+begin_src emacs-lisp
+1
+<<inner>>
+#+end_src"
+     (unwind-protect
+        (let ((org-babel-tangle-use-relative-file-links nil))
+          (org-babel-tangle)
+          (with-temp-buffer
+            (insert-file-contents "test-ob-tangle.el")
+            (buffer-string)
+            (goto-char (point-min))
+             (and
+              (search-forward (concat ";; [[file:" file "::inner") nil t)
+              (search-forward ";; inner ends here" 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.