master fcee0b4ff1d: Reimplement `outline-occur' using Xref and match Outline headings
Juri Linkov <[email protected]>
| Newsgroups | gmane.emacs.diffs |
|---|---|
| Message-ID | <[email protected]> |
branch: master commit fcee0b4ff1d8f1039871d46932a0b1bb72b5687f Author: Roi Martin <[email protected]> Commit: Juri Linkov <[email protected]> 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 (bug#81579). * 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. --- etc/NEWS | 8 ++---- lisp/outline.el | 70 +++++++++++++++++++++++++++++----------------- test/lisp/outline-tests.el | 44 +++++++++++++++-------------- 3 files changed, 71 insertions(+), 51 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 9ddf8d41028..0456354feac 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -207,11 +207,9 @@ with named choices for the predefined search functions 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'. +*** New command 'outline-xref'. +It allows users to navigate the current buffer's outline using Xref. +It is bound to 'M-o'. ** Newsticker diff --git a/lisp/outline.el b/lisp/outline.el index d27085c170f..60b79160c7b 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 @@ imitate the function `looking-at'." "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 @@ imitate the function `looking-at'." :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 @@ With a prefix argument, show headings up to that LEVEL." "<" #'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 da87a0d1171..b1b78df4c32 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)