org-fold-core-fontify-region: Fix cases when fontification is not registered

* lisp/org-fold-core.el (org-fold-core-fontify-region): Handle FORCE
argument better.  Skip unnecessary code parts when FORCE is non-nil.
Assign `fontified' text property manually in the actually fontified
regions.  We cannot just supply correct return value since jit-lock
does not allow piecewise fontification.
This commit is contained in:
Ihor Radchenko 2022-02-06 19:52:42 +08:00
parent 062e30be8a
commit 219bc6c2d3
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 27 additions and 24 deletions

View File

@ -1436,40 +1436,43 @@ folded regions.")
(defun org-fold-core-fontify-region (beg end loudly &optional force) (defun org-fold-core-fontify-region (beg end loudly &optional force)
"Run `font-lock-default-fontify-region' in visible regions." "Run `font-lock-default-fontify-region' in visible regions."
(with-silent-modifications (with-silent-modifications
(let ((pos beg) next (let* ((pos beg) next
(force (or force org-fold-core--force-fontification)) (force (or force org-fold-core--force-fontification))
(org-fold-core--fontifying t) (org-fold-core--fontifying t)
(skip-specs (skip-specs
(let (result) (unless force
(dolist (spec (org-fold-core-folding-spec-list)) (let (result)
(when (and (not (org-fold-core-get-folding-spec-property spec :visible)) (dolist (spec (org-fold-core-folding-spec-list))
(org-fold-core-get-folding-spec-property spec :font-lock-skip)) (when (and (not (org-fold-core-get-folding-spec-property spec :visible))
(push spec result))) (org-fold-core-get-folding-spec-property spec :font-lock-skip))
result))) (push spec result)))
result))))
;; Move POS to first visible point within BEG..END. ;; Move POS to first visible point within BEG..END.
(while (and (catch :found (unless force
(dolist (spec (org-fold-core-get-folding-spec 'all pos)) (while (and (catch :found
(when (org-fold-core-get-folding-spec-property spec :font-lock-skip) (dolist (spec (org-fold-core-get-folding-spec 'all pos))
(throw :found spec)))) (when (org-fold-core-get-folding-spec-property spec :font-lock-skip)
(< pos end)) (throw :found spec))))
(setq pos (org-fold-core-next-folding-state-change nil pos end))) (< pos end))
(setq pos (org-fold-core-next-folding-state-change nil pos end))))
(when force (setq pos beg next end)) (when force (setq pos beg next end))
(while (< pos end) (while (< pos end)
(unless force (unless force
(setq next (org-fold-core-next-folding-state-change skip-specs pos end))) (setq next (org-fold-core-next-folding-state-change skip-specs pos end))
;; Move to the end of the region to be fontified. ;; Move to the end of the region to be fontified.
(while (and (not (catch :found (while (and (not (catch :found
(dolist (spec (org-fold-core-get-folding-spec 'all next)) (dolist (spec (org-fold-core-get-folding-spec 'all next))
(when (org-fold-core-get-folding-spec-property spec :font-lock-skip) (when (org-fold-core-get-folding-spec-property spec :font-lock-skip)
(throw :found spec))))) (throw :found spec)))))
(< next end)) (< next end))
(setq next (org-fold-core-next-folding-state-change nil next end))) (setq next (org-fold-core-next-folding-state-change nil next end))))
(save-excursion (save-excursion
(font-lock-default-fontify-region pos next loudly) (font-lock-default-fontify-region pos next loudly)
(save-match-data (save-match-data
(unless (<= pos (point) next) (unless (<= pos (point) next)
(run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) (run-hook-with-args 'org-fold-core-first-unfold-functions pos next))))
(put-text-property pos next 'org-fold-core-fontified t) (put-text-property pos next 'org-fold-core-fontified t)
(put-text-property pos next 'fontified t)
(setq pos next))))) (setq pos next)))))
(defun org-fold-core-update-optimisation (beg end) (defun org-fold-core-update-optimisation (beg end)