From 5d186b499dde97f59a91dc11f4c4a15113d29f4d Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sun, 25 Feb 2024 11:42:44 +0300 Subject: [PATCH] org-fold: Refactor fontifying newlines after folds * lisp/org.el (org-activate-folds): New fontification function to arrange faces at newlines after folds to be the same as face before the fold. (org-set-font-lock-defaults): Add the new fontification function. * lisp/org-fold-core.el (org-fold-core-region): Refresh fontification of newlines after folds when folding/unfolding. Reported-by: StrawberryTea Link: https://orgmode.org/list/87plwoqrfv.fsf@strawberrytea.xyz --- lisp/org-fold-core.el | 47 ++++++++++++++++++------------------------- lisp/org.el | 21 ++++++++++++++++++- 2 files changed, 40 insertions(+), 28 deletions(-) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 9c148d328..e28039a68 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -1034,26 +1034,19 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." (when spec (org-fold-core--check-spec spec)) (with-silent-modifications (org-with-wide-buffer - ;; Arrange face property of newlines after all the folds - ;; between FROM and TO to match the first character before the - ;; fold; not the last as per Emacs defaults. This makes - ;; :extend faces span past the ellipsis. - ;; See bug#65896. - (if flag ; folding - (when (equal ?\n (char-after to)) - (put-text-property to (1+ to) 'face (get-text-property from 'face))) - ;; unfolding - (dolist (region (org-fold-core-get-regions :from from :to to :specs spec)) - (when (equal ?\n (char-after (cadr region))) - (if-let ((specs (remq spec (org-fold-core-get-folding-spec 'all (1- (cadr region)))))) - ;; There are multiple folds, re-apply 'face according - ;; to the folds that will stay after unfolding SPEC. - (put-text-property - (cadr region) (1+ (cadr region)) 'face - (get-text-property - (car (org-fold-core-get-region-at-point (car specs) (1- (cadr region)))) - 'face)) - (font-lock-flush (cadr region) (1+ (cadr region))))))) + ;; Arrange fontifying newlines after all the folds between FROM + ;; and TO to match the first character before the fold; not the + ;; last as per Emacs defaults. This makes :extend faces span + ;; past the ellipsis. See bug#65896. The face properties are + ;; assigned via `org-activate-folds'. + (when (equal ?\n (char-after to)) + (font-lock-flush to (1+ to))) + ;; Re-fontify beginning of the fold when unfolding - we may + ;; unfold inside an existing fold, with FROM begin a newline + ;; after spliced fold. + (unless flag + (when (equal ?\n (char-after from)) + (font-lock-flush from (1+ from)))) (when (eq org-fold-core-style 'overlays) (if org-fold-core--keep-overlays (mapc @@ -1114,13 +1107,13 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region." (setq pos (next-single-char-property-change pos 'invisible nil to))))))) (when (eq org-fold-core-style 'text-properties) (remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil))) - ;; FROM..TO may represent only a part of the fold. Transfer - ;; 'face from the new char before fold, if there is any. - (when-let ((trailing-fold (org-fold-core-get-region-at-point spec to))) - (when (equal ?\n (char-after (cdr trailing-fold))) - (put-text-property - (cdr trailing-fold) (1+ (cdr trailing-fold)) - 'face (get-text-property to 'face)))))))))) + ;; Re-calculate trailing faces for all the folds revealed + ;; by unfolding. + (unless flag + ;; unfolding + (dolist (region (org-fold-core-get-regions :from from :to to :specs spec)) + (when (equal ?\n (char-after (cadr region))) + (font-lock-flush (cadr region) (1+ (cadr region)))))))))))) (cl-defmacro org-fold-core-regions (regions &key override clean-markers relative) "Fold every region in REGIONS list in current buffer. diff --git a/lisp/org.el b/lisp/org.el index 1d33e6de0..9583783ce 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5797,6 +5797,24 @@ highlighting was done, nil otherwise." (org-rear-nonsticky-at (match-end 1)) t)) +(defun org-activate-folds (limit) + "Arrange trailing newlines after folds to inherit face before the fold." + (let ((next-unfolded-newline (search-forward "\n" limit 'move))) + (while (and next-unfolded-newline (org-fold-folded-p) (not (eobp))) + (setq next-unfolded-newline (search-forward "\n" limit 'move))) + (when next-unfolded-newline + (org-with-wide-buffer + (when (and (> (match-beginning 0) (point-min)) + (org-fold-folded-p (1- (match-beginning 0)))) + (put-text-property + (match-beginning 0) (match-end 0) + 'face + (get-text-property + (org-fold-previous-visibility-change + (1- (match-beginning 0))) + 'face))) + t)))) + (defun org-outline-level () "Compute the outline level of the heading at point. @@ -5978,7 +5996,8 @@ needs to be inserted at a specific position in the font-lock sequence.") (progn (unless (null org-cite-activate-processor) (org-cite-try-load-processor org-cite-activate-processor)) - '(org-cite-activate))))) + '(org-cite-activate)) + '(org-activate-folds)))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords