emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Ihor Radchenko <yantar92@gmail.com>
To: emacs-orgmode@gnu.org
Cc: Ihor Radchenko <yantar92@gmail.com>
Subject: [RFC PATCH 2/2] org-babel-expand-noweb-references: Cache block info
Date: Mon,  7 Feb 2022 20:31:15 +0800	[thread overview]
Message-ID: <17a5be9ec7f969a7a79088e079e94efab8b838b8.1644236545.git.yantar92@gmail.com> (raw)
In-Reply-To: <cover.1644236545.git.yantar92@gmail.com>

* lisp/ob-core.el (org-babel-expand-noweb-references--cache):
(org-babel-expand-noweb-references--cache-buffer): New variables
storing info cache.
(org-babel-expand-noweb-references): Make use of global info cache to
avoid extra parsing.  Use `cl-macrolet' instead of defining transient
lambda functions on every call.
---
 lisp/ob-core.el | 225 +++++++++++++++++++++++++++---------------------
 1 file changed, 127 insertions(+), 98 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 239a57f96..e767fd107 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -2790,6 +2790,10 @@ (defun org-babel-noweb-p (params context)
     (cl-some (lambda (v) (member v allowed-values))
 	     (split-string (or (cdr (assq :noweb params)) "")))))
 
+(defvar org-babel-expand-noweb-references--cache nil
+  "Noweb reference cache used during expansion.")
+(defvar org-babel-expand-noweb-references--cache-buffer nil
+  "Cons of (buffer . modified-tick) cached by `org-babel-expand-noweb-references--cache'.")
 (defun org-babel-expand-noweb-references (&optional info parent-buffer)
   "Expand Noweb references in the body of the current source code block.
 
@@ -2827,104 +2831,129 @@ (defun org-babel-expand-noweb-references (&optional info parent-buffer)
 	 (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
 	 (noweb-re (format "\\(.*?\\)\\(%s\\)"
 			   (with-current-buffer parent-buffer
-			     (org-babel-noweb-wrap))))
-	 (cache nil)
-	 (c-wrap
-	  (lambda (s)
-	    ;; Comment string S, according to LANG mode.  Return new
-	    ;; string.
-	    (unless org-babel-tangle-uncomment-comments
-	      (with-temp-buffer
-		(funcall (org-src-get-lang-mode lang))
-		(comment-region (point)
-				(progn (insert s) (point)))
-		(org-trim (buffer-string))))))
-	 (expand-body
-	  (lambda (i)
-	    ;; Expand body of code represented by block info I.
-	    (let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
-			 (org-babel-expand-noweb-references i)
-		       (nth 1 i))))
-	      (if (not comment) b
-		(let ((cs (org-babel-tangle-comment-links i)))
-		  (concat (funcall c-wrap (car cs)) "\n"
-			  b "\n"
-			  (funcall c-wrap (cadr cs))))))))
-	 (expand-references
-	  (lambda (ref cache)
-	    (pcase (gethash ref cache)
-	      (`(,last . ,previous)
-	       ;; Ignore separator for last block.
-	       (let ((strings (list (funcall expand-body last))))
-		 (dolist (i previous)
-		   (let ((parameters (nth 2 i)))
-		     ;; Since we're operating in reverse order, first
-		     ;; push separator, then body.
-		     (push (or (cdr (assq :noweb-sep parameters)) "\n")
-			   strings)
-		     (push (funcall expand-body i) strings)))
-		 (mapconcat #'identity strings "")))
-	      ;; Raise an error about missing reference, or return the
-	      ;; empty string.
-	      ((guard (or org-babel-noweb-error-all-langs
-			  (member lang org-babel-noweb-error-langs)))
-	       (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
-		      (org-babel-noweb-wrap ref)))
-	      (_ "")))))
-    (replace-regexp-in-string
-     noweb-re
-     (lambda (m)
-       (with-current-buffer parent-buffer
-	 (save-match-data
-	   (let* ((prefix (match-string 1 m))
-		  (id (match-string 3 m))
-		  (evaluate (string-match-p "(.*)" id))
-		  (expansion
-		   (cond
-		    (evaluate
-		     ;; Evaluation can potentially modify the buffer
-		     ;; and invalidate the cache: reset it.
-		     (setq cache nil)
-		     (let ((raw (org-babel-ref-resolve id)))
-		       (if (stringp raw) raw (format "%S" raw))))
-		    ;; Return the contents of headlines literally.
-		    ((org-babel-ref-goto-headline-id id)
-		     (org-babel-ref-headline-body))
-		    ;; Look for a source block named SOURCE-NAME.  If
-		    ;; found, assume it is unique; do not look after
-		    ;; `:noweb-ref' header argument.
-		    ((org-with-point-at 1
-		       (let ((r (org-babel-named-src-block-regexp-for-name id)))
-			 (and (re-search-forward r nil t)
-			      (not (org-in-commented-heading-p))
-			      (funcall expand-body
-				       (org-babel-get-src-block-info t))))))
-		    ;; Retrieve from the Library of Babel.
-		    ((nth 2 (assoc-string id org-babel-library-of-babel)))
-		    ;; All Noweb references were cached in a previous
-		    ;; run.  Extract the information from the cache.
-		    ((hash-table-p cache)
-		     (funcall expand-references id cache))
-		    ;; Though luck.  We go into the long process of
-		    ;; checking each source block and expand those
-		    ;; with a matching Noweb reference.  Since we're
-		    ;; going to visit all source blocks in the
-		    ;; document, cache information about them as well.
-		    (t
-		     (setq cache (make-hash-table :test #'equal))
-		     (org-with-wide-buffer
-		      (org-babel-map-src-blocks nil
-			(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)))))
-			    (push info (gethash ref cache))))))
-		     (funcall expand-references id cache)))))
-	     ;; Interpose PREFIX between every line.
-	     (mapconcat #'identity
-			(split-string expansion "[\n\r]")
-			(concat "\n" prefix))))))
-     body t t 2)))
+			     (org-babel-noweb-wrap)))))
+    (unless (equal (cons parent-buffer
+                         (with-current-buffer parent-buffer
+                           (buffer-chars-modified-tick)))
+                   org-babel-expand-noweb-references--cache-buffer)
+      (setq org-babel-expand-noweb-references--cache nil
+            org-babel-expand-noweb-references--cache-buffer
+            (cons parent-buffer
+                  (with-current-buffer parent-buffer
+                    (buffer-chars-modified-tick)))))
+    (cl-macrolet ((c-wrap
+	            (s)
+	            ;; Comment string S, according to LANG mode.  Return new
+	            ;; string.
+	            `(unless org-babel-tangle-uncomment-comments
+	               (with-temp-buffer
+		         (funcall (org-src-get-lang-mode lang))
+		         (comment-region (point)
+				         (progn (insert ,s) (point)))
+		         (org-trim (buffer-string)))))
+	          (expand-body
+	            (i)
+	            ;; Expand body of code represented by block info I.
+	            `(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval)
+			          (org-babel-expand-noweb-references ,i)
+		                (nth 1 ,i))))
+	               (if (not comment) b
+		         (let ((cs (org-babel-tangle-comment-links ,i)))
+		           (concat (c-wrap (car cs)) "\n"
+			           b "\n"
+			           (c-wrap (cadr cs)))))))
+	          (expand-references
+	            (ref)
+	            `(pcase (gethash ,ref org-babel-expand-noweb-references--cache)
+	               (`(,last . ,previous)
+	                ;; Ignore separator for last block.
+	                (let ((strings (list (expand-body last))))
+		          (dolist (i previous)
+		            (let ((parameters (nth 2 i)))
+		              ;; Since we're operating in reverse order, first
+		              ;; push separator, then body.
+		              (push (or (cdr (assq :noweb-sep parameters)) "\n")
+			            strings)
+		              (push (expand-body i) strings)))
+		          (mapconcat #'identity strings "")))
+	               ;; Raise an error about missing reference, or return the
+	               ;; empty string.
+	               ((guard (or org-babel-noweb-error-all-langs
+			           (member lang org-babel-noweb-error-langs)))
+	                (error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
+		               (org-babel-noweb-wrap ,ref)))
+	               (_ ""))))
+      (replace-regexp-in-string
+       noweb-re
+       (lambda (m)
+         (with-current-buffer parent-buffer
+	   (save-match-data
+	     (let* ((prefix (match-string 1 m))
+		    (id (match-string 3 m))
+		    (evaluate (string-match-p "(.*)" id))
+		    (expansion
+		     (cond
+		      (evaluate
+                       (prog1
+		           (let ((raw (org-babel-ref-resolve id)))
+		             (if (stringp raw) raw (format "%S" raw)))
+                         ;; Evaluation can potentially modify the buffer
+		         ;; and invalidate the cache: reset it.
+                         (unless (equal org-babel-expand-noweb-references--cache-buffer
+                                        (cons parent-buffer
+                                              (buffer-chars-modified-tick)))
+		           (setq org-babel-expand-noweb-references--cache nil
+                                 org-babel-expand-noweb-references--cache-buffer
+                                 (cons parent-buffer
+                                       (with-current-buffer parent-buffer
+                                         (buffer-chars-modified-tick)))))))
+                      ;; Already cached.
+                      ((and (hash-table-p org-babel-expand-noweb-references--cache)
+                            (gethash id org-babel-expand-noweb-references--cache))
+                       (expand-references id))
+		      ;; Return the contents of headlines literally.
+		      ((org-babel-ref-goto-headline-id id)
+		       (org-babel-ref-headline-body))
+		      ;; Look for a source block named SOURCE-NAME.  If
+		      ;; found, assume it is unique; do not look after
+		      ;; `:noweb-ref' header argument.
+		      ((org-with-point-at 1
+		         (let ((r (org-babel-named-src-block-regexp-for-name id)))
+			   (and (re-search-forward r nil t)
+			        (not (org-in-commented-heading-p))
+                                (let ((info (org-babel-get-src-block-info t)))
+                                  (unless (hash-table-p org-babel-expand-noweb-references--cache)
+                                    (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)))
+                                  (push info (gethash id  org-babel-expand-noweb-references--cache))
+			          (expand-body info))))))
+		      ;; Retrieve from the Library of Babel.
+		      ((nth 2 (assoc-string id org-babel-library-of-babel)))
+		      ;; All Noweb references were cached in a previous
+		      ;; run.  Yet, ID is not in cache (see the above
+		      ;; condition).  Process missing reference in
+		      ;; `expand-references'.
+		      ((hash-table-p org-babel-expand-noweb-references--cache)
+		       (expand-references id))
+		      ;; Though luck.  We go into the long process of
+		      ;; checking each source block and expand those
+		      ;; with a matching Noweb reference.  Since we're
+		      ;; going to visit all source blocks in the
+		      ;; document, cache information about them as well.
+		      (t
+		       (setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal))
+		       (org-with-wide-buffer
+		        (org-babel-map-src-blocks nil
+			  (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)))))
+			      (push info (gethash ref org-babel-expand-noweb-references--cache))))))
+		       (expand-references id)))))
+	       ;; Interpose PREFIX between every line.
+	       (mapconcat #'identity
+			  (split-string expansion "[\n\r]")
+			  (concat "\n" prefix))))))
+       body t t 2))))
 
 (defun org-babel--script-escape-inner (str)
   (let (in-single in-double backslash out)
-- 
2.34.1



  parent reply	other threads:[~2022-02-07 12:28 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-02-07 12:31 [RFC PATCH 0/2] Make org-babel-tangle usable in after-save-hook on large org buffers Ihor Radchenko
2022-02-07 12:31 ` [RFC PATCH 1/2] org-babel-tangle-single-block: Do not create comment link when not requested Ihor Radchenko
2022-02-07 12:31 ` Ihor Radchenko [this message]
2022-07-31  6:43 ` [RFC PATCH 0/2] Make org-babel-tangle usable in after-save-hook on large org buffers Ihor Radchenko

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=17a5be9ec7f969a7a79088e079e94efab8b838b8.1644236545.git.yantar92@gmail.com \
    --to=yantar92@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).