From 6ff6721ea706ff344f56be17ad04598e06b71973 Mon Sep 17 00:00:00 2001 From: Mingtong Lin Date: Thu, 27 Nov 2025 23:40:17 -0500 Subject: [PATCH 3/6] lisp/ob-core.el: Also generate numbered names for unnamed blocks that are referred via Noweb references. lisp/ob-tangle.el: Extract and generalize the name generation code. testing/lisp/test-ob-tangle.el: Add and update tests. * ob-core.el (org-babel-map-count-src-blocks, org-babel-tangle--unbracketed-link, org-babel-generate-block-name, org-babel-expand-noweb-references): Add org-babel-map-count-src-blocks and org-babel-generate-block-name that generalizes the name generation. The name generated now uses the search option in org-babel-tangle--unbracketed-link, so CUSTOM_ID will be respected. This helps to distinguish when two source blocks are from different headings that collide - the user can assign different CUSTOM_ID to the headings to resolve this. org-babel-expand-noweb-references is updated to generate name for :noweb-ref referred blocks that are unnamed. * ob-tangle.el (org-babel-tangle--unbracketed-link, org-babel-tangle-single-block, org-babel-tangle-collect-blocks): org-babel-tangle--unbracketed-link is moved to ob-core.el. The other two functions are updated to use the new abstraction. Link: https://list.orgmode.org/f43360bb-dc8f-41bb-b40e-dfdd38ebb87b@app.fastmail.com/ --- lisp/ob-core.el | 71 +++++++++++++++++++++++++++++++++- lisp/ob-tangle.el | 41 ++------------------ testing/lisp/test-ob-tangle.el | 57 ++++++++++++++++++++++++++- 3 files changed, 129 insertions(+), 40 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 32177fb56..c0ff8659c 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -3128,6 +3128,68 @@ CONTEXT may be one of :tangle, :export or :eval." (cl-some (lambda (v) (member v allowed-values)) (split-string (or (cdr (assq :noweb params)) ""))))) +(defmacro org-babel-map-count-src-blocks (file counter-var &rest body) + "A variant of `org-babel-map-src-blocks' that also tracks the number of source blocks. +The counter records the number of the current source block under +current heading. + +FILE and BODY see `org-babel-map-src-blocks' +COUNTER-VAR the variable symbol for current counter value." + (declare (indent 2)) + (let ((last-heading-pos-var (gensym "last-heading-pos-")) + (current-heading-pos-var (gensym "current-heading-pos-"))) + `(let ((,counter-var 0) + ,last-heading-pos-var) + (org-babel-map-src-blocks ,file + (let ((,current-heading-pos-var + (or (org-element-begin + (org-element-lineage + (org-element-at-point) + 'headline t)) + 1))) + (if (eq ,last-heading-pos-var ,current-heading-pos-var) + (cl-incf ,counter-var) + (setq ,counter-var 1) + (setq ,last-heading-pos-var ,current-heading-pos-var))) + ,@body)))) + +(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* ((l (org-no-properties (org-store-link nil))) + (bare (and l + (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--generate-block-name (link counter) + "Generate a name for source block. +LINK is the link to the source block, COUNTER is the number of the +source block, counted under the heading in the search option of LINK." + (let ((loc + (if (string-match "::" link) + (let ((search-option (substring link (match-end 0) + (length link)))) + ;; If the source block is not in a subtree, the search + ;; option will become "+begin_src ". + (if (or (string-prefix-p "+begin_src" search-option) + (string-prefix-p "+BEGIN_SRC" search-option)) + "No heading" + search-option)) + link))) + (format "%s:%d" loc counter))) + (defvar org-babel-expand-noweb-references--cache nil "Noweb reference cache used during expansion.") (defvar org-babel-expand-noweb-references--cache-buffer nil @@ -3312,11 +3374,18 @@ block but are passed literally to the \"example-block\"." (t (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)) (org-with-wide-buffer - (org-babel-map-src-blocks nil + (org-babel-map-count-src-blocks nil counter (if (org-in-commented-heading-p) (org-forward-heading-same-level nil t) (let* ((info (org-babel-get-src-block-info t)) (ref (cdr (assq :noweb-ref (nth 2 info))))) + ;; If the block is unnamed, generate one. + (when (and comment (not (nth 4 info))) + (setf (nth 4 info) + (org-babel--generate-block-name + (org-babel-tangle--unbracketed-link + (nth 2 info)) + counter))) (push info (gethash ref org-babel-expand-noweb-references--cache)))))) (puthash 'buffer-processed t org-babel-expand-noweb-references--cache) (expand-references id))))) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 022cc04bd..6e71800c7 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -488,19 +488,9 @@ source code blocks by languages matching a regular expression. Optional argument TANGLE-FILE can be used to limit the collected code blocks by target file." - (let ((counter 0) - (buffer-fn (buffer-file-name (buffer-base-buffer))) - last-heading-pos blocks) - (org-babel-map-src-blocks (buffer-file-name) - (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) (cl-incf counter) - (setq counter 1) - (setq last-heading-pos current-heading-pos))) + (let ((buffer-fn (buffer-file-name (buffer-base-buffer))) + blocks) + (org-babel-map-count-src-blocks (buffer-file-name) counter (unless (or (org-in-commented-heading-p) (org-in-archived-heading-p)) (let* ((info (org-babel-get-src-block-info 'no-eval)) @@ -527,26 +517,6 @@ 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* ((l (org-no-properties (org-store-link nil))) - (bare (and l - (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)))))) - (defvar org-outline-regexp) ; defined in lisp/org.el (defun org-babel-tangle-single-block (block-counter &optional only-this-block) "Collect the tangled source for current block. @@ -567,10 +537,7 @@ non-nil, return the full association list to be used by (link (org-babel-tangle--unbracketed-link params)) (source-name (or (nth 4 info) - (format "%s:%d" - (or (ignore-errors (nth 4 (org-heading-components))) - "No heading") - block-counter))) + (org-babel--generate-block-name link block-counter))) (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) (assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang))) diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el index cd45c1160..91b965b4a 100644 --- a/testing/lisp/test-ob-tangle.el +++ b/testing/lisp/test-ob-tangle.el @@ -158,8 +158,61 @@ echo 1 (with-temp-buffer (insert-file-contents "test-ob-tangle.el") (goto-char (point-min)) - (and (search-forward "[H:1]]" nil t) - (search-forward "[H:2]]" nil t)))) + (and (search-forward "[*H:1]]" nil t) + (search-forward "[*H:2]]" nil t)))) + (delete-file "test-ob-tangle.el"))))) + +(ert-deftest ob-tangle/comment-links-numbering-custom-id () + "Test numbering of source blocks when commenting with links, and +when the heading has a CUSTOM_ID." + (should + (org-test-with-temp-text-in-file + "* H +:PROPERTIES: +:CUSTOM_ID: myid +:END: +#+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") + (goto-char (point-min)) + (and (search-forward "[#myid:1]]" nil t) + (search-forward "[#myid:2]]" nil t)))) + (delete-file "test-ob-tangle.el"))))) + +(ert-deftest ob-tangle/comment-links-numbering-noweb () + "Test numbering of source blocks when commenting with links, when +they are referred by :noweb-ref." + (should + (org-test-with-temp-text-in-file + "* H +#+header: :noweb-ref strings +#+begin_src emacs-lisp +\"hello\" +#+end_src + +#+header: :tangle \"test-ob-tangle.el\" :comments noweb :noweb yes +#+begin_src emacs-lisp +<> +#+end_src" + (unwind-protect + (progn + (org-babel-tangle) + (with-temp-buffer + (insert-file-contents "test-ob-tangle.el") + (goto-char (point-min)) + (and (search-forward "[*H:2]]" nil t) + (search-forward "[*H:1]]" nil t)))) (delete-file "test-ob-tangle.el"))))) (ert-deftest ob-tangle/comment-links-relative-file () -- 2.39.5 (Apple Git-154)