diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 121c6b5c4..edae316ff 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -746,7 +746,8 @@ (defun org-fold-core-initialize (&optional specs) (add-hook 'clone-indirect-buffer-hook #'org-fold-core-decouple-indirect-buffer-folds nil 'local) ;; Optimise buffer fontification to not fontify folded text. (when (eq font-lock-fontify-region-function #'font-lock-default-fontify-region) - (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region)) + (setq-local font-lock-fontify-region-function 'org-fold-core-fontify-region) + (add-to-list 'font-lock-extra-managed-props 'org-fold-core-fontified)) ;; Setup killing text (setq-local filter-buffer-substring-function #'org-fold-core--buffer-substring-filter) (if (and (boundp 'isearch-opened-regions) @@ -1429,35 +1430,47 @@ (defun org-fold-core--buffer-substring-filter (beg end &optional delete) return-string)) ;;; Do not fontify folded text until needed. - +(defvar org-fold-core--force-fontification nil + "Let-bind this variable to t in order to force fontification in +folded regions.") (defun org-fold-core-fontify-region (beg end loudly &optional force) "Run `font-lock-default-fontify-region' in visible regions." - (let ((pos beg) next - (org-fold-core--fontifying t)) - (while (< pos end) - (setq next (org-fold-core-next-folding-state-change - (if force nil - (let (result) - (dolist (spec (org-fold-core-folding-spec-list)) - (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) - (org-fold-core-get-folding-spec-property spec :font-lock-skip)) - (push spec result))) - result)) - pos - end)) - (while (and (not (catch :found - (dolist (spec (org-fold-core-get-folding-spec 'all next)) - (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) - (throw :found spec))))) - (< next end)) - (setq next (org-fold-core-next-folding-state-change nil next end))) - (save-excursion - (font-lock-default-fontify-region pos next loudly) - (save-match-data - (unless (<= pos (point) next) - (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) - (put-text-property pos next 'org-fold-core-fontified t) - (setq pos next)))) + (with-silent-modifications + (let ((pos beg) next + (force (or force org-fold-core--force-fontification)) + (org-fold-core--fontifying t) + (skip-specs + (let (result) + (dolist (spec (org-fold-core-folding-spec-list)) + (when (and (not (org-fold-core-get-folding-spec-property spec :visible)) + (org-fold-core-get-folding-spec-property spec :font-lock-skip)) + (push spec result))) + result))) + ;; Move POS to first visible point within BEG..END. + (while (and (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all pos)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec)))) + (< pos end)) + (setq pos (org-fold-core-next-folding-state-change nil pos end))) + (when force (setq pos beg next end)) + (while (< pos end) + (unless force + (setq next (org-fold-core-next-folding-state-change skip-specs pos end))) + ;; Move to the end of the region to be fontified. + (while (and (not (catch :found + (dolist (spec (org-fold-core-get-folding-spec 'all next)) + (when (org-fold-core-get-folding-spec-property spec :font-lock-skip) + (throw :found spec))))) + (< next end)) + (setq next (org-fold-core-next-folding-state-change nil next end))) + (save-excursion + (font-lock-default-fontify-region pos next loudly) + (save-match-data + (unless (<= pos (point) next) + (run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) + (put-text-property pos next 'org-fold-core-fontified t) + (setq pos next))))) (defun org-fold-core-update-optimisation (beg end) "Update huge buffer optimisation between BEG and END. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index db98dd149..867139742 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -39,6 +39,7 @@ (declare-function org-agenda-files "org" (&optional unrestricted archives)) (declare-function org-fold-show-context "org-fold" (&optional key)) (declare-function org-fold-save-outline-visibility "org-fold" (use-markers &rest body)) (declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p)) +(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body)) (declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p)) (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) @@ -1172,6 +1173,36 @@ (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t org-emphasis t) "Properties to remove when a string without properties is wanted.") +(defvar org-fold-core--force-fontification) +(defmacro org-with-forced-fontification (&rest body) + "Run BODY forcing fontification of folded regions." + (declare (debug (form body)) (indent 1)) + `(unwind-protect + (progn + (setq org-fold-core--force-fontification t) + ,@body) + (setq org-fold-core--force-fontification nil))) + +(defun org-buffer-substring-fontified (beg end) + "Return fontified region between BEG and END." + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all beg end 'org-fold-core-fontified t) + (save-match-data (font-lock-fontify-region beg end))))) + (buffer-substring beg end)) + +(defun org-looking-at-fontified (re) + "Call `looking-at' RE and make sure that the match is fontified." + (prog1 (looking-at re) + (when (bound-and-true-p jit-lock-mode) + (org-with-forced-fontification + (when (text-property-not-all + (match-beginning 0) (match-end 0) + 'org-fold-core-fontified t) + (save-match-data + (font-lock-fontify-region (match-beginning 0) + (match-end 0)))))))) + (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed