On 8/11/22 12:26 AM, Ihor Radchenko wrote:
> Hraban Luyat <hra...@0brg.net> writes:
>
>>> Is there any problem with the following?
>>>
>>> (alist-get :tangle params)
>>
>> This bit of code was moved, I didn't write it. The original code uses a
>> variable `src-tfile' which isn't available here, so I reused the
>> definition of that variable (which is (cdr (assq yada yada))). When
>> creating this patch, I tried to change as little as possible, to keep
>> everything the same as much as I can. Don't write new code, just move
>> existing code around.
>>
>> The (cdr (assq ..)) is used in some other places, too; maybe it's worth
>> a separate refactor if we want to change that? I'd rather keep this
>> patch as isolated as possible.
>
> I suspect that alist-get was not there in Emacs 24.
> Otherwise, alist-get with no optional parameters is just a wrapper for
> (cdr (assq...))
>
> We can change it, though I do not see this as a big problem.
>
>> @Ihor: I have rebased the patch and attached it.
>
> Sorry, but the patch still does not apply on my side onto the current
> main branch.
Just rebased and recreated it. Based off
6acc58c9c6bcfd45dcc5964cac7e3df8347121cc.
@Max: what do you think of when-let? That seems more appropriate for
this situation. Thoughts?
>
> --
> Ihor Radchenko,
> Org mode contributor,
> Learn more about Org mode at https://orgmode.org/.
> Support Org development at https://liberapay.com/org-mode,
> or support my work at https://liberapay.com/yantar92
From 0c89c48a80b0095c40a1c4c478fdfd581e0110fd Mon Sep 17 00:00:00 2001
From: Hraban Luyat <hra...@0brg.net>
Date: Mon, 8 Aug 2022 16:58:05 -0400
Subject: [PATCH] =?UTF-8?q?ob-tangle.el:=20fix=20=E2=80=98:comments=20nowe?=
=?UTF-8?q?b=E2=80=99=20double=20linking?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
* 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 4b8fad6ce..4db0adda7 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 2ed4ba0da..618e118e0 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.
--
2.36.1
