[elpa] externals/urgrep 31fe7d5e5c 022/115: Cache the default tool per-host and allow users to override the tool preferences

[ELPA Syncer]

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

    Cache the default tool per-host and allow users to override the tool 
preferences
---
 urgrep-tests.el | 34 ++++++++++++++++++++++++++++
 urgrep.el       | 69 +++++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 84 insertions(+), 19 deletions(-)

diff --git a/urgrep-tests.el b/urgrep-tests.el
index 55472139df..6184f9743a 100644
--- a/urgrep-tests.el
+++ b/urgrep-tests.el
@@ -25,6 +25,8 @@
 ;;; Code:
 
 (require 'ert)
+(unless (fboundp 'always)
+  (defun always (&rest _) t))
 
 (ert-deftest urgrep-tests-command-ripgrep ()
   (let ((tool (assoc "ripgrep" urgrep-tools))
@@ -108,6 +110,38 @@
     (should (string-match "^find \\."
                           (urgrep-command "foo" :tool tool :context 3)))))
 
+(ert-deftest urgrep-tests-get-tool-default ()
+  (cl-letf (((symbol-function #'executable-find) #'always))
+    (let* ((urgrep--host-defaults '())
+           (tool (urgrep-get-tool)))
+      (should (equal (car tool) "ripgrep"))
+      (should (equal (urgrep-get-property tool 'executable-name) "rg"))
+      (should (equal urgrep--host-defaults '((localhost . "ripgrep")))))))
+
+(ert-deftest urgrep-tests-get-tool-default-cached ()
+  (cl-letf (((symbol-function #'executable-find) #'always))
+    (let* ((urgrep--host-defaults '((localhost . "ag")))
+           (tool (urgrep-get-tool)))
+      (should (equal (car tool) "ag"))
+      (should (equal (urgrep-get-property tool 'executable-name) "ag"))
+      (should (equal urgrep--host-defaults '((localhost . "ag")))))))
+
+(ert-deftest urgrep-tests-get-tool-string ()
+  (cl-letf (((symbol-function #'executable-find) #'always))
+    (let* ((urgrep--host-defaults '())
+           (tool (urgrep-get-tool "ag")))
+      (should (equal (car tool) "ag"))
+      (should (equal (urgrep-get-property tool 'executable-name) "ag"))
+      (should (equal urgrep--host-defaults '())))))
+
+(ert-deftest urgrep-tests-get-tool-cons ()
+  (cl-letf (((symbol-function #'executable-find) #'always))
+    (let* ((urgrep--host-defaults '())
+           (tool (urgrep-get-tool '("goofy" (executable-name "gf")))))
+      (should (equal (car tool) "goofy"))
+      (should (equal (urgrep-get-property tool 'executable-name) "gf"))
+      (should (equal urgrep--host-defaults '())))))
+
 (defun urgrep-tests--check-match-at-point ()
   (let* ((line (string-to-number (current-word)))
          (loc
diff --git a/urgrep.el b/urgrep.el
index 78965ec16f..e08ccd94fb 100644
--- a/urgrep.el
+++ b/urgrep.el
@@ -138,32 +138,63 @@
      (command-function ,#'urgrep-rgrep--command)))
   "An alist of known tools to try when running urgrep.")
 
+(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)
+
+(defvar urgrep--host-defaults '()
+  "Default urgrep values for each known host.
+This is an alist of host symbols (`localhost' or a TRAMP host) and
+the default tool to use on that host.")
+
 (defun urgrep-get-property (tool prop)
-  "Get a given property PROP from TOOL, or nil if PROP is undefined."
+  "Get the property PROP from TOOL, or nil if PROP is undefined."
   (when-let ((prop-entry (assoc prop (cdr tool))))
     (cadr prop-entry)))
 
 (defun urgrep-get-property-pcase (tool prop value)
-  "Get a given property PROP from TOOL and use it as a `pcase' macro for 
VALUE."
+  "Get the property PROP from TOOL and use it as a `pcase' macro for VALUE."
   (when-let ((cases (urgrep-get-property tool prop))
              (block (append `(,#'pcase ',value) cases)))
     (eval block t)))
 
-(defun urgrep-get-tool ()
-  "Get the preferred urgrep tool from `urgrep-tools'."
-  (let ((vc-backend-name))
-    (cl-dolist (tool urgrep-tools)
-      (let ((tool-executable (urgrep-get-property tool 'executable-name))
-            (tool-vc-backend (urgrep-get-property 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))))
-        (when (and (executable-find tool-executable t)
-                   (or (not tool-vc-backend)
-                       (string= vc-backend-name tool-vc-backend)))
-          (cl-return 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)))
+      (assoc cached-tool-name urgrep-tools)
+    (let ((vc-backend-name))
+      (cl-dolist (tool (or urgrep-preferred-tools urgrep-tools))
+        (let* ((tool (if (stringp tool) (assoc tool urgrep-tools) tool))
+               (tool-executable (urgrep-get-property tool 'executable-name))
+               (tool-vc-backend (urgrep-get-property 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)))
+            (add-to-list 'urgrep--host-defaults (cons host-id (car tool)))
+            (cl-return tool)))))))
+
+(defun urgrep-get-tool (&optional tool)
+  "Get the urgrep tool for TOOL.
+If TOOL is nil, get the default tool. If TOOL is a string, look it
+up in `urgrep-tools'. Otherwise, return TOOL as-is."
+  (pcase tool
+    ('nil (urgrep--get-default-tool))
+    ((and (pred stringp) tool) (assoc tool urgrep-tools))
+    (tool tool)))
 
 (defun urgrep--maybe-shell-quote-argument (argument)
   "Quote ARGUMENT if needed for passing to an inferior shell.
@@ -185,7 +216,7 @@ for MS shells."
           (t (car tool-syntaxes)))))
 
 (defun urgrep--convert-regexp (expr from-syntax to-syntax)
-  "Convert the regexp EXP from FROM-SYNTAX to TO-SYNTAX."
+  "Convert the regexp EXPR from FROM-SYNTAX to TO-SYNTAX."
   (cond ((and (not (eq from-syntax to-syntax))
               (or (eq from-syntax 'bre) (eq to-syntax 'bre)))
          ;; XXX: This is a bit of a hack, but xref.el contains an internal
@@ -197,7 +228,7 @@ for MS shells."
 
 (cl-defun urgrep-command (query &rest rest &key tool (group t) regexp-syntax
                                 (context 0))
-  (if-let ((tool (or tool (urgrep-get-tool)))
+  (if-let ((tool (urgrep-get-tool tool))
            (cmd-fun (urgrep-get-property tool 'command-function)))
       (apply cmd-fun query rest)
     (let* ((tool-re-syntax (urgrep--get-best-syntax regexp-syntax tool))