Hi Tobias, Thanks for your efforts. I have prepared a patch accordingly that wraps org-src-font-lock-fontify-block’s body with save-match-data (attached).
If I don’t hear anything bad about it in the next few days, I’ll push it :) Please let me know if my commit message agrees with your understanding of the issue. All the best, Timothy
>From c435fd41428b6eb4f9f7971e73ca0a422006461b Mon Sep 17 00:00:00 2001 From: TEC <t...@tecosaur.com> Date: Mon, 23 Aug 2021 15:09:24 +0800 Subject: [PATCH] org-src: Save match data when fontifying src block * lisp/org-src.el (org-src-font-lock-fontify-block): Since `org-src-font-lock-fontify-block' modifies match data during fontification, when called in `org-fontify-meta-lines-and-blocks-1' by `font-lock-fontify-region' the text property font-lock-multiline is applied to text from the beginning to the last match. Since there is a difference in buffer sizes, the match data is invalid and problematic. This issue can drastically slow down editing operations in large source blocks. This can be avoided simply by wrapping `save-match-data' around `org-src-font-lock-fontify-block'. Reported by: "Tobias Zawada" <i_in...@tn-home.de> <https://lists.gnu.org/archive/html/emacs-orgmode/2021-08/msg00307.html> --- lisp/org-src.el | 69 +++++++++++++++++++++++++------------------------ 1 file changed, 35 insertions(+), 34 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 4698c6dd2..ce33e1f54 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -586,40 +586,41 @@ (defun org-src-font-lock-fontify-block (lang start end) "Fontify code block. This function is called by emacs automatic fontification, as long as `org-src-fontify-natively' is non-nil." - (let ((lang-mode (org-src-get-lang-mode lang))) - (when (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (org-buffer (current-buffer))) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (format " *org-src-fontification:%s*" lang-mode)) - (let ((inhibit-modification-hooks nil)) - (erase-buffer) - ;; Add string and a final space to ensure property change. - (insert string " ")) - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (org-font-lock-ensure) - (let ((pos (point-min)) next) - (while (setq next (next-property-change pos)) - ;; Handle additional properties from font-lock, so as to - ;; preserve, e.g., composition. - (dolist (prop (cons 'face font-lock-extra-managed-props)) - (let ((new-prop (get-text-property pos prop))) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) prop new-prop - org-buffer))) - (setq pos next)))) - ;; Add Org faces. - (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) - (when (or (facep src-face) (listp src-face)) - (font-lock-append-text-property start end 'face src-face)) - (font-lock-append-text-property start end 'face 'org-block)) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) + (save-match-data + (let ((lang-mode (org-src-get-lang-mode lang))) + (when (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer))) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (format " *org-src-fontification:%s*" lang-mode)) + (let ((inhibit-modification-hooks nil)) + (erase-buffer) + ;; Add string and a final space to ensure property change. + (insert string " ")) + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (org-font-lock-ensure) + (let ((pos (point-min)) next) + (while (setq next (next-property-change pos)) + ;; Handle additional properties from font-lock, so as to + ;; preserve, e.g., composition. + (dolist (prop (cons 'face font-lock-extra-managed-props)) + (let ((new-prop (get-text-property pos prop))) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) prop new-prop + org-buffer))) + (setq pos next)))) + ;; Add Org faces. + (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) + (when (or (facep src-face) (listp src-face)) + (font-lock-append-text-property start end 'face src-face)) + (font-lock-append-text-property start end 'face 'org-block)) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified)))))) ;;; Escape contents -- 2.32.0
