bug#81512: [PATCH] Add command `outline-occur'

--=-=-=
Content-Type: text/plain

martin rudalics <[email protected]> writes:

> +   By setting the @var{action} argument and the
> +@code{display-buffer-default-alist} variable, an application effectively
>   overrules any customization of @code{display-buffer-base-action}.  Our
>
> might be read as "both must be set to overrule" so maybe "and/or" would
> be better.

Actualy, when I was editing that paragraph, I was not sure whether to
use "and" or "or", but didn't considered "and/or", which is definitely
better.

Fixed in v6.

        Roi


--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
 filename=v6-0001-Add-outline-occur-command-and-display-buffer-defa.patch

From 0ca811596b352e093c90b5b9290df28248d42377 Mon Sep 17 00:00:00 2001
From: Roi Martin <[email protected]>
Date: Tue, 28 Jul 2026 20:19:03 +0200
Subject: [PATCH v6] Add `outline-occur' command and
 `display-buffer-default-alist' variable

Add the `outline-occur' command that allows navigating the current
buffer's outline using Occur.  Also add the
`display-buffer-default-alist' variable, which Lisp programs may
let-bind to specify conditional actions for nested `display-buffer'
calls.

* doc/lispref/windows.texi (Choosing Window)
(Precedence of Action Functions): Document
`display-buffer-default-alist' variable.
* etc/NEWS: Add `outline-occur' and `display-buffer-default-alist'
entries.
* lisp/outline.el (outline-mode-prefix-map): Bind `outline-occur'.
(outline-mode-menu-bar-map): Add `outline-occur' menu item.
(outline-occur-regexp): New buffer-local variable.
(outline-occur): New command.
* lisp/replace.el (occur-1): Call `display-buffer' with category.
* lisp/window.el (display-buffer-alist): Update docstring.
(display-buffer-default-alist): New variable.
(display-buffer): Handle `display-buffer-default-alist' variable.
* test/lisp/outline-resources/outline.txt: New test file.
* test/lisp/outline-tests.el: New test suite.  (Bug#81512)

Co-authored-by: Martin Rudalics <[email protected]>
Co-authored-by: Juri Linkov <[email protected]>
---
 doc/lispref/windows.texi                | 48 +++++++++++++++--
 etc/NEWS                                | 12 +++++
 lisp/outline.el                         | 31 ++++++++++-
 lisp/replace.el                         |  2 +-
 lisp/window.el                          | 30 ++++++++---
 test/lisp/outline-resources/outline.txt |  2 +
 test/lisp/outline-tests.el              | 69 +++++++++++++++++++++++++
 7 files changed, 183 insertions(+), 11 deletions(-)
 create mode 100644 test/lisp/outline-resources/outline.txt
 create mode 100644 test/lisp/outline-tests.el

diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index ddc8524ddb6b..aed1eeca5da1 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -3119,6 +3119,9 @@ Choosing Window
 @item
 The user option @code{display-buffer-alist}.
 
+@item
+The variable @code{display-buffer-default-alist}.
+
 @item
 The @var{action} argument.
 
@@ -3181,6 +3184,13 @@ Choosing Window
 default value is an empty display action, i.e., @w{@code{(nil . nil)}}.
 @end defvar
 
+@defvar display-buffer-default-alist
+The value of this variable is an alist mapping conditions to display
+actions (@pxref{display-buffer-alist}).  Lisp programs may let-bind it
+to specify conditional actions for nested @code{display-buffer} calls.
+@end defvar
+
+@anchor{display-buffer-alist}
 @defopt display-buffer-alist
 The value of this option is an alist mapping conditions to display
 actions.  Each condition is passed to @code{buffer-match-p}
@@ -4475,10 +4485,42 @@ Precedence of Action Functions
 the window already showing @file{*foo*} since both functions supplied
 by the @var{action} argument try to reuse such a window first.
 
-   By setting the @var{action} argument, an application effectively
+   There are cases, however, where Lisp programs want to modify the
+default behavior of a @code{display-buffer} call hidden behind another
+function.  In those cases, setting the @var{action} argument is not an
+option.  Fortunately, the @code{display-buffer-default-alist} variable
+can be used to specify a list of conditional default actions.  Consider
+the following example:
+
+@example
+@group
+(defun foo (buffer)
+   (display-buffer
+    buffer
+    '((display-buffer-below-selected display-buffer-at-bottom))))
+
+(defun bar ()
+   (let ((display-buffer-default-alist
+         '(("\\*bar\\*" (display-buffer-pop-up-frame)))))
+     (foo (get-buffer-create "*bar*"))))
+
+(defun baz ()
+   (let ((display-buffer-default-alist
+         '(("\\*baz\\*" (display-buffer-same-window)))))
+     (foo (get-buffer-create "*baz*"))))
+@end group
+@end example
+
+   Here, @code{foo} calls @code{display-buffer} with a specific
+@var{action}.  Let-binding @code{display-buffer-default-alist} allows
+the functions @code{bar} and @code{baz} to specify their own action
+functions.
+
+   By setting the @var{action} argument and/or the
+@code{display-buffer-default-alist} variable, an application effectively
 overrules any customization of @code{display-buffer-base-action}.  Our
-user can now either accept the choice of the application, or redouble
-by customizing the option @code{display-buffer-alist} as follows:
+user can now either accept the choice of the application, or redouble by
+customizing the option @code{display-buffer-alist} as follows:
 
 @example
 @group
diff --git a/etc/NEWS b/etc/NEWS
index ead3f7fb72cb..56d87c8e4e36 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -206,6 +206,13 @@ with named choices for the predefined search functions
 ('outline-search-from-regexp' and 'outline-search-level')
 as well as the default nil and arbitrary user functions.
 
+---
+*** New command 'outline-occur'.
+It allows users to navigate the current buffer's outline using Occur.
+The 'outline-regexp' variable is used to find the beginning of the
+outline headings.  The 'outline-occur-regexp' buffer-local variable
+allows overriding this regexp.  It is bound to 'M-o'.
+
 ** Newsticker
 
 ---
@@ -327,6 +334,11 @@ how to analyze the arguments of a function by declaring the
 specification of each argument, rather than implementing an analyzer
 function as you would with 'elisp-scope-define-function-analyzer'.
 
++++
+** New variable 'display-buffer-default-alist'
+Lisp programs may let-bind this variable to specify conditional actions
+for nested 'display-buffer' calls.
+
 
 * Changes in Emacs 32.1 on Non-Free Operating Systems
 
diff --git a/lisp/outline.el b/lisp/outline.el
index 4b4f3c2d520e..1ee86ae871dc 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -107,7 +107,8 @@ outline-mode-prefix-map
   "/ h" #'outline-hide-by-heading-regexp
   "C-<" #'outline-promote
   "C->" #'outline-demote
-  "RET" #'outline-insert-heading)
+  "RET" #'outline-insert-heading
+  "M-o" #'outline-occur)
 
 (defvar outline-mode-menu-bar-map
   (let ((map (make-sparse-keymap)))
@@ -148,6 +149,9 @@ outline-mode-menu-bar-map
 		  :help "Show all of the text in the buffer"))
     (define-key map [headings]
       (cons "Headings" (make-sparse-keymap "Headings")))
+    (define-key map [headings outline-occur]
+      '(menu-item "Show in Occur" outline-occur
+		  :help "Navigate the buffer's outline using Occur"))
     (define-key map [headings demote-subtree]
       '(menu-item "Demote Subtree" outline-demote
 		  :help "Demote headings lower down the tree"))
@@ -2179,6 +2183,31 @@ outline-editing-repeat-map
   "C-<" #'outline-promote
   "<"   #'outline-promote)
 
+
+;;; Occur outline navigation
+
+(defvar-local outline-occur-regexp nil
+  "Regexp used by `outline-occur' to override `outline-regexp'.
+Matches the beginning of the outline headings.  Any line whose beginning
+matches this regexp is considered to start a heading.  As Outline mode
+does with `outline-regexp', `outline-occur' only checks this regexp at
+the start of a line, so the regexp need not start with `^'.")
+
+(defun outline-occur ()
+  "Navigate the current buffer's outline using `occur'.
+The `outline-regexp' variable is used to find the beginning of the
+outline headings.  The `outline-occur-regexp' buffer-local variable
+allows overriding this regexp."
+  (interactive)
+  (if-let* ((regexp (or outline-occur-regexp outline-regexp)))
+      (let ((display-buffer-default-alist
+	     (append '(((category . occur)
+		        (display-buffer-pop-up-window)
+		        (post-command-select-window . t)))
+		     display-buffer-default-alist)))
+        (occur (concat "^\\(?:" regexp "\\)")))
+    (user-error "No outline regexp defined")))
+
 
 (provide 'outline)
 (provide 'noutline)
diff --git a/lisp/replace.el b/lisp/replace.el
index e7407869ca27..be8b4d1baffb 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2062,7 +2062,7 @@ occur-1
 	  (setq occur-revert-arguments (list regexp nlines bufs))
           (if (= count 0)
               (kill-buffer occur-buf)
-            (display-buffer occur-buf)
+            (display-buffer occur-buf '(nil (category . occur)))
             (when occur--final-pos
               (set-window-point
                (get-buffer-window occur-buf 'all-frames)
diff --git a/lisp/window.el b/lisp/window.el
index 06128cf0483c..dbd72e7bf6c4 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8084,9 +8084,9 @@ display-buffer-overriding-action
 
 (defcustom display-buffer-alist nil
   "Alist of user-defined conditional actions for `display-buffer'.
-Its value takes effect before processing the ACTION argument of
-`display-buffer' and before `display-buffer-base-action' and
-`display-buffer-fallback-action', but after
+Its value takes effect before processing `display-buffer-default-alist',
+the ACTION argument of `display-buffer', `display-buffer-base-action'
+and `display-buffer-fallback-action', but after
 `display-buffer-overriding-action', which see.
 
 If non-nil, this is an alist of elements (CONDITION . ACTION),
@@ -8110,6 +8110,21 @@ display-buffer-alist
   :version "24.1"
   :group 'windows)
 
+(defvar display-buffer-default-alist nil
+  "Alist of conditional default actions for `display-buffer'.
+Its value takes effect before processing the ACTION argument of
+`display-buffer' and before `display-buffer-base-action' and
+`display-buffer-fallback-action', but after
+`display-buffer-overriding-action' and `display-buffer-alist', which
+see.
+
+Lisp programs may let-bind this variable to specify conditional actions
+for nested `display-buffer' calls.
+
+If non-nil, this is an alist of elements (CONDITION . ACTION) like
+`display-buffer-alist'.")
+(put 'display-buffer-default-alist 'risky-local-variable t)
+
 (defcustom display-buffer-base-action '(nil . nil)
   "User-specified default action for `display-buffer'.
 This is the default action used by `display-buffer' if no other
@@ -8398,6 +8413,9 @@ display-buffer
             (display-buffer-assq-regexp
              buf-name display-buffer-alist action))
            (special-action (display-buffer--special-action buffer))
+           (default-action
+            (display-buffer-assq-regexp
+             buf-name display-buffer-default-alist action))
            ;; Extra actions from the arguments to this function:
            (extra-action
             (cons nil (append (if inhibit-same-window
@@ -8405,9 +8423,9 @@ display-buffer
                               (if frame
                                   `((reusable-frames . ,frame))))))
            ;; Construct action function list and action alist.
-           (actions (list display-buffer-overriding-action
-                          user-action special-action action extra-action
-                          display-buffer-base-action
+           (actions (list display-buffer-overriding-action user-action
+                          special-action default-action action
+                          extra-action display-buffer-base-action
                           display-buffer-fallback-action))
            (functions (apply #'append
                              (mapcar (lambda (x)
diff --git a/test/lisp/outline-resources/outline.txt b/test/lisp/outline-resources/outline.txt
new file mode 100644
index 000000000000..f3704f9438a0
--- /dev/null
+++ b/test/lisp/outline-resources/outline.txt
@@ -0,0 +1,2 @@
+* Star heading
+- Dash heading
diff --git a/test/lisp/outline-tests.el b/test/lisp/outline-tests.el
new file mode 100644
index 000000000000..da87a0d1171f
--- /dev/null
+++ b/test/lisp/outline-tests.el
@@ -0,0 +1,69 @@
+;;; outline-tests.el --- ERT tests for outline.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2026 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for the `outline' feature.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'outline)
+
+(ert-deftest outline-tests--outline-occur ()
+  "Test the `outline-occur' function with `outline-regexp'."
+  (let ((test-file (ert-resource-file "outline.txt")))
+    (with-temp-buffer
+      (insert-file-contents test-file)
+      (setq-local outline-regexp "\\*"
+		  outline-occur-regexp nil)
+      (outline-occur))
+    (with-current-buffer (get-buffer "*Occur*")
+      (goto-char (point-min))
+      (should (search-forward "* Star heading"))
+      (goto-char (point-min))
+      (should-error (search-forward "- Dash heading")))))
+
+(ert-deftest outline-tests--outline-occur-override ()
+  "Test the `outline-occur' function with `outline-occur-regexp'."
+  (let ((test-file (ert-resource-file "outline.txt")))
+    (with-temp-buffer
+      (insert-file-contents test-file)
+      (setq-local outline-regexp "\\*"
+		  outline-occur-regexp "-")
+      (outline-occur))
+    (with-current-buffer (get-buffer "*Occur*")
+      (goto-char (point-min))
+      (should-error (search-forward "* Star heading"))
+      (goto-char (point-min))
+      (should (search-forward "- Dash heading")))))
+
+(ert-deftest outline-tests--outline-occur-undefined-regexp ()
+  "Test the `outline-occur' function with undefined regexp."
+  (let ((test-file (ert-resource-file "outline.txt")))
+    (with-temp-buffer
+      (insert-file-contents test-file)
+      (setq-local outline-regexp nil
+		  outline-occur-regexp nil)
+      (should-error (outline-occur)))))
+
+(provide 'outline-tests)
+
+;;; outline-tests.el ends here
-- 
2.55.0


--=-=-=--