Skip to content

Commit f5c9ce8

Browse files
yantar92yantar92
committed
org-babel-exp-process-buffer: Disable edit control while processing
* lisp/ob-exp.el (org-babel-exp-process-buffer): Do not track buffer changes in element cache and org-fold after-change hooks while updating src blocks. `org-babel-exp-process-buffer' makes a large number of changes, which would overload the element cache and degrade performance.
1 parent 84c89ea commit f5c9ce8

File tree

1 file changed

+134
-127
lines changed

1 file changed

+134
-127
lines changed

‎lisp/ob-exp.el‎

Lines changed: 134 additions & 127 deletions
Original file line numberDiff line numberDiff line change
@@ -157,133 +157,140 @@ this template."
157157
;; Evaluate from top to bottom every Babel block
158158
;; encountered.
159159
(goto-char (point-min))
160-
(while (re-search-forward regexp nil t)
161-
(unless (save-match-data (or (org-in-commented-heading-p)
162-
(org-in-archived-heading-p)))
163-
(let* ((object? (match-end 1))
164-
(element (save-match-data
165-
(if object? (org-element-context)
166-
;; No deep inspection if we're
167-
;; just looking for an element.
168-
(org-element-at-point))))
169-
(type
170-
(pcase (org-element-type element)
171-
;; Discard block elements if we're looking
172-
;; for inline objects. False results
173-
;; happen when, e.g., "call_" syntax is
174-
;; located within affiliated keywords:
175-
;;
176-
;; #+name: call_src
177-
;; #+begin_src ...
178-
((and (or `babel-call `src-block) (guard object?))
179-
nil)
180-
(type type)))
181-
(begin
182-
(copy-marker (org-element-property :begin element)))
183-
(end
184-
(copy-marker
185-
(save-excursion
186-
(goto-char (org-element-property :end element))
187-
(skip-chars-backward " \r\t\n")
188-
(point)))))
189-
(pcase type
190-
(`inline-src-block
191-
(let* ((info
192-
(org-babel-get-src-block-info nil element))
193-
(params (nth 2 info)))
194-
(setf (nth 1 info)
195-
(if (and (cdr (assq :noweb params))
196-
(string= "yes"
197-
(cdr (assq :noweb params))))
198-
(org-babel-expand-noweb-references
199-
info org-babel-exp-reference-buffer)
200-
(nth 1 info)))
201-
(goto-char begin)
202-
(let ((replacement
203-
(org-babel-exp-do-export info 'inline)))
204-
(if (equal replacement "")
205-
;; Replacement code is empty: remove
206-
;; inline source block, including extra
207-
;; white space that might have been
208-
;; created when inserting results.
209-
(delete-region begin
210-
(progn (goto-char end)
211-
(skip-chars-forward " \t")
212-
(point)))
213-
;; Otherwise: remove inline source block
214-
;; but preserve following white spaces.
215-
;; Then insert value.
216-
(delete-region begin end)
217-
(insert replacement)))))
218-
((or `babel-call `inline-babel-call)
219-
(org-babel-exp-do-export
220-
(or (org-babel-lob-get-info element)
221-
(user-error "Unknown Babel reference: %s"
222-
(org-element-property :call element)))
223-
'lob)
224-
(let ((rep
225-
(org-fill-template
226-
org-babel-exp-call-line-template
227-
`(("line" .
228-
,(org-element-property :value element))))))
229-
;; If replacement is empty, completely remove
230-
;; the object/element, including any extra
231-
;; white space that might have been created
232-
;; when including results.
233-
(if (equal rep "")
234-
(delete-region
235-
begin
236-
(progn (goto-char end)
237-
(if (not (eq type 'babel-call))
238-
(progn (skip-chars-forward " \t")
239-
(point))
240-
(skip-chars-forward " \r\t\n")
241-
(line-beginning-position))))
242-
;; Otherwise, preserve trailing
243-
;; spaces/newlines and then, insert
244-
;; replacement string.
245-
(goto-char begin)
246-
(delete-region begin end)
247-
(insert rep))))
248-
(`src-block
249-
(let ((match-start (copy-marker (match-beginning 0)))
250-
(ind (current-indentation)))
251-
;; Take care of matched block: compute
252-
;; replacement string. In particular, a nil
253-
;; REPLACEMENT means the block is left as-is
254-
;; while an empty string removes the block.
255-
(let ((replacement
256-
(progn (goto-char match-start)
257-
(org-babel-exp-src-block))))
258-
(cond ((not replacement) (goto-char end))
259-
((equal replacement "")
260-
(goto-char end)
261-
(skip-chars-forward " \r\t\n")
262-
(beginning-of-line)
263-
(delete-region begin (point)))
264-
(t
265-
(goto-char match-start)
266-
(delete-region (point)
267-
(save-excursion
268-
(goto-char end)
269-
(line-end-position)))
270-
(insert replacement)
271-
(if (or org-src-preserve-indentation
272-
(org-element-property
273-
:preserve-indent element))
274-
;; Indent only code block
275-
;; markers.
276-
(save-excursion
277-
(skip-chars-backward " \r\t\n")
278-
(indent-line-to ind)
279-
(goto-char match-start)
280-
(indent-line-to ind))
281-
;; Indent everything.
282-
(indent-rigidly
283-
match-start (point) ind)))))
284-
(set-marker match-start nil))))
285-
(set-marker begin nil)
286-
(set-marker end nil)))))
160+
;; We are about to do a large number of changes in
161+
;; buffer. Do not try to track them in cache and update
162+
;; the folding states. Reset the cache afterwards.
163+
(org-element-with-disabled-cache
164+
(org-fold-core-ignore-modifications
165+
(while (re-search-forward regexp nil t)
166+
(unless (save-match-data (or (org-in-commented-heading-p)
167+
(org-in-archived-heading-p)))
168+
(let* ((object? (match-end 1))
169+
(element (save-match-data
170+
(if object? (org-element-context)
171+
;; No deep inspection if we're
172+
;; just looking for an element.
173+
(org-element-at-point))))
174+
(type
175+
(pcase (org-element-type element)
176+
;; Discard block elements if we're looking
177+
;; for inline objects. False results
178+
;; happen when, e.g., "call_" syntax is
179+
;; located within affiliated keywords:
180+
;;
181+
;; #+name: call_src
182+
;; #+begin_src ...
183+
((and (or `babel-call `src-block) (guard object?))
184+
nil)
185+
(type type)))
186+
(begin
187+
(copy-marker (org-element-property :begin element)))
188+
(end
189+
(copy-marker
190+
(save-excursion
191+
(goto-char (org-element-property :end element))
192+
(skip-chars-backward " \r\t\n")
193+
(point)))))
194+
(pcase type
195+
(`inline-src-block
196+
(let* ((info
197+
(org-babel-get-src-block-info nil element))
198+
(params (nth 2 info)))
199+
(setf (nth 1 info)
200+
(if (and (cdr (assq :noweb params))
201+
(string= "yes"
202+
(cdr (assq :noweb params))))
203+
(org-babel-expand-noweb-references
204+
info org-babel-exp-reference-buffer)
205+
(nth 1 info)))
206+
(goto-char begin)
207+
(let ((replacement
208+
(org-babel-exp-do-export info 'inline)))
209+
(if (equal replacement "")
210+
;; Replacement code is empty: remove
211+
;; inline source block, including extra
212+
;; white space that might have been
213+
;; created when inserting results.
214+
(delete-region begin
215+
(progn (goto-char end)
216+
(skip-chars-forward " \t")
217+
(point)))
218+
;; Otherwise: remove inline source block
219+
;; but preserve following white spaces.
220+
;; Then insert value.
221+
(delete-region begin end)
222+
(insert replacement)))))
223+
((or `babel-call `inline-babel-call)
224+
(org-babel-exp-do-export
225+
(or (org-babel-lob-get-info element)
226+
(user-error "Unknown Babel reference: %s"
227+
(org-element-property :call element)))
228+
'lob)
229+
(let ((rep
230+
(org-fill-template
231+
org-babel-exp-call-line-template
232+
`(("line" .
233+
,(org-element-property :value element))))))
234+
;; If replacement is empty, completely remove
235+
;; the object/element, including any extra
236+
;; white space that might have been created
237+
;; when including results.
238+
(if (equal rep "")
239+
(delete-region
240+
begin
241+
(progn (goto-char end)
242+
(if (not (eq type 'babel-call))
243+
(progn (skip-chars-forward " \t")
244+
(point))
245+
(skip-chars-forward " \r\t\n")
246+
(line-beginning-position))))
247+
;; Otherwise, preserve trailing
248+
;; spaces/newlines and then, insert
249+
;; replacement string.
250+
(goto-char begin)
251+
(delete-region begin end)
252+
(insert rep))))
253+
(`src-block
254+
(let ((match-start (copy-marker (match-beginning 0)))
255+
(ind (current-indentation)))
256+
;; Take care of matched block: compute
257+
;; replacement string. In particular, a nil
258+
;; REPLACEMENT means the block is left as-is
259+
;; while an empty string removes the block.
260+
(let ((replacement
261+
(progn (goto-char match-start)
262+
(org-babel-exp-src-block))))
263+
(cond ((not replacement) (goto-char end))
264+
((equal replacement "")
265+
(goto-char end)
266+
(skip-chars-forward " \r\t\n")
267+
(beginning-of-line)
268+
(delete-region begin (point)))
269+
(t
270+
(goto-char match-start)
271+
(delete-region (point)
272+
(save-excursion
273+
(goto-char end)
274+
(line-end-position)))
275+
(insert replacement)
276+
(if (or org-src-preserve-indentation
277+
(org-element-property
278+
:preserve-indent element))
279+
;; Indent only code block
280+
;; markers.
281+
(save-excursion
282+
(skip-chars-backward " \r\t\n")
283+
(indent-line-to ind)
284+
(goto-char match-start)
285+
(indent-line-to ind))
286+
;; Indent everything.
287+
(indent-rigidly
288+
match-start (point) ind)))))
289+
(set-marker match-start nil))))
290+
(set-marker begin nil)
291+
(set-marker end nil))))))
292+
;; Reset the outdated cache.
293+
(org-element-cache-reset))
287294
(kill-buffer org-babel-exp-reference-buffer)
288295
(remove-text-properties (point-min) (point-max)
289296
'(org-reference nil)))))))

0 commit comments

Comments
 (0)