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>
