Package: emacs;
Reported by: Stefan Monnier <monnier <at> iro.umontreal.ca>
Date: Sun, 1 Jun 2025 20:08:03 UTC
Severity: normal
Found in version 31.0.50
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Eli Zaretskii <eliz <at> gnu.org> Cc: Jonas Bernoulli <jonas <at> bernoul.li>, 78665 <at> debbugs.gnu.org, Juri Linkov <juri <at> linkov.net> Subject: bug#78665: 31.0.50; Very slow saves Date: Mon, 02 Jun 2025 18:18:13 -0400
[Message part 1 (text/plain, inline)]
> AFAICT the problem is that sometimes this heading is already hidden
> (because of a preceding subtree covering the current one), so we end up
> going back to the preceding/larger subtree and re-hiding it. So for
> a subtree like that of `;;; Code:` covering N smaller subtrees that were
> previously hidden, we end hiding the `;;; Code:` subtree N times (and
> each time, this requires looping through all the covered headings),
> which introduces an O(N^2) complexity.
The patch below seems to fix it (and bug#78673 as well).
Juri, comments?
Stefan
[outline.patch (text/x-diff, inline)]
diff --git a/lisp/outline.el b/lisp/outline.el
index 9d453881b7e..5e8a3360c63 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -685,6 +685,7 @@ outline-next-preface
(goto-char (match-beginning 0))
;; Compensate "\n" from the beginning of regexp
(when (and outline-search-function (not (bobp))) (forward-char -1)))
+ ;; FIXME: Use `outline--end-of-previous'.
(when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
(forward-char -1)))
@@ -1287,6 +1288,16 @@ outline-flag-subtree
(progn (outline-end-of-subtree) (point))
flag)))
+(defun outline--end-of-previous ()
+ "Go back from BOH (or EOB) to end of previous element."
+ (if (eobp)
+ (if (bolp) (forward-char -1))
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (if (and outline-blank-line (bolp))
+ ;; leave blank line before heading
+ (forward-char -1))))
+
(defun outline-end-of-subtree ()
"Move to the end of the current subtree."
(outline-back-to-heading)
@@ -1298,12 +1309,7 @@ outline-end-of-subtree
(outline-next-heading))
(if (and (bolp) (not (eolp)))
;; We stopped at a nonempty line (the next heading).
- (progn
- ;; Go to end of line before heading
- (forward-char -1)
- (if (and outline-blank-line (bolp))
- ;; leave blank line before heading
- (forward-char -1))))))
+ (outline--end-of-previous))))
(defun outline-show-branches ()
"Show all subheadings of this heading, but not their bodies."
@@ -1717,8 +1723,8 @@ outline-hide-by-heading-regexp
(run-hooks 'outline-view-change-hook))
(defun outline--hidden-headings-paths ()
- "Return a hash with headings of currently hidden outlines.
-Every hash key is a list whose elements compose a complete path
+ "Return a hash-table with headings of currently hidden outlines.
+Every key is a list whose elements compose a complete path
of headings descending from the top level down to the bottom level.
This is useful to save the hidden outlines and restore them later
after reverting the buffer. Also return the outline where point
@@ -1730,40 +1736,60 @@ outline--hidden-headings-paths
(current-end (when current-heading-p (pos-eol))))
(outline-map-region
(lambda ()
- (let* ((level (funcall outline-level))
- (heading (buffer-substring-no-properties (pos-bol) (pos-eol))))
- (while (and path (>= (cdar path) level))
- (pop path))
- (push (cons heading level) path)
- (when (save-excursion
- (outline-end-of-heading)
- (seq-some (lambda (o) (eq (overlay-get o 'invisible)
- 'outline))
- (overlays-at (point))))
- (setf (gethash (mapcar #'car path) paths) t))
+ (let ((level (funcall outline-level)))
+ (if (outline-invisible-p)
+ ;; Covered by "the" previous heading.
+ (cl-callf (lambda (l) (if (numberp l) (min l level) level))
+ (gethash (mapcar #'car path) paths))
+ (let ((heading (buffer-substring-no-properties (pos-bol) (pos-eol))))
+ (while (and path (>= (cdar path) level))
+ (pop path))
+ (push (cons heading level) path)
+ (when (save-excursion
+ (outline-end-of-heading)
+ (outline-invisible-p))
+ (setf (gethash (mapcar #'car path) paths) t))))
(when (and current-heading-p (<= current-beg (point) current-end))
(setq current-path (mapcar #'car path)))))
(point-min) (point-max))
(list paths current-path)))
(defun outline--hidden-headings-restore-paths (paths current-path)
- "Restore hidden outlines from a hash of hidden headings.
+ "Restore hidden outlines from a hash-table of hidden headings.
This is useful after reverting the buffer to restore the outlines
hidden by `outline--hidden-headings-paths'. Also restore point
on the same outline where point was before reverting the buffer."
- (let (path current-point outline-view-change-hook)
+ (let ((hidelevel nil) (hidestart nil)
+ path current-point outline-view-change-hook)
(outline-map-region
(lambda ()
- (let* ((level (funcall outline-level))
- (heading (buffer-substring (pos-bol) (pos-eol))))
- (while (and path (>= (cdar path) level))
- (pop path))
- (push (cons heading level) path)
- (when (gethash (mapcar #'car path) paths)
- (outline-hide-subtree))
+ (let ((level (funcall outline-level)))
+ (if (and (numberp hidelevel) (<= hidelevel level))
+ nil
+ (when hidestart
+ (outline-flag-region hidestart
+ (save-excursion (outline--end-of-previous)
+ (point))
+ t)
+ (setq hidestart nil))
+ (let* ((heading (buffer-substring-no-properties
+ (pos-bol) (pos-eol))))
+ (while (and path (>= (cdar path) level))
+ (pop path))
+ (push (cons heading level) path)
+ (when (setq hidelevel (gethash (mapcar #'car path) paths))
+ (setq hidestart (save-excursion (outline-end-of-heading)
+ (point))))))
(when (and current-path (equal current-path (mapcar #'car path)))
(setq current-point (point)))))
(point-min) (point-max))
+ (when hidestart
+ (outline-flag-region hidestart
+ (save-excursion
+ (goto-char (point-max))
+ (outline--end-of-previous)
+ (point))
+ t))
(when current-point (goto-char current-point))))
(defun outline-revert-buffer-restore-visibility ()
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.