daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-06-22 17:08:08 +02:00
parent 54e5633369
commit 16a0a6db93
558 changed files with 68349 additions and 26568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

361
lisp/org/org-fold-core.el
View File

@@ -1,8 +1,9 @@
;;; org-fold-core.el --- Folding buffer text -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020-2023 Free Software Foundation, Inc.
;; Copyright (C) 2020-2025 Free Software Foundation, Inc.
;;
;; Author: Ihor Radchenko <yantar92 at gmail dot com>
;; Author: Ihor Radchenko <yantar92 at posteo dot net>
;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net>
;; Keywords: folding, invisible text
;; URL: https://orgmode.org
;;
@@ -160,7 +161,7 @@
;; If one wants to search invisible text without using the provided
;; functions, it is important to keep in mind that 'invisible text
;; property may have multiple possible values (not just nil and
;; t). Hence, (next-single-char-property-change pos 'invisible) is not
;; t). Hence, (next-single-char-property-change pos 'invisible) is not
;; guaranteed to return the boundary of invisible/visible text.
;;; Interactive searching inside folded text (via isearch)
@@ -172,7 +173,7 @@
;; The isearch behavior is controlled on per-folding-spec basis by
;; setting `isearch-open' and `isearch-ignore' folding spec
;; properties. The the docstring of `org-fold-core--specs' for more details.
;; properties. See the docstring of `org-fold-core--specs' for more details.
;;; Handling edits inside folded text
@@ -280,16 +281,17 @@
;;; Customization
(defcustom org-fold-core-style 'text-properties
(defcustom org-fold-core-style (if (version< emacs-version "29")
'text-properties
'overlays)
"Internal implementation detail used to hide folded text.
Can be either `text-properties' or `overlays'.
The former is faster on large files, while the latter is generally
less error-prone with regard to third-party packages that haven't yet
adapted to the new folding implementation.
The former is faster on large files in Emacs <29, while the latter is
generally less error-prone with regard to third-party packages.
Important: This variable must be set before loading Org."
:group 'org
:package-version '(Org . "9.6")
:package-version '(Org . "9.7")
:type '(choice
(const :tag "Overlays" overlays)
(const :tag "Text properties" text-properties)))
@@ -380,6 +382,9 @@ The following properties are known:
`buffer-invisibility-spec' will be used as is.
Note that changing this property from nil to t may
clear the setting in `buffer-invisibility-spec'.
- :font-lock :: non-nil means that newlines after the fold should
be re-fontified upon folding/unfolding. See
`org-activate-folds'.
- :alias :: a list of aliases for the SPEC-SYMBOL.
- :fragile :: Must be a function accepting two arguments.
Non-nil means that changes in region may cause
@@ -424,7 +429,7 @@ Return nil when there is no matching folding spec."
(unless org-fold-core--spec-symbols
(dolist (spec (org-fold-core-folding-spec-list))
(push (cons spec spec) org-fold-core--spec-symbols)
(dolist (alias (assq :alias (assq spec org-fold-core--specs)))
(dolist (alias (cdr (assq :alias (assq spec org-fold-core--specs))))
(push (cons alias spec) org-fold-core--spec-symbols))))
(alist-get spec-or-alias org-fold-core--spec-symbols)))
@@ -433,7 +438,7 @@ Return nil when there is no matching folding spec."
(org-fold-core-get-folding-spec-from-alias spec-or-alias))
(defsubst org-fold-core--check-spec (spec-or-alias)
"Throw an error if SPEC-OR-ALIAS is not in `org-fold-core--spec-priority-list'."
"Throw an error if SPEC-OR-ALIAS is not in `org-fold-core-folding-spec-list'."
(unless (org-fold-core-folding-spec-p spec-or-alias)
(error "%s is not a valid folding spec" spec-or-alias)))
@@ -553,7 +558,10 @@ and the setup appears to be created for different buffer,
copy the old invisibility state into new buffer-local text properties,
unless RETURN-ONLY is non-nil."
(if (eq org-fold-core-style 'overlays)
(org-fold-core-get-folding-property-symbol spec nil 'global)
(or (gethash (cons 'global spec) org-fold-core--property-symbol-cache)
(puthash (cons 'global spec)
(org-fold-core-get-folding-property-symbol spec nil 'global)
org-fold-core--property-symbol-cache))
(let* ((buf (or buffer (current-buffer))))
;; Create unique property symbol for SPEC in BUFFER
(let ((local-prop (or (gethash (cons buf spec) org-fold-core--property-symbol-cache)
@@ -574,15 +582,6 @@ unless RETURN-ONLY is non-nil."
;; would contain folding properties, which are not
;; matching the generated `local-prop'.
(unless (member local-prop (cdr (assq 'invisible char-property-alias-alist)))
;; Add current buffer to the list of indirect buffers in the base buffer.
(when (buffer-base-buffer)
(with-current-buffer (buffer-base-buffer)
(setq-local org-fold-core--indirect-buffers
(let (bufs)
(org-fold-core-cycle-over-indirect-buffers
(push (current-buffer) bufs))
(push buf bufs)
(delete-dups bufs)))))
;; Copy all the old folding properties to preserve the folding state
(with-silent-modifications
(dolist (old-prop (cdr (assq 'invisible char-property-alias-alist)))
@@ -633,14 +632,28 @@ unless RETURN-ONLY is non-nil."
text-property-default-nonsticky
full-prop-list))))))))))))))
(defun org-fold-core--update-buffer-folds ()
"Copy folding state in a new buffer with text copied from old buffer."
(org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list))))
(defun org-fold-core-decouple-indirect-buffer-folds ()
"Copy and decouple folding state in a newly created indirect buffer.
This function is mostly intended to be used in
`clone-indirect-buffer-hook'."
;; Add current buffer to the list of indirect buffers in the base buffer.
(when (buffer-base-buffer)
(let ((new-buffer (current-buffer)))
(with-current-buffer (buffer-base-buffer)
(setq-local org-fold-core--indirect-buffers
(let (bufs)
(org-fold-core-cycle-over-indirect-buffers
(push (current-buffer) bufs))
(push new-buffer bufs)
(delete-dups bufs))))))
(when (and (buffer-base-buffer)
(eq org-fold-core-style 'text-properties)
(not (memql 'ignore-indirect org-fold-core--optimise-for-huge-buffers)))
(org-fold-core--property-symbol-get-create (car (org-fold-core-folding-spec-list)))))
(org-fold-core--update-buffer-folds)))
;;; API
@@ -694,7 +707,7 @@ The folding spec properties will be set to PROPERTIES (see
(let* ((full-properties (mapcar (lambda (prop) (cons prop (cdr (assq prop properties))))
'( :visible :ellipsis :isearch-ignore
:global :isearch-open :front-sticky
:rear-sticky :fragile :alias)))
:rear-sticky :fragile :alias :font-lock)))
(full-spec (cons spec full-properties)))
(add-to-list 'org-fold-core--specs full-spec append)
(mapc (lambda (prop-cons) (org-fold-core-set-folding-spec-property spec (car prop-cons) (cdr prop-cons) 'force)) full-properties)
@@ -783,16 +796,19 @@ corresponding folding spec (if the text is folded using that spec)."
(when (and spec (not (eq spec 'all))) (org-fold-core--check-spec spec))
(org-with-point-at pom
(cond
((eq spec 'all)
(let ((result))
(dolist (spec (org-fold-core-folding-spec-list))
(let ((val (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))
(when val (push val result))))
(reverse result)))
((null spec)
(let ((result (get-char-property (point) 'invisible)))
(when (org-fold-core-folding-spec-p result) result)))
(t (get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t)))))))
((or (null spec) (eq spec 'all))
(catch :single-spec
(let ((result))
(dolist (lspec (org-fold-core-folding-spec-list))
(let ((val (if (eq org-fold-core-style 'text-properties)
(get-text-property (point) (org-fold-core--property-symbol-get-create lspec nil t))
(get-char-property (point) (org-fold-core--property-symbol-get-create lspec nil t)))))
(when (and val (null spec)) (throw :single-spec val))
(when val (push val result))))
(reverse result))))
(t (if (eq org-fold-core-style 'text-properties)
(get-text-property (point) (org-fold-core--property-symbol-get-create spec nil t))
(get-char-property (point) (org-fold-core--property-symbol-get-create spec nil t))))))))
(defun org-fold-core-get-folding-specs-in-region (beg end)
"Get all folding specs in region from BEG to END."
@@ -843,13 +859,20 @@ If PREVIOUS-P is non-nil, search backwards."
(next-change (if previous-p
(if ignore-hidden-p
(lambda (p) (org-fold-core-previous-folding-state-change (org-fold-core-get-folding-spec nil p) p limit))
(lambda (p) (max limit (1- (previous-single-char-property-change p 'invisible nil limit)))))
(lambda (p) (max limit (previous-single-char-property-change p 'invisible nil limit))))
(if ignore-hidden-p
(lambda (p) (org-fold-core-next-folding-state-change (org-fold-core-get-folding-spec nil p) p limit))
(lambda (p) (next-single-char-property-change p 'invisible nil limit)))))
(next pos))
(while (and (funcall cmp next limit)
(not (org-xor invisible-initially? (funcall invisible-p next))))
(not (org-xor
invisible-initially?
(funcall invisible-p
(if previous-p
;; NEXT-1 -> NEXT is the change.
(max limit (1- next))
;; NEXT -> NEXT+1 is the change.
next)))))
(setq next (funcall next-change next)))
next))
@@ -897,14 +920,19 @@ Search backwards when PREVIOUS-P is non-nil."
(unless spec-or-alias
(setq spec-or-alias (org-fold-core-folding-spec-list)))
(setq pos (or pos (point)))
(apply (if previous-p
#'max
#'min)
(mapcar (if previous-p
(lambda (prop) (max (or limit (point-min)) (previous-single-char-property-change pos prop nil (or limit (point-min)))))
(lambda (prop) (next-single-char-property-change pos prop nil (or limit (point-max)))))
(mapcar (lambda (el) (org-fold-core--property-symbol-get-create el nil t))
spec-or-alias))))
(let ((limit (or limit (if previous-p (point-min) (point-max)))))
(catch :limit
(dolist (prop (mapcar
(lambda (el)
(org-fold-core--property-symbol-get-create el nil t))
spec-or-alias))
(when (= limit pos) (throw :limit limit))
(setq
limit
(if previous-p
(previous-single-char-property-change pos prop nil limit)
(next-single-char-property-change pos prop nil limit))))
limit)))
(defun org-fold-core-previous-folding-state-change (&optional spec-or-alias pos limit)
"Call `org-fold-core-next-folding-state-change' searching backwards."
@@ -985,6 +1013,24 @@ WITH-MARKERS must be nil when RELATIVE is non-nil."
;;;;; Region visibility
(defvar org-fold-core--keep-overlays nil
"When non-nil, `org-fold-core-region' will not remove existing overlays.")
(defvar org-fold-core--isearch-overlays) ; defined below
(defmacro org-fold-core--keep-overlays (&rest body)
"Run BODY with `org-fold-core--keep-overlays' set to t."
(declare (debug (body)))
`(let ((org-fold-core--keep-overlays t))
,@body))
(defvar org-fold-core--isearch-active nil
"When non-nil, `org-fold-core-region' records created overlays.
New overlays will be added to `org-fold-core--isearch-overlays'.")
(defmacro org-fold-core--with-isearch-active (&rest body)
"Run BODY with `org-fold-core--isearch-active' set to t."
(declare (debug (body)))
`(let ((org-fold-core--isearch-active t))
,@body))
;; This is the core function performing actual folding/unfolding. The
;; folding state is stored in text property (folding property)
;; returned by `org-fold-core--property-symbol-get-create'. The value of the
@@ -997,7 +1043,44 @@ 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
(when (eq org-fold-core-style 'overlays) (remove-overlays from to 'invisible spec))
;; 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 (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock))
(when (equal ?\n (char-after from))
(font-lock-flush from (1+ from)))
(when (equal ?\n (char-after to))
(font-lock-flush to (1+ to)))
(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))))
;; Re-fontify beginning of the fold - we may
;; unfold inside an existing fold, with FROM begin a newline
;; after spliced fold.
(when (equal ?\n (char-after (car region)))
(font-lock-flush (car region) (1+ (car region))))))
(when (eq org-fold-core-style 'overlays)
(if org-fold-core--keep-overlays
(mapc
(lambda (ov)
(when (or (not spec)
(eq spec (overlay-get ov 'invisible)))
(when (and org-fold-core--isearch-active
(overlay-get ov 'invisible)
(org-fold-core-get-folding-spec-property
(overlay-get ov 'invisible) :isearch-open))
(when-let* ((spec (overlay-get ov 'invisible)))
(overlay-put ov 'org-invisible spec)
(overlay-put ov (org-fold-core--property-symbol-get-create spec) nil))
(overlay-put ov 'invisible nil)
(when org-fold-core--isearch-active
(cl-pushnew ov org-fold-core--isearch-overlays)))))
(overlays-in from to))
(when spec
(remove-overlays from to 'org-invisible spec)
(remove-overlays from to 'invisible spec))))
(if flag
(if (not spec)
(error "Calling `org-fold-core-region' with missing SPEC")
@@ -1007,17 +1090,14 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region."
(let ((o (make-overlay from to nil
(org-fold-core-get-folding-spec-property spec :front-sticky)
(org-fold-core-get-folding-spec-property spec :rear-sticky))))
(when org-fold-core--isearch-active
(push o org-fold-core--isearch-overlays))
(overlay-put o 'evaporate t)
(overlay-put o (org-fold-core--property-symbol-get-create spec) spec)
(overlay-put o 'invisible spec)
(overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show)
;; FIXME: Disabling to work around Emacs bug#60399
;; and https://orgmode.org/list/87zgb6tk6h.fsf@localhost.
;; The proper fix will require making sure that
;; `org-fold-core-isearch-open-function' does not
;; delete the overlays used by isearch.
;; (overlay-put o 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)
)
;; Preserve priority.
(overlay-put o 'priority (length (member spec (org-fold-core-folding-spec-list))))
(overlay-put o 'isearch-open-invisible #'org-fold-core--isearch-show))
(put-text-property from to (org-fold-core--property-symbol-get-create spec) spec)
(put-text-property from to 'isearch-open-invisible #'org-fold-core--isearch-show)
(put-text-property from to 'isearch-open-invisible-temporary #'org-fold-core--isearch-show-temporary)
@@ -1041,7 +1121,13 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold everything in the region."
(setq pos next))
(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)))))))))
(remove-text-properties from to (list (org-fold-core--property-symbol-get-create spec) nil)))))
;; Re-calculate trailing faces for all the folds revealed
;; by unfolding or created by folding.
(when (or (not spec) (org-fold-core-get-folding-spec-property spec :font-lock))
(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.
@@ -1088,7 +1174,7 @@ because otherwise all these markers will point to nowhere."
This is used to allow searching in regions hidden via text properties.
As for [2020-05-09 Sat], Isearch only has special handling of hidden overlays.
Any text hidden via text properties is not revealed even if `search-invisible'
is set to `t'.")
is set to t.")
(defvar-local org-fold-core--isearch-local-regions (make-hash-table :test 'equal)
"Hash table storing temporarily shown folds from isearch matches.")
@@ -1104,13 +1190,19 @@ TYPE can be either `text-properties' or `overlays'."
(setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-text-properties))
(`overlays
(when (eq org-fold-core-style 'text-properties)
(setq-local isearch-filter-predicate #'org-fold-core--isearch-filter-predicate-overlays)
(add-hook 'isearch-mode-end-hook #'org-fold-core--clear-isearch-overlays nil 'local)))
(add-function :before (local 'isearch-filter-predicate) #'org-fold-core--create-isearch-overlays)
;; When `isearch-filter-predicate' is called outside isearch,
;; it is common that `isearch-mode-end-hook' does not get
;; executed, but `isearch-clean-overlays' usually does.
(advice-add
'isearch-clean-overlays :after
#'org-fold-core--clear-isearch-overlays
'((name . isearch-clean-overlays@org-fold-core)))))
(_ (error "%s: Unknown type of setup for `org-fold-core--isearch-setup'" type))))
(defun org-fold-core--isearch-reveal (pos)
"Default function used to reveal hidden text at POS for isearch."
(let ((region (org-fold-core-get-region-at-point pos)))
(let ((region (org-fold-core-get-region-at-point nil pos)))
(org-fold-core-region (car region) (cdr region) nil)))
(defun org-fold-core--isearch-filter-predicate-text-properties (beg end)
@@ -1145,34 +1237,38 @@ This function is intended to be used as `isearch-filter-predicate'."
"Clear `org-fold-core--isearch-local-regions'."
(clrhash org-fold-core--isearch-local-regions))
(defun org-fold-core--isearch-show (_)
"Reveal text at point found by isearch."
(funcall org-fold-core-isearch-open-function (point)))
(defun org-fold-core--isearch-show (overlay-or-region)
"Reveal text at OVERLAY-OR-REGION found by isearch."
(let (beg end)
(if (overlayp overlay-or-region)
(setq beg (overlay-start overlay-or-region)
end (overlay-end overlay-or-region))
(setq beg (car overlay-or-region)
end (cdr overlay-or-region)))
;; FIXME: Reveal the match (usually point, but may sometimes go beyond the region).
(when (< beg (point) end)
(funcall org-fold-core-isearch-open-function (point)))
(if (overlayp overlay-or-region)
(delete-overlay overlay-or-region)
(org-fold-core-region beg end nil))))
(defun org-fold-core--isearch-show-temporary (region hide-p)
"Temporarily reveal text in REGION.
Hide text instead if HIDE-P is non-nil.
REGION can also be an overlay in current buffer."
(when (overlayp region)
(setq region (cons (overlay-start region)
(overlay-end region))))
(if (not hide-p)
(let ((pos (car region)))
(while (< pos (cdr region))
(let ((spec-no-open
(catch :found
(dolist (spec (org-fold-core-get-folding-spec 'all pos))
(unless (org-fold-core-get-folding-spec-property spec :isearch-open)
(throw :found spec))))))
(if spec-no-open
;; Skip regions folded with folding specs that cannot be opened.
(setq pos (org-fold-core-next-folding-state-change spec-no-open pos (cdr region)))
(dolist (spec (org-fold-core-get-folding-spec 'all pos))
(push (cons spec (org-fold-core-get-region-at-point spec pos)) (gethash region org-fold-core--isearch-local-regions)))
(org-fold-core--isearch-show region)
(setq pos (org-fold-core-next-folding-state-change nil pos (cdr region)))))))
(mapc (lambda (val) (org-fold-core-region (cadr val) (cddr val) t (car val))) (gethash region org-fold-core--isearch-local-regions))
(remhash region org-fold-core--isearch-local-regions)))
(save-match-data ; match data must not be modified.
(let ((org-fold-core-style (if (overlayp region) 'overlays 'text-properties)))
(if hide-p
(if (not (overlayp region))
nil ;; FIXME: after isearch supports text properties.
(when-let* ((spec (overlay-get region 'org-invisible)))
(overlay-put region 'invisible spec)
(overlay-put region (org-fold-core--property-symbol-get-create spec) spec)))
;; isearch expects all the temporarily opened overlays to exist.
;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=60399
(org-fold-core--keep-overlays
(org-fold-core--with-isearch-active
(org-fold-core--isearch-show region)))))))
(defvar-local org-fold-core--isearch-special-specs nil
"List of specs that can break visibility state when converted to overlays.
@@ -1187,49 +1283,28 @@ instead of text properties. The created overlays will be stored in
(while (< pos end)
;; We need loop below to make sure that we clean all invisible
;; properties, which may be nested.
(dolist (spec (org-fold-core-get-folding-spec 'all pos))
(unless (org-fold-core-get-folding-spec-property spec :isearch-ignore)
(let* ((region (org-fold-core-get-region-at-point spec pos)))
(when (memq spec org-fold-core--isearch-special-specs)
(setq pos (min pos (car region)))
(setq end (max end (cdr region))))
;; Changing text properties is considered buffer modification.
;; We do not want it here.
(with-silent-modifications
(org-fold-core-region (car region) (cdr region) nil spec)
;; The overlay is modeled after `outline-flag-region'
;; [2020-05-09 Sat] overlay for 'outline blocks.
(let ((o (make-overlay (car region) (cdr region) nil 'front-advance)))
(overlay-put o 'evaporate t)
(overlay-put o 'invisible spec)
(overlay-put o 'org-invisible spec)
;; Make sure that overlays are applied in the same order
;; with the folding specs.
;; Note: `memq` returns cdr with car equal to the first
;; found matching element.
(overlay-put o 'priority (length (memq spec (org-fold-core-folding-spec-list))))
;; `delete-overlay' here means that spec information will be lost
;; for the region. The region will remain visible.
(if (org-fold-core-get-folding-spec-property spec :isearch-open)
(overlay-put o 'isearch-open-invisible #'delete-overlay)
(overlay-put o 'isearch-open-invisible #'ignore)
(overlay-put o 'isearch-open-invisible-temporary #'ignore))
(push o org-fold-core--isearch-overlays))))))
(setq pos (org-fold-core-next-folding-state-change nil pos end)))))
(defun org-fold-core--isearch-filter-predicate-overlays (beg end)
"Return non-nil if text between BEG and END is deemed visible by isearch.
This function is intended to be used as `isearch-filter-predicate'."
(org-fold-core--create-isearch-overlays beg end) ;; trick isearch by creating overlays in place of invisible text
(isearch-filter-visible beg end))
(catch :repeat
(dolist (spec (org-fold-core-get-folding-spec 'all pos))
(unless (org-fold-core-get-folding-spec-property spec :isearch-ignore)
(let* ((region (org-fold-core-get-region-at-point spec pos)))
(when (memq spec org-fold-core--isearch-special-specs)
(setq end (max end (cdr region)))
(when (< (car region) beg)
(setq beg (car region))
(setq pos beg)
(throw :repeat t)))
;; Changing text properties is considered buffer modification.
;; We do not want it here.
(with-silent-modifications
(org-fold-core-region (car region) (cdr region) nil spec)
(let ((org-fold-core-style 'overlays))
(org-fold-core--with-isearch-active
(org-fold-core-region (car region) (cdr region) t spec)))))))
(setq pos (org-fold-core-next-folding-state-change nil pos end))))))
(defun org-fold-core--clear-isearch-overlay (ov)
"Convert OV region back into using text properties."
(let ((spec (if isearch-mode-end-hook-quit
;; Restore all folds.
(overlay-get ov 'org-invisible)
;; Leave opened folds open.
(overlay-get ov 'invisible))))
(let ((spec (overlay-get ov 'invisible)))
;; Ignore deleted overlays.
(when (and spec
(overlay-buffer ov))
@@ -1238,8 +1313,6 @@ This function is intended to be used as `isearch-filter-predicate'."
(with-silent-modifications
(when (<= (overlay-end ov) (point-max))
(org-fold-core-region (overlay-start ov) (overlay-end ov) t spec)))))
(when (member ov isearch-opened-overlays)
(setq isearch-opened-overlays (delete ov isearch-opened-overlays)))
(delete-overlay ov))
(defun org-fold-core--clear-isearch-overlays ()
@@ -1254,6 +1327,8 @@ This function is intended to be used as `isearch-filter-predicate'."
"Non-nil: skip processing modifications in `org-fold-core--fix-folded-region'.")
(defvar org-fold-core--ignore-fragility-checks nil
"Non-nil: skip fragility checks in `org-fold-core--fix-folded-region'.")
(defvar org-fold-core--suppress-folding-fix nil
"Non-nil: skip folding fix in `org-fold-core--fix-folded-region'.")
(defmacro org-fold-core-ignore-modifications (&rest body)
"Run BODY ignoring buffer modifications in `org-fold-core--fix-folded-region'."
@@ -1262,12 +1337,47 @@ This function is intended to be used as `isearch-filter-predicate'."
(unwind-protect (progn ,@body)
(setq org-fold-core--last-buffer-chars-modified-tick (buffer-chars-modified-tick)))))
(defmacro org-fold-core-suppress-folding-fix (&rest body)
"Run BODY skipping re-folding checks in `org-fold-core--fix-folded-region'."
(declare (debug (form body)) (indent 0))
`(let ((org-fold-core--suppress-folding-fix t))
(progn ,@body)))
(defmacro org-fold-core-ignore-fragility-checks (&rest body)
"Run BODY skipping :fragility checks in `org-fold-core--fix-folded-region'."
(declare (debug (form body)) (indent 0))
`(let ((org-fold-core--ignore-fragility-checks t))
(progn ,@body)))
(defvar org-fold-core--region-delayed-list nil
"List holding (MKFROM MKTO FLAG SPEC-OR-ALIAS) arguments to process.
The list is used by `org-fold-core--region-delayed'.")
(defun org-fold-core--region-delayed (from to flag &optional spec-or-alias)
"Call `org-fold-core-region' after current command.
Pass the same FROM, TO, FLAG, and SPEC-OR-ALIAS."
;; Setup delayed folding.
(add-hook 'post-command-hook #'org-fold-core--process-delayed)
(let ((frommk (make-marker))
(tomk (make-marker)))
(set-marker frommk from (current-buffer))
(set-marker tomk to (current-buffer))
(push (list frommk tomk flag spec-or-alias) org-fold-core--region-delayed-list)))
(defun org-fold-core--process-delayed ()
"Perform folding for `org-fold-core--region-delayed-list'."
(when org-fold-core--region-delayed-list
(mapc (lambda (args)
(when (and (buffer-live-p (marker-buffer (nth 0 args)))
(buffer-live-p (marker-buffer (nth 1 args)))
(< (nth 0 args) (nth 1 args)))
(org-with-point-at (car args)
(apply #'org-fold-core-region args))))
;; Restore the initial folding order.
(nreverse org-fold-core--region-delayed-list))
;; Cleanup `post-command-hook'.
(remove-hook 'post-command-hook #'org-fold-core--process-delayed)
(setq org-fold-core--region-delayed-list nil)))
(defvar-local org-fold-core--last-buffer-chars-modified-tick nil
"Variable storing the last return value of `buffer-chars-modified-tick'.")
@@ -1295,7 +1405,7 @@ property, unfold the region if the :fragile function returns non-nil."
;; buffer. Work around Emacs bug#46982.
;; Re-hide text inserted in the middle/front/back of a folded
;; region.
(unless (equal from to) ; Ignore deletions.
(unless (or org-fold-core--suppress-folding-fix (equal from to)) ; Ignore deletions.
(when (eq org-fold-core-style 'text-properties)
(org-fold-core-cycle-over-indirect-buffers
(dolist (spec (org-fold-core-folding-spec-list))
@@ -1385,7 +1495,10 @@ property, unfold the region if the :fragile function returns non-nil."
(cons fold-begin fold-end)
spec))
;; Reveal completely, not just from the SPEC.
(org-fold-core-region fold-begin fold-end nil)))))
;; Do it only after command is finished -
;; some Emacs commands assume that
;; visibility is not altered by `after-change-functions'.
(org-fold-core--region-delayed fold-begin fold-end nil)))))
;; Move to next fold.
(setq pos (org-fold-core-next-folding-state-change spec pos local-to)))))))))))))