[elpa] externals/urgrep 3002fdf731 054/115: Add support for specifying executable path in 'urgrep-preferred-tools'

[ELPA Syncer]

branch: externals/urgrep
commit 3002fdf7314faa20e5eb6aa342c6fa9239f24e9a
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    Add support for specifying executable path in 'urgrep-preferred-tools'
---
 README.md       |  9 +++++-
 urgrep-tests.el | 19 +++++++++---
 urgrep.el       | 92 +++++++++++++++++++++++++++++++++++++--------------------
 3 files changed, 83 insertions(+), 37 deletions(-)

diff --git a/README.md b/README.md
index 2c0b159b28..07827482fd 100644
--- a/README.md
+++ b/README.md
@@ -58,6 +58,13 @@ setting `urgrep-preferred-tools`:
 (setq urgrep-preferred-tools '(git-grep grep))
 ```
 
+If a tool is installed in an unusual place on your system, you can specify this
+by providing a cons cell as an element in `urgrep-preferred-tools':
+
+```elisp
+(setq urgrep-preferred-tools '((ag . "/home/coco/bin/ag")))
+```
+
 This also works with connection-local variables:
 
 ```elisp
@@ -65,7 +72,7 @@ This also works with connection-local variables:
  '((urgrep-preferred-tools . (ripgrep))))
 
 (connection-local-set-profiles
- '(:application tramp :machine "coco") 'urgrep-ripgrep)
+ '(:application tramp :machine "imagewriter") 'urgrep-ripgrep)
 ```
 
 ## Programmatic interface
diff --git a/urgrep-tests.el b/urgrep-tests.el
index dd8e94b634..5d04e4e90a 100644
--- a/urgrep-tests.el
+++ b/urgrep-tests.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'ert)
+
 (unless (fboundp 'always)
   (defun always (&rest _) t))
 
@@ -384,15 +385,16 @@
            (tool (urgrep-get-tool)))
       (should (equal (car tool) 'ripgrep))
       (should (equal (urgrep--get-prop 'executable-name tool) "rg"))
-      (should (equal urgrep--host-defaults '((localhost . ripgrep)))))))
+      (should (equal urgrep--host-defaults `((localhost . ,tool)))))))
 
 (ert-deftest urgrep-tests-get-tool-default-cached ()
   (cl-letf (((symbol-function #'executable-find) #'always))
-    (let* ((urgrep--host-defaults '((localhost . ag)))
+    (let* ((ag (assq 'ag urgrep-tools))
+           (urgrep--host-defaults `((localhost . ,ag)))
            (tool (urgrep-get-tool)))
       (should (equal (car tool) 'ag))
       (should (equal (urgrep--get-prop 'executable-name tool) "ag"))
-      (should (equal urgrep--host-defaults '((localhost . ag)))))))
+      (should (equal urgrep--host-defaults `((localhost . ,ag)))))))
 
 (ert-deftest urgrep-tests-get-tool-preferred ()
   (cl-letf (((symbol-function #'executable-find) #'always))
@@ -401,7 +403,16 @@
            (tool (urgrep-get-tool)))
       (should (equal (car tool) 'ag))
       (should (equal (urgrep--get-prop 'executable-name tool) "ag"))
-      (should (equal urgrep--host-defaults '((localhost . ag)))))))
+      (should (equal urgrep--host-defaults `((localhost . ,tool)))))))
+
+(ert-deftest urgrep-tests-get-tool-preferred-cons ()
+  (cl-letf (((symbol-function #'executable-find) #'always))
+    (let* ((urgrep--host-defaults)
+           (urgrep-preferred-tools '((ag . "/usr/bin/ag")))
+           (tool (urgrep-get-tool)))
+      (should (equal (car tool) 'ag))
+      (should (equal (urgrep--get-prop 'executable-name tool) "/usr/bin/ag"))
+      (should (equal urgrep--host-defaults `((localhost . ,tool)))))))
 
 (ert-deftest urgrep-tests-get-tool-key ()
   (cl-letf (((symbol-function #'executable-find) #'always))
diff --git a/urgrep.el b/urgrep.el
index 36b6ec8d04..75974f1a4e 100644
--- a/urgrep.el
+++ b/urgrep.el
@@ -31,6 +31,7 @@
 
 (require 'cl-lib)
 (require 'compile)
+(require 'generator)
 (require 'grep)
 (require 'project)
 (require 'text-property-search)
@@ -288,12 +289,19 @@ See also `grep-process-setup'."
 (defcustom urgrep-preferred-tools nil
   "List of urgrep tools to search for.
 This can be nil to use the default list of tools in `urgrep-tools'
-or a list of tool names to try in descending order of preference."
-  :type `(choice (const :tag "Default" nil)
-                 (repeat :tag "List of tools"
-                         (choice . ,(mapcar (lambda (i) (list 'const (car i)))
-                                            urgrep-tools))))
-  :group 'urgrep)
+or a list of tools to try in descending order of preference.  Each tool
+can be either a symbol naming the tool or a cons cell of the tool name
+and the path of the executable."
+  :type `(choice
+          (const :tag "Default" nil)
+          (repeat :tag "List of tools"
+                  ,(let* ((tool-names (mapcar (lambda (i) `(const ,(car i)))
+                                              urgrep-tools))
+                          (tool-choice `(choice :tag "Tool" . ,tool-names)))
+                     (append tool-choice
+                             `((cons :tag "(tool . path)"
+                                     ,tool-choice (string :tag "Path")))))))
+    :group 'urgrep)
 
 (defvar urgrep--host-defaults nil
   "Default urgrep values for each known host.
@@ -310,36 +318,54 @@ the default tool to use on that host.")
              (block (append `(,#'pcase ',value) cases)))
     (eval block t)))
 
+(iter-defun urgrep--iter-tools ()
+  "Iterate over all the grep-like tools.
+If `urgrep-preferred-tools' is non-nil, iterate over them, yielding
+each tool, possibly modified with the executable path defined in
+`urgrep-preferred-tools.'  Otherwise, iterate over `urgrep-tools'."
+  (if urgrep-preferred-tools
+      (dolist (pref urgrep-preferred-tools)
+        (pcase-let* ((`(,name . ,path) (if (consp pref) pref (cons pref nil)))
+                     (tool (assq name urgrep-tools))
+                     (tool (if path
+                               `(,(car tool) .
+                                 ((executable-name . ,path) . ,(cdr tool)))
+                             tool)))
+          (iter-yield tool)))
+    (dolist (tool urgrep-tools)
+      (iter-yield tool))))
+
 (defun urgrep--get-default-tool ()
   "Get the preferred urgrep tool from `urgrep-tools'.
 This caches the default tool per-host in `urgrep--host-defaults'."
   (if-let ((host-id (intern (or (file-remote-p default-directory) 
"localhost")))
-           (cached-tool-name (alist-get host-id urgrep--host-defaults)))
-      (assq cached-tool-name urgrep-tools)
+           (cached-tool (alist-get host-id urgrep--host-defaults)))
+      cached-tool
     (let ((vc-backend-name)
           (saw-vc-tool-p nil))
-      (cl-dolist (tool (or urgrep-preferred-tools urgrep-tools))
-        (let* ((tool (if (symbolp tool) (assq tool urgrep-tools) tool))
-               (tool-executable (urgrep--get-prop 'executable-name tool))
-               (tool-vc-backend (urgrep--get-prop 'vc-backend tool)))
-          (setq saw-vc-tool-p (or saw-vc-tool-p tool-vc-backend))
-          ;; Cache the VC backend name if we need it.
-          (when-let (((and tool-vc-backend (not vc-backend-name)))
-                     (proj (project-current)))
-            (setq vc-backend-name (vc-responsible-backend (project-root 
proj))))
-          ;; If we find the executable (and it's for the right VC backend, if
-          ;; relevant), cache it and then return it.
-          (when (and (executable-find tool-executable t)
-                     (or (not tool-vc-backend)
-                         (string= vc-backend-name tool-vc-backend)))
-            ;; So long as we didn't examine a VC-specific tool, we can cache
-            ;; this result for future calls, since the result will always be 
the
-            ;; same.  If we *did* see a VC-specific tool, this host will use
-            ;; different tools for different directories, so we can't cache
-            ;; anything.
-            (unless saw-vc-tool-p
-              (add-to-list 'urgrep--host-defaults (cons host-id (car tool))))
-            (cl-return tool)))))))
+      (cl-loop for tool iter-by (urgrep--iter-tools) do
+               (let ((tool-executable (urgrep--get-prop 'executable-name tool))
+                     (tool-vc-backend (urgrep--get-prop 'vc-backend tool)))
+                 (setq saw-vc-tool-p (or saw-vc-tool-p tool-vc-backend))
+                 ;; Cache the VC backend name if we need it.
+                 (when-let (((and tool-vc-backend (not vc-backend-name)))
+                            (proj (project-current)))
+                   (setq vc-backend-name (vc-responsible-backend
+                                          (project-root proj))))
+                 ;; If we find the executable (and it's for the right VC
+                 ;; backend, if relevant), cache it and then return it.
+                 (when (and (executable-find tool-executable t)
+                            (or (not tool-vc-backend)
+                                (string= vc-backend-name tool-vc-backend)))
+                   ;; So long as we didn't examine a VC-specific tool, we can
+                   ;; cache this result for future calls, since the result will
+                   ;; always be the same.  If we *did* see a VC-specific tool,
+                   ;; this host will use different tools for different
+                   ;; directories, so we can't cache anything.
+                   (unless saw-vc-tool-p
+                     (add-to-list 'urgrep--host-defaults
+                                  (cons host-id tool)))
+                   (cl-return tool)))))))
 
 (defun urgrep-get-tool (&optional tool)
   "Get the urgrep tool for TOOL.
@@ -558,9 +584,11 @@ If EDIT-COMMAND is non-nil, the search can be edited."
 
 (defvar urgrep--column-end-adjustment
   (if (< emacs-major-version 28) 0 1)
-  "In Emacs 28+, the column range for matches is closed, but in previous
+  "Handle core Emacs changes to the column range for `compile-mode' matches.
+In Emacs 28+, the column range for matches is closed, but in previous
 versions, it's half-open.  Use this to adjust the value as needed in
-`urgrep--column-end'.")
+`urgrep--column-end'.  For more details on the change, see
+<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49624>.")
 
 (defun urgrep--column-begin ()
   "Look forwards for the match highlight to compute the beginning column."