Thanks.
I realized that it's challenging to handle the error properly if the
return value of org-babel-tangle-single-block remains unchanged.
Consider your code block:
#+begin_src emacs-lisp :tangle '("1.el" "2.el")
(+ 1 2)
#+end_src
In the org-babel-tangle--unbracketed-link function, if
org-babel-tangle-use-relative-file-links is non-nil, the expression
(file-relative-name "/tmp/test.org::heading" '("1.el" "2.el")) will
raise the error. That's why I used ignore-errors in the first patch
within org-babel-tangle-single-block.
If I handle this properly using a loop and return a list of relative
file links, the return value of org-babel-tangle-single-block must
also be adjusted to a nested list accordingly. Otherwise, it would be
meaningless and could lead to potential errors.
Since this change would be a breaking one, I'd like to hear your
thoughts. Do you have any suggestions for handling this more
effectively?
llcc
On Tue, Mar 18, 2025 at 1:59 AM Ihor Radchenko <yanta...@posteo.net> wrote:
>
> Lei Zhe <lzhe...@gmail.com> writes:
>
> >>>As for the patch, I tried to run it with simple example and got an error.
> > I tested on my side and didn't see any failures. Would you mind
> > sharing the error details?
>
> 1. git clone ...
> 2. cd /path/to/org/source
> 3. apply the patch
> 4. make repro
> 5. C-x C-f /tmp/test.org
> 6. Insert
> #+begin_src emacs-lisp :tangle '("1.el" "2.el")
> (+ 1 2)
> #+end_src
> 7. C-c C-v C-t
> 8. Observe
>
> Debugger entered--Lisp error: (wrong-type-argument stringp ("1.el" "2.el"))
> file-name-directory(("1.el" "2.el"))
> (file-relative-name (substring bare (match-end 0)) (file-name-directory
> (cdr (assq :tangle params))))
> (concat "file:" (file-relative-name (substring bare (match-end 0))
> (file-name-directory (cdr (assq :tangle params)))))
> (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)
> (progn (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))
> (if bare (progn (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)))
> (let* ((l (org-no-properties (org-store-link nil))) (bare (and l
> (string-match org-link-bracket-re l) (match-string 1 l)))) (if bare (progn
> (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 ...)))) bare))))
> (progn (let* ((l (org-no-properties (org-store-link nil))) (bare (and l
> (string-match org-link-bracket-re l) (match-string 1 l)))) (if bare (progn
> (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 ...) (file-name-directory ...)))
> bare)))))
> (unwind-protect (progn (let* ((l (org-no-properties (org-store-link nil)))
> (bare (and l (string-match org-link-bracket-re l) (match-string 1 l)))) (if
> bare (progn (if (and org-babel-tangle-use-relative-file-links (string-match
> org-link-types-re bare) (string= ... "file")) (concat "file:"
> (file-relative-name ... ...)) bare))))) (set-match-data saved-match-data t))
> (let ((saved-match-data (match-data))) (unwind-protect (progn (let* ((l
> (org-no-properties (org-store-link nil))) (bare (and l (string-match
> org-link-bracket-re l) (match-string 1 l)))) (if bare (progn (if (and
> org-babel-tangle-use-relative-file-links ... ...) (concat "file:" ...)
> bare))))) (set-match-data saved-match-data t)))
> (if (string= "no" (cdr (assq :comments params))) nil (let
> ((saved-match-data (match-data))) (unwind-protect (progn (let* ((l
> (org-no-properties ...)) (bare (and l ... ...))) (if bare (progn (if ... ...
> bare))))) (set-match-data saved-match-data t))))
> org-babel-tangle--unbracketed-link(((:colname-names) (:rowname-names)
> (:result-params "replace") (:result-type . value) (:results . "replace")
> (:exports . "code") (:tangle "1.el" "2.el") (:lexical . "no") (:hlines .
> "no") (:noweb . "no") (:cache . "no") (:session . "none")))
> (let* ((info (org-babel-get-src-block-info)) (start-line (save-restriction
> (widen) (+ 1 (line-number-at-pos (point))))) (file (buffer-file-name
> (buffer-base-buffer))) (src-lang (nth 0 info)) (params (nth 2 info)) (extra
> (nth 3 info)) (coderef (nth 6 info)) (cref-regexp (org-src-coderef-regexp
> coderef)) (link (org-babel-tangle--unbracketed-link params)) (source-name (or
> (nth 4 info) (format "%s:%d" (or (condition-case nil (progn ...) (error nil))
> "No heading") block-counter))) (expand-cmd (intern (concat
> "org-babel-expand-body:" src-lang))) (assignments-cmd (intern (concat
> "org-babel-variable-assignments:" src-lang))) (body (let ((body (if
> (org-babel-noweb-p params :tangle) (if ... ... ...) (nth 1 info)))) (let
> ((temp-buffer (generate-new-buffer " *temp*" t))) (save-current-buffer
> (set-buffer temp-buffer) (unwind-protect (progn ... ... ... ...) (and ...
> ...)))))) (comment (if (or (string= "both" (cdr (assq :comments params)))
> (string= "org" (cdr (assq :comments params)))) (progn (funcall
> org-babel-process-comment-text (buffer-substring (max ... ...) (point))))))
> (result (list start-line (if org-babel-tangle-use-relative-file-links
> (file-relative-name file) file) link source-name params (if
> (org-src-preserve-indentation-p) (org-trim body t) (org-trim
> (org-remove-indentation body))) comment))) (if only-this-block (let*
> ((file-names (org-babel-tangle--concat-targets file info))) (mapcar #'(lambda
> (file-name) (cons file-name (list ...))) file-names)) result))
> org-babel-tangle-single-block(1 t)
> (let* ((block (org-babel-tangle-single-block counter t)) (src-file (car
> block)) (src-lang (car (car block)))) (if (or (not src-file) (and (not
> src-lang) src-file) (and tangle-file (not (equal tangle-file src-file))) (and
> lang-re (or (not src-lang) (not (string-match-p lang-re src-lang))))) nil
> (setq blocks (mapcar #'(lambda (group) (cons (car group) (apply ... ...)))
> (seq-group-by #'car (append block blocks))))))
> (if (or (org-in-commented-heading-p) (org-in-archived-heading-p)) nil (let*
> ((block (org-babel-tangle-single-block counter t)) (src-file (car block))
> (src-lang (car (car block)))) (if (or (not src-file) (and (not src-lang)
> src-file) (and tangle-file (not (equal tangle-file src-file))) (and lang-re
> (or (not src-lang) (not (string-match-p lang-re src-lang))))) nil (setq
> blocks (mapcar #'(lambda (group) (cons ... ...)) (seq-group-by #'car (append
> block blocks)))))))
> (let ((full-block (match-string 0)) (beg-block (match-beginning 0))
> (end-block (match-end 0)) (lang (match-string 2)) (beg-lang (match-beginning
> 2)) (end-lang (match-end 2)) (switches (match-string 3)) (beg-switches
> (match-beginning 3)) (end-switches (match-end 3)) (header-args (match-string
> 4)) (beg-header-args (match-beginning 4)) (end-header-args (match-end 4))
> (body (match-string 5)) (beg-body (match-beginning 5)) (end-body (match-end
> 5))) (ignore full-block beg-block end-block lang beg-lang end-lang switches
> beg-switches end-switches header-args beg-header-args end-header-args body
> beg-body end-body) (let ((current-heading-pos (or (org-element-begin
> (org-element-lineage (org-element-at-point) 'headline t)) 1))) (if (eq
> last-heading-pos current-heading-pos) (setq counter (1+ counter)) (setq
> counter 1) (setq last-heading-pos current-heading-pos))) (if (or
> (org-in-commented-heading-p) (org-in-archived-heading-p)) nil (let* ((block
> (org-babel-tangle-single-block counter t)) (src-file (car block)) (src-lang
> (car (car block)))) (if (or (not src-file) (and (not src-lang) src-file) (and
> tangle-file (not (equal tangle-file src-file))) (and lang-re (or (not
> src-lang) (not ...)))) nil (setq blocks (mapcar #'(lambda ... ...)
> (seq-group-by #'car (append block blocks))))))) (goto-char end-block))
> (progn (goto-char (match-beginning 0)) (let ((full-block (match-string 0))
> (beg-block (match-beginning 0)) (end-block (match-end 0)) (lang (match-string
> 2)) (beg-lang (match-beginning 2)) (end-lang (match-end 2)) (switches
> (match-string 3)) (beg-switches (match-beginning 3)) (end-switches (match-end
> 3)) (header-args (match-string 4)) (beg-header-args (match-beginning 4))
> (end-header-args (match-end 4)) (body (match-string 5)) (beg-body
> (match-beginning 5)) (end-body (match-end 5))) (ignore full-block beg-block
> end-block lang beg-lang end-lang switches beg-switches end-switches
> header-args beg-header-args end-header-args body beg-body end-body) (let
> ((current-heading-pos (or (org-element-begin (org-element-lineage ... ... t))
> 1))) (if (eq last-heading-pos current-heading-pos) (setq counter (1+
> counter)) (setq counter 1) (setq last-heading-pos current-heading-pos))) (if
> (or (org-in-commented-heading-p) (org-in-archived-heading-p)) nil (let*
> ((block (org-babel-tangle-single-block counter t)) (src-file (car block))
> (src-lang (car (car block)))) (if (or (not src-file) (and (not src-lang)
> src-file) (and tangle-file (not ...)) (and lang-re (or ... ...))) nil (setq
> blocks (mapcar #'... (seq-group-by ... ...)))))) (goto-char end-block)))
> (if (org-babel-active-location-p) (progn (goto-char (match-beginning 0))
> (let ((full-block (match-string 0)) (beg-block (match-beginning 0))
> (end-block (match-end 0)) (lang (match-string 2)) (beg-lang (match-beginning
> 2)) (end-lang (match-end 2)) (switches (match-string 3)) (beg-switches
> (match-beginning 3)) (end-switches (match-end 3)) (header-args (match-string
> 4)) (beg-header-args (match-beginning 4)) (end-header-args (match-end 4))
> (body (match-string 5)) (beg-body (match-beginning 5)) (end-body (match-end
> 5))) (ignore full-block beg-block end-block lang beg-lang end-lang switches
> beg-switches end-switches header-args beg-header-args end-header-args body
> beg-body end-body) (let ((current-heading-pos (or (org-element-begin ...)
> 1))) (if (eq last-heading-pos current-heading-pos) (setq counter (1+
> counter)) (setq counter 1) (setq last-heading-pos current-heading-pos))) (if
> (or (org-in-commented-heading-p) (org-in-archived-heading-p)) nil (let*
> ((block (org-babel-tangle-single-block counter t)) (src-file (car block))
> (src-lang (car ...))) (if (or (not src-file) (and ... src-file) (and
> tangle-file ...) (and lang-re ...)) nil (setq blocks (mapcar ... ...)))))
> (goto-char end-block))))
> (while (re-search-forward org-babel-src-block-regexp nil t) (if
> (org-babel-active-location-p) (progn (goto-char (match-beginning 0)) (let
> ((full-block (match-string 0)) (beg-block (match-beginning 0)) (end-block
> (match-end 0)) (lang (match-string 2)) (beg-lang (match-beginning 2))
> (end-lang (match-end 2)) (switches (match-string 3)) (beg-switches
> (match-beginning 3)) (end-switches (match-end 3)) (header-args (match-string
> 4)) (beg-header-args (match-beginning 4)) (end-header-args (match-end 4))
> (body (match-string 5)) (beg-body (match-beginning 5)) (end-body (match-end
> 5))) (ignore full-block beg-block end-block lang beg-lang end-lang switches
> beg-switches end-switches header-args beg-header-args end-header-args body
> beg-body end-body) (let ((current-heading-pos (or ... 1))) (if (eq
> last-heading-pos current-heading-pos) (setq counter (1+ counter)) (setq
> counter 1) (setq last-heading-pos current-heading-pos))) (if (or
> (org-in-commented-heading-p) (org-in-archived-heading-p)) nil (let* ((block
> ...) (src-file ...) (src-lang ...)) (if (or ... ... ... ...) nil (setq blocks
> ...)))) (goto-char end-block)))))
> (progn (if file (progn (find-file file))) (setq to-be-removed
> (current-buffer)) (goto-char (point-min)) (while (re-search-forward
> org-babel-src-block-regexp nil t) (if (org-babel-active-location-p) (progn
> (goto-char (match-beginning 0)) (let ((full-block (match-string 0))
> (beg-block (match-beginning 0)) (end-block (match-end 0)) (lang (match-string
> 2)) (beg-lang (match-beginning 2)) (end-lang (match-end 2)) (switches
> (match-string 3)) (beg-switches (match-beginning 3)) (end-switches (match-end
> 3)) (header-args (match-string 4)) (beg-header-args (match-beginning 4))
> (end-header-args (match-end 4)) (body (match-string 5)) (beg-body
> (match-beginning 5)) (end-body (match-end 5))) (ignore full-block beg-block
> end-block lang beg-lang end-lang switches beg-switches end-switches
> header-args beg-header-args end-header-args body beg-body end-body) (let
> ((current-heading-pos ...)) (if (eq last-heading-pos current-heading-pos)
> (setq counter ...) (setq counter 1) (setq last-heading-pos
> current-heading-pos))) (if (or (org-in-commented-heading-p)
> (org-in-archived-heading-p)) nil (let* (... ... ...) (if ... nil ...)))
> (goto-char end-block))))))
> (unwind-protect (progn (if file (progn (find-file file))) (setq
> to-be-removed (current-buffer)) (goto-char (point-min)) (while
> (re-search-forward org-babel-src-block-regexp nil t) (if
> (org-babel-active-location-p) (progn (goto-char (match-beginning 0)) (let
> ((full-block ...) (beg-block ...) (end-block ...) (lang ...) (beg-lang ...)
> (end-lang ...) (switches ...) (beg-switches ...) (end-switches ...)
> (header-args ...) (beg-header-args ...) (end-header-args ...) (body ...)
> (beg-body ...) (end-body ...)) (ignore full-block beg-block end-block lang
> beg-lang end-lang switches beg-switches end-switches header-args
> beg-header-args end-header-args body beg-body end-body) (let (...) (if ...
> ... ... ...)) (if (or ... ...) nil (let* ... ...)) (goto-char end-block))))))
> (set-window-configuration wconfig))
> (let ((wconfig (current-window-configuration))) (unwind-protect (progn (if
> file (progn (find-file file))) (setq to-be-removed (current-buffer))
> (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp
> nil t) (if (org-babel-active-location-p) (progn (goto-char (match-beginning
> 0)) (let (... ... ... ... ... ... ... ... ... ... ... ... ... ... ...)
> (ignore full-block beg-block end-block lang beg-lang end-lang switches
> beg-switches end-switches header-args beg-header-args end-header-args body
> beg-body end-body) (let ... ...) (if ... nil ...) (goto-char end-block))))))
> (set-window-configuration wconfig)))
> (let* ((case-fold-search t) (file (buffer-file-name)) (visited-p (or (null
> file) (get-file-buffer (expand-file-name file)))) (point (point))
> to-be-removed) (let ((wconfig (current-window-configuration)))
> (unwind-protect (progn (if file (progn (find-file file))) (setq to-be-removed
> (current-buffer)) (goto-char (point-min)) (while (re-search-forward
> org-babel-src-block-regexp nil t) (if (org-babel-active-location-p) (progn
> (goto-char ...) (let ... ... ... ... ...))))) (set-window-configuration
> wconfig))) (if visited-p nil (kill-buffer to-be-removed)) (goto-char point))
> (let ((counter 0) (buffer-fn (buffer-file-name (buffer-base-buffer)))
> last-heading-pos blocks) (let* ((case-fold-search t) (file
> (buffer-file-name)) (visited-p (or (null file) (get-file-buffer
> (expand-file-name file)))) (point (point)) to-be-removed) (let ((wconfig
> (current-window-configuration))) (unwind-protect (progn (if file (progn
> (find-file file))) (setq to-be-removed (current-buffer)) (goto-char
> (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) (if
> (org-babel-active-location-p) (progn ... ...)))) (set-window-configuration
> wconfig))) (if visited-p nil (kill-buffer to-be-removed)) (goto-char point))
> (mapcar #'(lambda (b) (cons (car b) (nreverse (cdr b)))) (nreverse blocks)))
> org-babel-tangle-collect-blocks(nil nil)
> (if (equal arg '(4)) (org-babel-tangle-single-block 1 t)
> (org-babel-tangle-collect-blocks lang-re tangle-file))
> (mapc #'(lambda (by-fn) (let ((file-name (car by-fn))) (if file-name (progn
> (let (... ... modes make-dir she-banged lang) (let ... ...)))))) (if (equal
> arg '(4)) (org-babel-tangle-single-block 1 t)
> (org-babel-tangle-collect-blocks lang-re tangle-file)))
> (let ((block-counter 0) (org-babel-default-header-args (if target-file
> (org-babel-merge-params org-babel-default-header-args (list (cons :tangle
> target-file))) org-babel-default-header-args)) (tangle-file (if (equal arg
> '(16)) (progn (or (cdr (assq :tangle ...)) (user-error "Point is not in a
> source code block"))))) path-collector (source-file buffer-file-name)) (mapc
> #'(lambda (by-fn) (let ((file-name (car by-fn))) (if file-name (progn (let
> ... ...))))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t)
> (org-babel-tangle-collect-blocks lang-re tangle-file))) (message "Tangled %d
> code block%s from %s" block-counter (if (= block-counter 1) "" "s")
> (file-name-nondirectory (buffer-file-name (or (buffer-base-buffer)
> (current-buffer) (and (org-src-edit-buffer-p) (org-src-source-buffer))))))
> (if org-babel-post-tangle-hook (progn (mapc #'(lambda (file) (let* (... ...
> temp-result temp-file) (org-babel-find-file-noselect-refresh temp-path) (setq
> temp-file ...) (save-current-buffer ... ...) (if visited-p nil ...)
> temp-result)) path-collector))) (run-hooks 'org-babel-tangle-finished-hook)
> path-collector)
> (save-excursion (if (equal arg '(4)) (progn (let ((head
> (org-babel-where-is-src-block-head))) (if head (goto-char head) (user-error
> "Point is not in a source code block"))))) (let ((block-counter 0)
> (org-babel-default-header-args (if target-file (org-babel-merge-params
> org-babel-default-header-args (list (cons :tangle target-file)))
> org-babel-default-header-args)) (tangle-file (if (equal arg '(16)) (progn (or
> (cdr ...) (user-error "Point is not in a source code block")))))
> path-collector (source-file buffer-file-name)) (mapc #'(lambda (by-fn) (let
> ((file-name ...)) (if file-name (progn ...)))) (if (equal arg '(4))
> (org-babel-tangle-single-block 1 t) (org-babel-tangle-collect-blocks lang-re
> tangle-file))) (message "Tangled %d code block%s from %s" block-counter (if
> (= block-counter 1) "" "s") (file-name-nondirectory (buffer-file-name (or
> (buffer-base-buffer) (current-buffer) (and (org-src-edit-buffer-p)
> (org-src-source-buffer)))))) (if org-babel-post-tangle-hook (progn (mapc
> #'(lambda (file) (let* ... ... ... ... ... temp-result)) path-collector)))
> (run-hooks 'org-babel-tangle-finished-hook) path-collector))
> (save-restriction (save-excursion (if (equal arg '(4)) (progn (let ((head
> (org-babel-where-is-src-block-head))) (if head (goto-char head) (user-error
> "Point is not in a source code block"))))) (let ((block-counter 0)
> (org-babel-default-header-args (if target-file (org-babel-merge-params
> org-babel-default-header-args (list ...)) org-babel-default-header-args))
> (tangle-file (if (equal arg '...) (progn (or ... ...)))) path-collector
> (source-file buffer-file-name)) (mapc #'(lambda (by-fn) (let (...) (if
> file-name ...))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t)
> (org-babel-tangle-collect-blocks lang-re tangle-file))) (message "Tangled %d
> code block%s from %s" block-counter (if (= block-counter 1) "" "s")
> (file-name-nondirectory (buffer-file-name (or (buffer-base-buffer)
> (current-buffer) (and ... ...))))) (if org-babel-post-tangle-hook (progn
> (mapc #'(lambda ... ...) path-collector))) (run-hooks
> 'org-babel-tangle-finished-hook) path-collector)))
> org-babel-tangle(nil)
> funcall-interactively(org-babel-tangle nil)
> command-execute(org-babel-tangle)
>
>
> >>> I recommend running make test to check the patch.
>
> > I will do that. After reviewing the `ob-tangle/collect-blocks', I
> > found the following test cases.
> >
> > #+begin_src emacs-lisp :tangle %r
> > "H2: relative org-file.lang-ext :tangle %r"
> > #+end_src
> >
> > #+begin_src emacs-lisp :tangle %a
> > "H1: absolute org-file.lang-ext :tangle %a\"
> > #+end_src
> >
> > %r and %a are not mentioned in either the org manual or ob-tangle.el.
> > Where is their logic implemented in ob-tangle.el?
>
> %a and %r are the placeholders for `format-spec', which see.
>
> --
> Ihor Radchenko // yantar92,
> Org mode maintainer,
> 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>
