From 8e2fed82ed9335680f6b5a7d02028786d8479ca3 Mon Sep 17 00:00:00 2001 Message-Id: <8e2fed82ed9335680f6b5a7d02028786d8479ca3.1657634233.git.yantar92@gmail.com> In-Reply-To: References: From: Ihor Radchenko Date: Tue, 12 Jul 2022 21:32:08 +0800 Subject: [PATCH 3/3] org-fold: Make sure that changes do not leave partially folded headings * lisp/org-fold-core.el (org-fold-core--fix-folded-region): Check fragility in all the indirect buffers. * lisp/org-fold.el (org-fold--reveal-headline-at-point): New function revealing heading line or full heading when the heading only contains blank lines. (org-fold--reveal-outline-maybe): Check headline at the end of folded region as well. Use `org-fold-core--fix-folded-region'. * lisp/org.el (org-insert-heading): Make sure that the newline in front of heading is revealed. --- lisp/org-fold-core.el | 71 ++++++++++++++++++++++--------------------- lisp/org-fold.el | 52 ++++++++++++++++++++++--------- lisp/org.el | 5 ++- 3 files changed, 77 insertions(+), 51 deletions(-) diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el index 23507967f..3fcacb975 100644 --- a/lisp/org-fold-core.el +++ b/lisp/org-fold-core.el @@ -1269,41 +1269,42 @@ (defun org-fold-core--fix-folded-region (from to _) (let ((new-region (funcall func from to))) (setq from (car new-region)) (setq to (cdr new-region)))) - (dolist (spec (org-fold-core-folding-spec-list)) - ;; No action is needed when :fragile is nil for the spec. - (when (org-fold-core-get-folding-spec-property spec :fragile) - (org-with-wide-buffer - ;; Expand the considered region to include partially present fold. - ;; Note: It is important to do this inside loop over all - ;; specs. Otherwise, the region may be expanded to huge - ;; outline fold, potentially involving majority of the - ;; buffer. That would cause the below code to loop over - ;; almost all the folds in buffer, which would be too slow. - (let ((local-from from) - (local-to to) - (region-from (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) - (region-to (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) - (when region-from (setq local-from (car region-from))) - (when region-to (setq local-to (cdr region-to))) - (let ((pos local-from)) - ;; Move to the first hidden region. - (unless (org-fold-core-get-folding-spec spec pos) - (setq pos (org-fold-core-next-folding-state-change spec pos local-to))) - ;; Cycle over all the folds. - (while (< pos local-to) - (save-match-data ; we should not clobber match-data in after-change-functions - (let ((fold-begin (and (org-fold-core-get-folding-spec spec pos) - pos)) - (fold-end (org-fold-core-next-folding-state-change spec pos local-to))) - (when (and fold-begin fold-end) - (when (save-excursion - (funcall (org-fold-core-get-folding-spec-property spec :fragile) - (cons fold-begin fold-end) - spec)) - ;; Reveal completely, not just from the SPEC. - (org-fold-core-region fold-begin fold-end nil))))) - ;; Move to next fold. - (setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))) + (org-fold-core-cycle-over-indirect-buffers + (dolist (spec (org-fold-core-folding-spec-list)) + ;; No action is needed when :fragile is nil for the spec. + (when (org-fold-core-get-folding-spec-property spec :fragile) + (org-with-wide-buffer + ;; Expand the considered region to include partially present fold. + ;; Note: It is important to do this inside loop over all + ;; specs. Otherwise, the region may be expanded to huge + ;; outline fold, potentially involving majority of the + ;; buffer. That would cause the below code to loop over + ;; almost all the folds in buffer, which would be too slow. + (let ((local-from from) + (local-to to) + (region-from (org-fold-core-get-region-at-point spec (max (point-min) (1- from)))) + (region-to (org-fold-core-get-region-at-point spec (min to (1- (point-max)))))) + (when region-from (setq local-from (car region-from))) + (when region-to (setq local-to (cdr region-to))) + (let ((pos local-from)) + ;; Move to the first hidden region. + (unless (org-fold-core-get-folding-spec spec pos) + (setq pos (org-fold-core-next-folding-state-change spec pos local-to))) + ;; Cycle over all the folds. + (while (< pos local-to) + (save-match-data ; we should not clobber match-data in after-change-functions + (let ((fold-begin (and (org-fold-core-get-folding-spec spec pos) + pos)) + (fold-end (org-fold-core-next-folding-state-change spec pos local-to))) + (when (and fold-begin fold-end) + (when (save-excursion + (funcall (org-fold-core-get-folding-spec-property spec :fragile) + (cons fold-begin fold-end) + spec)) + ;; Reveal completely, not just from the SPEC. + (org-fold-core-region fold-begin fold-end nil))))) + ;; Move to next fold. + (setq pos (org-fold-core-next-folding-state-change spec pos local-to))))))))))))) ;;; Handling killing/yanking of folded text diff --git a/lisp/org-fold.el b/lisp/org-fold.el index ce8afd9b4..6ff21dfc7 100644 --- a/lisp/org-fold.el +++ b/lisp/org-fold.el @@ -55,6 +55,7 @@ (defvar org-link-descriptive) (defvar org-outline-regexp-bol) (defvar org-archive-tag) (defvar org-custom-properties-overlays) +(defvar org-element-headline-re) (declare-function isearch-filter-visible "isearch" (beg end)) (declare-function org-element-type "org-element" (element)) @@ -930,6 +931,30 @@ (defun org-fold--extend-changed-region (from to) (setq from (save-excursion (goto-char from) (line-beginning-position 0))) (cons from to)) +(defun org-fold--reveal-headline-at-point () + "Reveal header line and empty contents inside. +Reveal the header line and, if present, also reveal its contents, when +the contents consists of blank lines. + +Assume that point is located at the header line." + (org-with-wide-buffer + (beginning-of-line) + (org-fold-region + (max (point-min) (1- (point))) + (let ((endl (line-end-position))) + (save-excursion + (goto-char endl) + (skip-chars-forward "\n\t\r ") + ;; Unfold blank lines after newly inserted headline. + (if (equal (point) + (save-excursion + (goto-char endl) + (org-end-of-subtree) + (skip-chars-forward "\n\t\r "))) + (point) + endl))) + nil 'headline))) + (defun org-fold--reveal-outline-maybe (region _) "Reveal folded outline in REGION when needed. @@ -942,28 +967,25 @@ (defun org-fold--reveal-outline-maybe (region _) ;; headline or a list item. (backward-char) (beginning-of-line) - ;; Make sure that headline is not partially hidden + ;; Make sure that headline is not partially hidden. (unless (org-fold-folded-p nil 'headline) - (org-fold-region - (max (point-min) (1- (point))) - (let ((endl (line-end-position))) - (save-excursion - (goto-char endl) - (skip-chars-forward "\n\t\r ") - ;; Unfold blank lines. - (if (or (and (looking-at-p "\\*") - (> (point) (1+ endl))) - (eq (point) (point-max))) - (point) - endl))) - nil 'headline)) + (org-fold--reveal-headline-at-point)) ;; Never hide level 1 headlines (save-excursion (goto-char (line-end-position)) (unless (>= (point) (cdr region)) (when (re-search-forward (rx bol "* ") (cdr region) t) - (org-fold-region (match-beginning 0) (line-end-position) nil 'headline)))) + (org-fold--reveal-headline-at-point)))) + ;; Make sure that headline after is not partially hidden. + (goto-char (cdr region)) + (beginning-of-line) + (unless (org-fold-folded-p nil 'headline) + (when (looking-at-p org-element-headline-re) + (org-fold--reveal-headline-at-point))) ;; Check the validity of headline + (goto-char (car region)) + (backward-char) + (beginning-of-line) (unless (let ((case-fold-search t)) (looking-at (rx-to-string `(or (regex ,(org-item-re)) diff --git a/lisp/org.el b/lisp/org.el index d85b5818e..1c9eaf09a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6141,7 +6141,10 @@ (defun org-insert-heading (&optional arg invisible-ok top) (unless invisible-ok (if (eq org-fold-core-style 'text-properties) (cond - ((org-fold-folded-p (line-beginning-position) 'headline) + ((org-fold-folded-p + (max (point-min) + (1- (line-beginning-position))) + 'headline) (org-fold-region (line-end-position 0) (line-end-position) nil 'headline)) (t nil)) (pcase (get-char-property-and-overlay (point) 'invisible) -- 2.35.1