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

From acb5d86eab01ed69beb786b2ccb227979efb8ba1 Mon Sep 17 00:00:00 2001
From: Roi Martin <[email protected]>
Date: Tue, 28 Jul 2026 20:19:03 +0200
Subject: [PATCH] Add command `outline-occur'

* etc/NEWS: Add entry.
* lisp/outline.el (outline-mode-prefix-map): Add keymap.
(outline-mode-menu-bar-map): Add menu item.
(outline-occur-regexp): New buffer-local variable.
(outline-occur): New command.
* test/lisp/outline-resources/outline.txt: New test file.
* test/lisp/outline-tests.el: New test suite.
---
 etc/NEWS                                |  7 +++
 lisp/outline.el                         | 27 +++++++++-
 test/lisp/outline-resources/outline.txt |  2 +
 test/lisp/outline-tests.el              | 69 +++++++++++++++++++++++++
 4 files changed, 104 insertions(+), 1 deletion(-)
 create mode 100644 test/lisp/outline-resources/outline.txt
 create mode 100644 test/lisp/outline-tests.el

diff --git a/etc/NEWS b/etc/NEWS
index 92033851c74c..2fbec148abd6 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
 
 ---
diff --git a/lisp/outline.el b/lisp/outline.el
index 4b4f3c2d520e..aa0db326861c 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,27 @@ 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 ((occur-hook (lambda () (pop-to-buffer "*Occur*"))))
+	(occur (concat "^\\(?:" regexp "\\)")))
+    (user-error "No outline regexp defined")))
+
 
 (provide 'outline)
 (provide 'noutline)
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