bug#81579: [PATCH] Reimplement `outline-occur' using Xref and match Outline headings

From 0386da575b02565b73308de9d6d2cb13f0f38bd0 Mon Sep 17 00:00:00 2001
From: Roi Martin <[email protected]>
Date: Sat, 8 Aug 2026 11:13:41 +0200
Subject: [PATCH] Reimplement `outline-occur' using Xref and match Outline
 headings

Outline provides two search strategies to locate headings.  If
`outline-search-function' is defined, it is used to find the headings.
Otherwise, `outline-regexp' is used.  Reimplement `outline-occur' as
`outline-xref' using Xref and accepting a search function.  This
supports both search strategies and ensures that the headings detected
by `outline-xref' match the Outline ones.

* lisp/outline.el (outline-mode-prefix-map): Update binding.
(outline-mode-menu-bar-map): Update menu item.
(outline-occur-regexp): Remove variable.
(outline-occur): Remove function.
(outline-xref--fetch-headings, outline-xref--show-xrefs, outline-xref):
New functions.
* test/lisp/outline-tests.el (outline-tests--outline-occur)
(outline-tests--outline-occur-override)
(outline-tests--outline-occur-undefined-regexp): Remove tests.
(outline-tests--outline-xref-search-function)
(outline-tests--outline-xref-regexp)
(outline-tests--outline-xref-undefined): New tests.
---
 lisp/outline.el            | 70 ++++++++++++++++++++++++--------------
 test/lisp/outline-tests.el | 44 ++++++++++++------------
 2 files changed, 68 insertions(+), 46 deletions(-)

diff --git a/lisp/outline.el b/lisp/outline.el
index d27085c170f6..60b79160c7be 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -38,6 +38,7 @@
   (require 'cl-lib)
   (require 'subr-x))
 (require 'icons)
+(require 'xref)
 
 (defgroup outlines nil
   "Support for hierarchical outlining."
@@ -108,7 +109,7 @@ outline-mode-prefix-map
   "C-<" #'outline-promote
   "C->" #'outline-demote
   "RET" #'outline-insert-heading
-  "M-o" #'outline-occur)
+  "M-o" #'outline-xref)
 
 (defvar outline-mode-menu-bar-map
   (let ((map (make-sparse-keymap)))
@@ -149,9 +150,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 outline-xref]
+      '(menu-item "Show in Xref" outline-xref
+		  :help "Navigate the buffer's outline using Xref"))
     (define-key map [headings demote-subtree]
       '(menu-item "Demote Subtree" outline-demote
 		  :help "Demote headings lower down the tree"))
@@ -2184,30 +2185,49 @@ outline-editing-repeat-map
   "<"   #'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 `^'.")
+;;; Xref outline navigation
+
+(defun outline-xref--fetch-headings (search-function buffer)
+  "Return a list of Xref values matching SEARCH-FUNCTION in BUFFER."
+  (let (headings)
+    (with-current-buffer buffer
+      (save-excursion
+        (goto-char (point-min))
+        (while (funcall search-function nil t)
+          (let* ((line-beg (line-beginning-position))
+                 (line-end (line-end-position))
+                 (summary (progn
+                            (font-lock-ensure line-beg line-end)
+                            (buffer-substring line-beg line-end)))
+                 (location (xref-make-buffer-location buffer line-beg))
+                 (length (length summary)))
+            (push (xref-make-match summary location length) headings))
+          (forward-line 1))))
+    (nreverse headings)))
+
+(defun outline-xref--show-xrefs (search-function)
+  "Display search results in an Xref buffer.
+Populate an Xref buffer with the matches returned by SEARCH-FUNCTION
+applied to the current buffer."
+  (let ((buf (current-buffer)))
+    (xref-show-xrefs
+     (lambda ()
+       (outline-xref--fetch-headings search-function buf))
+     nil)))
 
 ;;;###autoload
-(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."
+(defun outline-xref ()
+  "Navigate the current buffer's outline using Xref.
+If `outline-search-function' is defined, it is used to find the outline
+headings.  Otherwise, the `outline-regexp' variable is used."
   (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")))
+  (cond
+   (outline-search-function
+    (outline-xref--show-xrefs outline-search-function))
+   (outline-regexp
+    (outline-xref--show-xrefs #'outline-search-from-regexp))
+   (t
+    (user-error "Undefined outline search strategy"))))
 
 
 (provide 'outline)
diff --git a/test/lisp/outline-tests.el b/test/lisp/outline-tests.el
index da87a0d1171f..b1b78df4c32e 100644
--- a/test/lisp/outline-tests.el
+++ b/test/lisp/outline-tests.el
@@ -27,42 +27,44 @@
 (require 'ert-x)
 (require 'outline)
 
-(ert-deftest outline-tests--outline-occur ()
-  "Test the `outline-occur' function with `outline-regexp'."
+(ert-deftest outline-tests--outline-xref-search-function ()
+  "Test the `outline-xref' function with `outline-search-function'."
   (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*")
+      (let ((outline-regexp "\\*")
+            (outline-search-function
+             (lambda (&optional bound move _backward _looking-at)
+               (re-search-forward "^-" bound move))))
+        (outline-xref)))
+    (with-current-buffer (get-buffer "*xref*")
       (goto-char (point-min))
-      (should (search-forward "* Star heading"))
+      (should-error (search-forward "* Star heading"))
       (goto-char (point-min))
-      (should-error (search-forward "- Dash heading")))))
+      (should (search-forward "- Dash heading")))))
 
-(ert-deftest outline-tests--outline-occur-override ()
-  "Test the `outline-occur' function with `outline-occur-regexp'."
+(ert-deftest outline-tests--outline-xref-regexp ()
+  "Test the `outline-xref' 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 "-")
-      (outline-occur))
-    (with-current-buffer (get-buffer "*Occur*")
+      (let ((outline-regexp "\\*")
+            (outline-search-function nil))
+        (outline-xref)))
+    (with-current-buffer (get-buffer "*xref*")
       (goto-char (point-min))
-      (should-error (search-forward "* Star heading"))
+      (should (search-forward "* Star heading"))
       (goto-char (point-min))
-      (should (search-forward "- Dash heading")))))
+      (should-error (search-forward "- Dash heading")))))
 
-(ert-deftest outline-tests--outline-occur-undefined-regexp ()
-  "Test the `outline-occur' function with undefined regexp."
+(ert-deftest outline-tests--outline-xref-undefined ()
+  "Test the `outline-xref' function with undefined search strategy."
   (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)))))
+      (let ((outline-regexp nil)
+            (outline-search-function nil))
+        (should-error (outline-xref))))))
 
 (provide 'outline-tests)
 
-- 
2.55.0