org-fold-core: Fix edge case when fontification goes beyond requested

* lisp/org-fold-core.el (org-fold-core-fontify-region): Run
`org-fold-core-first-unfold-functions' on all the regions unmarked by
'org-fold-core-fontified property instead of using incorrect
heuristics with `point' position.  Make sure that fontified region is
registered as fontified according to the return value of
`font-lock-default-fontify-region'

Fixes https://orgmode.org/list/8735i5gd8n.fsf@gmail.com
This commit is contained in:
Ihor Radchenko 2022-04-23 23:55:44 +08:00
parent fc6314b267
commit 9bc6c363da
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 14 additions and 5 deletions

View File

@ -1436,7 +1436,7 @@ 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 font-lock-return-value
(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
@ -1467,13 +1467,22 @@ folded regions.")
(< 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) (setq font-lock-return-value (font-lock-default-fontify-region pos next loudly))
(save-match-data (save-match-data
(unless (<= pos (point) next) ;; Only run within regions that are not yet touched by
(run-hook-with-args 'org-fold-core-first-unfold-functions pos next)))) ;; fontification.
(let ((l pos) (r next) (c pos) nxt)
(when (get-text-property c 'org-fold-core-fontified)
(setq c (next-single-property-change c 'org-fold-core-fontified)))
(setq nxt (next-single-property-change c 'org-fold-core-fontified nil r))
(while (< c r)
(run-hook-with-args 'org-fold-core-first-unfold-functions c nxt)
(setq c (next-single-property-change nxt 'org-fold-core-fontified nil r))
(setq nxt (next-single-property-change c 'org-fold-core-fontified nil r))))))
(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) (put-text-property pos next 'fontified t)
(setq pos next))))) (setq pos next))
(or font-lock-return-value `(jit-lock-bounds ,beg . ,end)))))
(defun org-fold-core-update-optimisation (beg end) (defun org-fold-core-update-optimisation (beg end)
"Update huge buffer optimisation between BEG and END. "Update huge buffer optimisation between BEG and END.