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

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

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

* doc/lispref/windows.texi (Choosing Window): Document
`display-buffer-bound-alist' variable.
* etc/NEWS: Add `outline-occur' and `display-buffer-bound-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-bound-alist): New variable.
(display-buffer): Handle `display-buffer-bound-alist'.
* 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                | 11 ++++
 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, 149 insertions(+), 8 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..2967bc934d3f 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-bound-alist}.
+
 @item
 The @var{action} argument.
 
@@ -3181,6 +3184,14 @@ Choosing Window
 default value is an empty display action, i.e., @w{@code{(nil . nil)}}.
 @end defvar
 
+@defvar display-buffer-bound-alist
+The value of this variable is an alist mapping conditions to display
+actions (@pxref{display-buffer-alist}).  Elisp code may let-bind it to set
+conditional actions for nested @code{display-buffer} calls.  However, it
+should never be assigned buffer-locally or globally.
+@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}
diff --git a/etc/NEWS b/etc/NEWS
index 92033851c74c..7d5180f62168 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -188,6 +188,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
 
 ---
@@ -296,6 +303,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-bound-alist'
+Elisp code may let-bind this variable to set 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..6c2af272bfaa 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-bound-alist
+	     (append '(((category . occur)
+		        (display-buffer-pop-up-window)
+		        (post-command-select-window . t)))
+		     display-buffer-bound-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..38c971caecac 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-bound-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-bound-alist nil
+  "Alist of bound 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
+`display-buffer-overriding-action' and `display-buffer-alist', which
+see.
+
+Elisp code may let-bind this around nested `display-buffer' calls but
+should never assign it buffer-locally or globally.
+
+If non-nil, this is an alist of elements (CONDITION . ACTION) like
+`display-buffer-alist'.")
+(put 'display-buffer-bound-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))
+           (bound-action
+            (display-buffer-assq-regexp
+             buf-name display-buffer-bound-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 bound-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