Skip to content

Commit 0435fea

Browse files
yantar92yantar92
committed
org-babel-expand-noweb-references: Cache block info
* 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.
1 parent 0d3bf2e commit 0435fea

File tree

1 file changed

+129
-100
lines changed

1 file changed

+129
-100
lines changed

‎lisp/ob-core.el‎

Lines changed: 129 additions & 100 deletions
Original file line numberDiff line numberDiff line change
@@ -2844,6 +2844,10 @@ CONTEXT may be one of :tangle, :export or :eval."
28442844
(cl-some (lambda (v) (member v allowed-values))
28452845
(split-string (or (cdr (assq :noweb params)) "")))))
28462846

2847+
(defvar org-babel-expand-noweb-references--cache nil
2848+
"Noweb reference cache used during expansion.")
2849+
(defvar org-babel-expand-noweb-references--cache-buffer nil
2850+
"Cons of (buffer . modified-tick) cached by `org-babel-expand-noweb-references--cache'.")
28472851
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
28482852
"Expand Noweb references in the body of the current source code block.
28492853
@@ -2885,106 +2889,131 @@ block but are passed literally to the \"example-block\"."
28852889
(not (equal (cdr v) "no"))))))
28862890
(noweb-re (format "\\(.*?\\)\\(%s\\)"
28872891
(with-current-buffer parent-buffer
2888-
(org-babel-noweb-wrap))))
2889-
(cache nil)
2890-
(c-wrap
2891-
(lambda (s)
2892-
;; Comment string S, according to LANG mode. Return new
2893-
;; string.
2894-
(unless org-babel-tangle-uncomment-comments
2895-
(with-temp-buffer
2896-
(funcall (org-src-get-lang-mode lang))
2897-
(comment-region (point)
2898-
(progn (insert s) (point)))
2899-
(org-trim (buffer-string))))))
2900-
(expand-body
2901-
(lambda (i)
2902-
;; Expand body of code represented by block info I.
2903-
(let ((b (if (org-babel-noweb-p (nth 2 i) :eval)
2904-
(org-babel-expand-noweb-references i)
2905-
(nth 1 i))))
2906-
(if (not comment) b
2907-
(let ((cs (org-babel-tangle-comment-links i)))
2908-
(concat (funcall c-wrap (car cs)) "\n"
2909-
b "\n"
2910-
(funcall c-wrap (cadr cs))))))))
2911-
(expand-references
2912-
(lambda (ref cache)
2913-
(pcase (gethash ref cache)
2914-
(`(,last . ,previous)
2915-
;; Ignore separator for last block.
2916-
(let ((strings (list (funcall expand-body last))))
2917-
(dolist (i previous)
2918-
(let ((parameters (nth 2 i)))
2919-
;; Since we're operating in reverse order, first
2920-
;; push separator, then body.
2921-
(push (or (cdr (assq :noweb-sep parameters)) "\n")
2922-
strings)
2923-
(push (funcall expand-body i) strings)))
2924-
(mapconcat #'identity strings "")))
2925-
;; Raise an error about missing reference, or return the
2926-
;; empty string.
2927-
((guard (or org-babel-noweb-error-all-langs
2928-
(member lang org-babel-noweb-error-langs)))
2929-
(error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
2930-
(org-babel-noweb-wrap ref)))
2931-
(_ "")))))
2932-
(replace-regexp-in-string
2933-
noweb-re
2934-
(lambda (m)
2935-
(with-current-buffer parent-buffer
2936-
(save-match-data
2937-
(let* ((prefix (match-string 1 m))
2938-
(id (match-string 3 m))
2939-
(evaluate (string-match-p "(.*)" id))
2940-
(expansion
2941-
(cond
2942-
(evaluate
2943-
;; Evaluation can potentially modify the buffer
2944-
;; and invalidate the cache: reset it.
2945-
(setq cache nil)
2946-
(let ((raw (org-babel-ref-resolve id)))
2947-
(if (stringp raw) raw (format "%S" raw))))
2948-
;; Return the contents of headlines literally.
2949-
((org-babel-ref-goto-headline-id id)
2950-
(org-babel-ref-headline-body))
2951-
;; Look for a source block named SOURCE-NAME. If
2952-
;; found, assume it is unique; do not look after
2953-
;; `:noweb-ref' header argument.
2954-
((org-with-point-at 1
2955-
(let ((r (org-babel-named-src-block-regexp-for-name id)))
2956-
(and (re-search-forward r nil t)
2957-
(not (org-in-commented-heading-p))
2958-
(funcall expand-body
2959-
(org-babel-get-src-block-info t))))))
2960-
;; Retrieve from the Library of Babel.
2961-
((nth 2 (assoc-string id org-babel-library-of-babel)))
2962-
;; All Noweb references were cached in a previous
2963-
;; run. Extract the information from the cache.
2964-
((hash-table-p cache)
2965-
(funcall expand-references id cache))
2966-
;; Though luck. We go into the long process of
2967-
;; checking each source block and expand those
2968-
;; with a matching Noweb reference. Since we're
2969-
;; going to visit all source blocks in the
2970-
;; document, cache information about them as well.
2971-
(t
2972-
(setq cache (make-hash-table :test #'equal))
2973-
(org-with-wide-buffer
2974-
(org-babel-map-src-blocks nil
2975-
(if (org-in-commented-heading-p)
2976-
(org-forward-heading-same-level nil t)
2977-
(let* ((info (org-babel-get-src-block-info t))
2978-
(ref (cdr (assq :noweb-ref (nth 2 info)))))
2979-
(push info (gethash ref cache))))))
2980-
(funcall expand-references id cache)))))
2981-
;; Interpose PREFIX between every line.
2982-
(if noweb-prefix
2983-
(mapconcat #'identity
2984-
(split-string expansion "[\n\r]")
2985-
(concat "\n" prefix))
2986-
expansion)))))
2987-
body t t 2)))
2892+
(org-babel-noweb-wrap)))))
2893+
(unless (equal (cons parent-buffer
2894+
(with-current-buffer parent-buffer
2895+
(buffer-chars-modified-tick)))
2896+
org-babel-expand-noweb-references--cache-buffer)
2897+
(setq org-babel-expand-noweb-references--cache nil
2898+
org-babel-expand-noweb-references--cache-buffer
2899+
(cons parent-buffer
2900+
(with-current-buffer parent-buffer
2901+
(buffer-chars-modified-tick)))))
2902+
(cl-macrolet ((c-wrap
2903+
(s)
2904+
;; Comment string S, according to LANG mode. Return new
2905+
;; string.
2906+
`(unless org-babel-tangle-uncomment-comments
2907+
(with-temp-buffer
2908+
(funcall (org-src-get-lang-mode lang))
2909+
(comment-region (point)
2910+
(progn (insert ,s) (point)))
2911+
(org-trim (buffer-string)))))
2912+
(expand-body
2913+
(i)
2914+
;; Expand body of code represented by block info I.
2915+
`(let ((b (if (org-babel-noweb-p (nth 2 ,i) :eval)
2916+
(org-babel-expand-noweb-references ,i)
2917+
(nth 1 ,i))))
2918+
(if (not comment) b
2919+
(let ((cs (org-babel-tangle-comment-links ,i)))
2920+
(concat (c-wrap (car cs)) "\n"
2921+
b "\n"
2922+
(c-wrap (cadr cs)))))))
2923+
(expand-references
2924+
(ref)
2925+
`(pcase (gethash ,ref org-babel-expand-noweb-references--cache)
2926+
(`(,last . ,previous)
2927+
;; Ignore separator for last block.
2928+
(let ((strings (list (expand-body last))))
2929+
(dolist (i previous)
2930+
(let ((parameters (nth 2 i)))
2931+
;; Since we're operating in reverse order, first
2932+
;; push separator, then body.
2933+
(push (or (cdr (assq :noweb-sep parameters)) "\n")
2934+
strings)
2935+
(push (expand-body i) strings)))
2936+
(mapconcat #'identity strings "")))
2937+
;; Raise an error about missing reference, or return the
2938+
;; empty string.
2939+
((guard (or org-babel-noweb-error-all-langs
2940+
(member lang org-babel-noweb-error-langs)))
2941+
(error "Cannot resolve %s (see `org-babel-noweb-error-langs')"
2942+
(org-babel-noweb-wrap ,ref)))
2943+
(_ ""))))
2944+
(replace-regexp-in-string
2945+
noweb-re
2946+
(lambda (m)
2947+
(with-current-buffer parent-buffer
2948+
(save-match-data
2949+
(let* ((prefix (match-string 1 m))
2950+
(id (match-string 3 m))
2951+
(evaluate (string-match-p "(.*)" id))
2952+
(expansion
2953+
(cond
2954+
(evaluate
2955+
(prog1
2956+
(let ((raw (org-babel-ref-resolve id)))
2957+
(if (stringp raw) raw (format "%S" raw)))
2958+
;; Evaluation can potentially modify the buffer
2959+
;; and invalidate the cache: reset it.
2960+
(unless (equal org-babel-expand-noweb-references--cache-buffer
2961+
(cons parent-buffer
2962+
(buffer-chars-modified-tick)))
2963+
(setq org-babel-expand-noweb-references--cache nil
2964+
org-babel-expand-noweb-references--cache-buffer
2965+
(cons parent-buffer
2966+
(with-current-buffer parent-buffer
2967+
(buffer-chars-modified-tick)))))))
2968+
;; Already cached.
2969+
((and (hash-table-p org-babel-expand-noweb-references--cache)
2970+
(gethash id org-babel-expand-noweb-references--cache))
2971+
(expand-references id))
2972+
;; Return the contents of headlines literally.
2973+
((org-babel-ref-goto-headline-id id)
2974+
(org-babel-ref-headline-body))
2975+
;; Look for a source block named SOURCE-NAME. If
2976+
;; found, assume it is unique; do not look after
2977+
;; `:noweb-ref' header argument.
2978+
((org-with-point-at 1
2979+
(let ((r (org-babel-named-src-block-regexp-for-name id)))
2980+
(and (re-search-forward r nil t)
2981+
(not (org-in-commented-heading-p))
2982+
(let ((info (org-babel-get-src-block-info t)))
2983+
(unless (hash-table-p org-babel-expand-noweb-references--cache)
2984+
(setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal)))
2985+
(push info (gethash id org-babel-expand-noweb-references--cache))
2986+
(expand-body info))))))
2987+
;; Retrieve from the Library of Babel.
2988+
((nth 2 (assoc-string id org-babel-library-of-babel)))
2989+
;; All Noweb references were cached in a previous
2990+
;; run. Yet, ID is not in cache (see the above
2991+
;; condition). Process missing reference in
2992+
;; `expand-references'.
2993+
((hash-table-p org-babel-expand-noweb-references--cache)
2994+
(expand-references id))
2995+
;; Though luck. We go into the long process of
2996+
;; checking each source block and expand those
2997+
;; with a matching Noweb reference. Since we're
2998+
;; going to visit all source blocks in the
2999+
;; document, cache information about them as well.
3000+
(t
3001+
(setq org-babel-expand-noweb-references--cache (make-hash-table :test #'equal))
3002+
(org-with-wide-buffer
3003+
(org-babel-map-src-blocks nil
3004+
(if (org-in-commented-heading-p)
3005+
(org-forward-heading-same-level nil t)
3006+
(let* ((info (org-babel-get-src-block-info t))
3007+
(ref (cdr (assq :noweb-ref (nth 2 info)))))
3008+
(push info (gethash ref org-babel-expand-noweb-references--cache))))))
3009+
(expand-references id)))))
3010+
;; Interpose PREFIX between every line.
3011+
(if noweb-prefix
3012+
(mapconcat #'identity
3013+
(split-string expansion "[\n\r]")
3014+
(concat "\n" prefix))
3015+
expansion)))))
3016+
body t t 2))))
29883017

29893018
(defun org-babel--script-escape-inner (str)
29903019
(let (in-single in-double backslash out)

0 commit comments

Comments
 (0)