]> git.eshelyaron.com Git - emacs.git/commitdiff
Support bookmarking 'project-find-regexp' results buffer
authorEshel Yaron <me@eshelyaron.com>
Mon, 12 Feb 2024 17:38:36 +0000 (18:38 +0100)
committerEshel Yaron <me@eshelyaron.com>
Mon, 12 Feb 2024 17:38:36 +0000 (18:38 +0100)
* lisp/progmodes/project.el (xref-backend-apropos)
(xref-backend-context, xref-backend-restore): New methods.
(project-find-regexp, project-or-external-find-regexp): Use
'xref-make-fetcher' instead of a bespoke fetcher function to
facilitate bookmarking the results buffer.

* lisp/progmodes/xref.el (xref-bookmark-make-record): Use
strings for 'format-spec' specifications.
(xref-bookmark-jump): Autoload it.
(xref-show-xrefs): Make DISPLAY-ACTION argument optional.
(xref-make-fetcher): Autoload, and make BUFFER and POINT
arguments optional, default to the current buffer and point.

lisp/progmodes/project.el
lisp/progmodes/xref.el

index 916a031ec6071d71608464f68225ef820b561dac..6b0b4e8685141127dcb74b6df199c4b002dd852e 100644 (file)
@@ -947,32 +947,44 @@ The following commands are available:
 (declare-function grep-read-files "grep")
 (declare-function xref--find-ignores-arguments "xref")
 
+(cl-defmethod xref-backend-context ((_backend (head project)) _id _kind))
+(cl-defmethod xref-backend-restore ((_backend (head project)) _context))
+(cl-defmethod xref-backend-apropos ((backend (head project)) pattern)
+  (project--find-regexp-in-files pattern (project-files (cdr backend))))
+
+(cl-defmethod xref-backend-context ((_backend (head project-dir)) _id _kind))
+(cl-defmethod xref-backend-restore ((_backend (head project-dir)) _context))
+(cl-defmethod xref-backend-apropos ((backend (head project-dir)) pattern)
+  (project--find-regexp-in-files
+   pattern (project--files-in-directory (nth 1 backend) nil (nth 2 backend))))
+
+(cl-defmethod xref-backend-context ((_backend (head project-ext)) _id _kind))
+(cl-defmethod xref-backend-restore ((_backend (head project-ext)) _context))
+(cl-defmethod xref-backend-apropos ((backend (head project-ext)) pattern)
+  (let ((pr (cdr backend)))
+    (project--find-regexp-in-files
+     pattern (project-files pr (cons (project-root pr)
+                                     (project-external-roots pr))))))
+
 ;;;###autoload
-(defun project-find-regexp (regexp)
+(defun project-find-regexp (regexp &optional dir pattern)
   "Find all matches for REGEXP in the current project's roots.
-With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for.  The
+With \\[universal-argument] prefix, you can specify the DIR
+to search in, and the file name PATTERN to search for.  The
 pattern may use abbreviations defined in `grep-files-aliases',
 e.g. entering `ch' is equivalent to `*.[ch]'.  As whitespace
 triggers completion when entering a pattern, including it
 requires quoting, e.g. `\\[quoted-insert]<space>'."
-  (interactive (list (project--read-regexp)))
-  (require 'xref)
-  (require 'grep)
-  (let* ((caller-dir default-directory)
-         (pr (project-current t))
-         (default-directory (project-root pr))
-         (files
-          (if (not current-prefix-arg)
-              (project-files pr)
-            (let ((dir (read-directory-name "Base directory: "
-                                            caller-dir nil t)))
-              (project--files-in-directory dir
-                                           nil
-                                           (grep-read-files regexp))))))
-    (xref-show-xrefs
-     (apply-partially #'project--find-regexp-in-files regexp files)
-     nil)))
+  (interactive (let* ((regexp (project--read-regexp))
+                      (dir-pat (when current-prefix-arg
+                                 (cons (read-directory-name "Base directory: ")
+                                       (grep-read-files regexp)))))
+                 (list regexp (car dir-pat) (cdr dir-pat))))
+  (xref-show-xrefs (xref-make-fetcher
+                    (if dir
+                        (list 'project-dir dir pattern)
+                      (cons 'project (project-current t)))
+                    regexp 'apropos regexp)))
 
 (defun project--dir-ignores (project dir)
   (let ((root (project-root project)))
@@ -987,20 +999,11 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
 
 ;;;###autoload
 (defun project-or-external-find-regexp (regexp)
-  "Find all matches for REGEXP in the project roots or external roots.
-With \\[universal-argument] prefix, you can specify the file name
-pattern to search for."
+  "Find all matches for REGEXP in the project roots or external roots."
   (interactive (list (project--read-regexp)))
-  (require 'xref)
-  (let* ((pr (project-current t))
-         (default-directory (project-root pr))
-         (files
-          (project-files pr (cons
-                             (project-root pr)
-                             (project-external-roots pr)))))
-    (xref-show-xrefs
-     (apply-partially #'project--find-regexp-in-files regexp files)
-     nil)))
+  (xref-show-xrefs (xref-make-fetcher
+                    (cons 'project-ext (project-current t))
+                    regexp 'apropos regexp)))
 
 (defun project--find-regexp-in-files (regexp files)
   (unless files
index 6841f93a9c21fca3e328f7fb2d7616689e729c2f..2742cc56ea1f1f95c4b772b2740110f3c5184148 100644 (file)
@@ -1049,8 +1049,8 @@ Xref buffers."
     (user-error "Cannot bookmark due to unknown Xref backend"))
   `(,(format-spec xref-default-bookmark-name-format
                   `((?i . ,xref--identifier)
-                    (?k . ,xref--kind)
-                    (?b . ,xref--backend)))
+                    (?k . ,(symbol-name xref--kind))
+                    (?b . ,(prin1-to-string xref--backend))))
     ,@(bookmark-make-record-default t)
     (backend . ,xref--backend)
     (context . ,(when (buffer-live-p xref--original-buffer)
@@ -1064,6 +1064,7 @@ Xref buffers."
     (kind . ,xref--kind)
     (handler . xref-bookmark-jump)))
 
+;;;###autoload
 (defun xref-bookmark-jump (bookmark)
   "Jump to Xref buffer bookmark BOOKMARK."
   (let* ((backend (bookmark-prop-get bookmark 'backend))
@@ -1587,7 +1588,7 @@ definitions."
 (defvar xref--read-pattern-history nil)
 
 ;;;###autoload
-(defun xref-show-xrefs (fetcher display-action)
+(defun xref-show-xrefs (fetcher &optional display-action)
   "Display some Xref values produced by FETCHER using DISPLAY-ACTION.
 The meanings of both arguments are the same as documented in
 `xref-show-xrefs-function'."
@@ -1680,7 +1681,8 @@ The meanings of both arguments are the same as documented in
    (xref--create-fetcher id 'definitions id)
    display-action))
 
-(defun xref-make-fetcher (backend input kind identifier buffer point)
+;;;###autoload
+(defun xref-make-fetcher (backend input kind identifier &optional buffer point)
   "Return fetcher function for xrefs of kind KIND for IDENTIFIER using BACKEND.
 
 INPUT is the user input for the Xref operation, usually it is the same
@@ -1690,7 +1692,9 @@ operation was invoked.
 
 The fetcher function returns a list of xrefs, and sets
 `xref-fetcher-alist', which see."
-  (let ((method (intern (format "xref-backend-%s" kind))))
+  (let ((method (intern (format "xref-backend-%s" kind)))
+        (buffer (or buffer (current-buffer)))
+        (point (or point (point))))
     (lambda ()
       (setq xref-fetcher-alist (list (cons 'original-buffer buffer)
                                      (cons 'original-point point)