From 77a4c63fda5ca5d4c6d82092eaa06f1eb9b51302 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 4 Jun 2025 16:36:27 -0400 Subject: [PATCH] (outline--hidden-headings-paths): Fix slow saves (bug#78665) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/outline.el: Prefer #' to quote function names. (outline--end-of-previous): New function, extracted from `outline-end-of-subtree`. (outline-end-of-subtree): Use it. (outline--hidden-headings-paths): Distinguish headings where just the entry is hidden from those where a whole subtree is hidden (bug#78673). (outline--hidden-headings-restore-paths): Adjust accordingly and don't delegate to functions like `outline-hide-subtree` so as to avoid an O(N²) behavior. --- lisp/outline.el | 101 ++++++++++++++++++++++++++++++---------------- lisp/transient.el | 48 +++++++++++----------- 2 files changed, 90 insertions(+), 59 deletions(-) diff --git a/lisp/outline.el b/lisp/outline.el index 9d453881b7e..dc2b5b32685 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -235,10 +235,10 @@ The argument MAP is optional and defaults to `outline-minor-mode-cycle-map'." (let ((map (make-sparse-keymap))) (outline-minor-mode-cycle--bind map (kbd "TAB") #'outline-cycle) (outline-minor-mode-cycle--bind map (kbd "") #'outline-cycle-buffer) - (keymap-set map " " 'outline-cycle) - (keymap-set map " " 'outline-cycle) - (keymap-set map " S-" 'outline-cycle-buffer) - (keymap-set map " S-" 'outline-cycle-buffer) + (keymap-set map " " #'outline-cycle) + (keymap-set map " " #'outline-cycle) + (keymap-set map " S-" #'outline-cycle-buffer) + (keymap-set map " S-" #'outline-cycle-buffer) map) "Keymap used as a parent of the `outline-minor-mode' keymap. It contains key bindings that can be used to cycle visibility. @@ -483,7 +483,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of The value of this variable is checked as part of loading Outline mode. After that, changing the prefix key requires manipulating keymaps." :type 'key-sequence - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (sym val) (define-key outline-minor-mode-map outline-minor-mode-prefix nil) (define-key outline-minor-mode-map val outline-mode-prefix-map) @@ -685,6 +685,7 @@ at the end of the buffer." (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 @@ This also unhides the top heading-less body, if any." (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 @@ This also unhides the top heading-less body, if any." (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,12 +1723,17 @@ LEVEL, decides of subtree visibility according to (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 (HASH-TABLE CURRENT-HEADING). +HASH-TABLE holds the 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. +Every entry's value is non-nil if that entry should be hidden. +The specific non-nil vale can be t to hide just the entry, or a number +LEVEL to mean that not just the entry should be hidden but also all the +subsequent elements of level higher or equal to LEVEL. This is useful to save the hidden outlines and restore them later -after reverting the buffer. Also return the outline where point -was located before reverting the buffer." +after reverting the buffer. +CURRENT-HEADING is the heading where point is located." (let* ((paths (make-hash-table :test #'equal)) path current-path (current-heading-p (outline-on-heading-p)) @@ -1730,40 +1741,60 @@ was located before reverting the buffer." (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 () diff --git a/lisp/transient.el b/lisp/transient.el index 686dc469463..e0c834564c6 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -72,7 +72,7 @@ (transient--emergency-exit :debugger) (apply #'debug args)) -;;; Options +;;;; Options (defgroup transient nil "Transient commands." @@ -507,7 +507,7 @@ give you as many additional suffixes as you hoped.)" :group 'transient :type 'boolean) -;;; Faces +;;;; Faces (defgroup transient-faces nil "Faces used by Transient." @@ -655,7 +655,7 @@ See also option `transient-highlight-mismatched-keys'." See also option `transient-highlight-mismatched-keys'." :group 'transient-faces) -;;; Persistence +;;;; Persistence (defun transient--read-file-contents (file) (with-demoted-errors "Transient error: %S" @@ -718,7 +718,7 @@ If `transient-save-history' is nil, then do nothing." (unless noninteractive (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) -;;; Classes +;;;; Classes ;;;; Prefix (defclass transient-prefix () @@ -965,7 +965,7 @@ commands or strings. This group inserts an empty line between subgroups. The subgroups are responsible for displaying their elements themselves.") -;;; Define +;;;; Define (defmacro transient-define-prefix (name arglist &rest args) "Define NAME as a transient prefix command. @@ -1482,7 +1482,7 @@ Intended for use in a group's `:setup-children' function." (setq prefix (oref prefix command))) (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) -;;; Edit +;;;; Edit (defun transient--insert-suffix (prefix loc suffix action &optional keep-other) (pcase-let* ((suf (cl-etypecase suffix @@ -1699,7 +1699,7 @@ using `transient-define-suffix', `transient-define-infix' or (user-error "Cannot set level for `%s'; no prototype object exists" command))) -;;; Variables +;;;; Variables (defvar transient-current-prefix nil "The transient from which this suffix command was invoked. @@ -1806,7 +1806,7 @@ This is bound while the suffixes are drawn in the transient buffer.") mwheel-scroll scroll-bar-toolkit-scroll)) -;;; Identities +;;;; Identities (defun transient-active-prefix (&optional prefixes) "Return the active transient object. @@ -1944,7 +1944,7 @@ probably use this instead: (seq-some (lambda (cmd) (get cmd 'transient--suffix)) (function-alias-p command)))) -;;; Keymaps +;;;; Keymaps (defvar-keymap transient-base-map :doc "Parent of other keymaps used by Transient. @@ -2306,7 +2306,7 @@ of the corresponding object." transient--transient-map)) topmap)) -;;; Setup +;;;; Setup (defun transient-setup (&optional name layout edit &rest params) "Setup the transient specified by NAME. @@ -2587,7 +2587,7 @@ value. Otherwise return CHILDREN as is.") (transient--debug " autoload %s" cmd) (autoload-do-load fn))) -;;; Flow-Control +;;;; Flow-Control (defun transient--setup-transient () (transient--debug 'setup-transient) @@ -2981,7 +2981,7 @@ identifying the exit." (transient--pre-exit) (transient--post-exit this-command))) -;;; Pre-Commands +;;;; Pre-Commands (defun transient--call-pre-command () (if-let* ((fn (transient--get-pre-command this-command @@ -3164,7 +3164,7 @@ prefix argument and pivot to `transient-update'." (put 'transient--do-move 'transient-face 'transient-key-stay) (put 'transient--do-minus 'transient-face 'transient-key-stay) -;;; Commands +;;;; Commands ;;;; Noop (defun transient-noop () @@ -3487,7 +3487,7 @@ such as when suggesting a new feature or reporting an issue." arguments " ")) (message "%s: %S" (key-description (this-command-keys)) arguments))) -;;; Value +;;;; Value ;;;; Init (cl-defgeneric transient-init-value (obj) @@ -4000,7 +4000,7 @@ Append \"=\ to ARG to indicate that it is an option." (or (match-string 1 match) ""))) (and (member arg args) t))) -;;; Return +;;;; Return (defun transient-init-return (obj) (when-let* ((transient--stack) @@ -4012,7 +4012,7 @@ Append \"=\ to ARG to indicate that it is an option." (list t 'recurse #'transient--do-recurse)))) (oset obj return t))) -;;; Scope +;;;; Scope ;;;; Init (cl-defgeneric transient-init-scope (obj) @@ -4084,7 +4084,7 @@ If no prefix matches, return nil." (and-let* ((obj (transient-prefix-object))) (oref obj scope)))) -;;; History +;;;; History (cl-defgeneric transient--history-key (obj) "Return OBJ's history key.") @@ -4116,7 +4116,7 @@ have a history of their own.") (cons val (delete val (alist-get (transient--history-key obj) transient-history)))))) -;;; Display +;;;; Display (defun transient--show-hint () (let ((message-log-max nil)) @@ -4190,7 +4190,7 @@ have a history of their own.") (window-body-width window t) (window-body-height window t)))) -;;; Delete +;;;; Delete (defun transient--delete-window () (when (window-live-p transient--window) @@ -4224,7 +4224,7 @@ have a history of their own.") (setq show (natnump show))) show)) -;;; Format +;;;; Format (defun transient--format-hint () (if (and transient-show-popup (<= transient-show-popup 0)) @@ -4728,7 +4728,7 @@ a prefix command, while porting a regular keymap to a transient." (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) -;;; Help +;;;; Help (cl-defgeneric transient-show-help (obj) "Show documentation for the command represented by OBJ.") @@ -5169,7 +5169,7 @@ as stand-in for elements of exhausted lists." (setq lists (mapcar #'cdr lists))) (nreverse result))) -;;; Font-Lock +;;;; Font-Lock (defconst transient-font-lock-keywords (eval-when-compile @@ -5187,7 +5187,7 @@ as stand-in for elements of exhausted lists." (font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords) -;;; Auxiliary Classes +;;;; Auxiliary Classes ;;;; `transient-lisp-variable' (defclass transient-lisp-variable (transient-variable) @@ -5250,4 +5250,4 @@ as stand-in for elements of exhausted lists." ;; indent-tabs-mode: nil ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") ;; End: -;;; transient.el ends here +;;;; transient.el ends here