]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/project.el
Don't use 'find-program'
[gnu-emacs] / lisp / progmodes / project.el
index a972def24b0b1c86ad8e50d7e4a3c67a5be21312..82059c9136308e39e28aa609109ed7b6d61b3e22 100644 (file)
@@ -101,7 +101,9 @@ that it is not applicable, or a project instance.")
 (defun project-current (&optional maybe-prompt dir)
   "Return the project instance in DIR or `default-directory'.
 When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in."
+the user for a different directory to look in.  If that directory
+is not a part of a detectable project either, return a
+`transient' project instance rooted in it."
   (unless dir (setq dir default-directory))
   (let ((pr (project--find-in-directory dir)))
     (cond
@@ -110,7 +112,8 @@ the user for a different directory to look in."
       (setq dir (read-directory-name "Choose the project directory: " dir nil t)
             pr (project--find-in-directory dir))
       (unless pr
-        (user-error "No project found in `%s'" dir))))
+        (message "Using '%s' as a transient project root" dir)
+        (setq pr (cons 'transient dir)))))
     pr))
 
 (defun project--find-in-directory (dir)
@@ -154,6 +157,37 @@ end it with `/'.  DIR must be one of `project-roots' or
     vc-directory-exclusion-list)
    grep-find-ignored-files))
 
+(cl-defgeneric project-file-completion-table (project dirs)
+  "Return a completion table for files in directories DIRS in PROJECT.
+DIRS is a list of absolute directories; it should be some
+subset of the project roots and external roots.
+
+The default implementation uses `grep-find-program'.  PROJECT is used
+to find the list of ignores for each directory."
+  ;; FIXME: Uniquely abbreviate the roots?
+  (require 'xref)
+  (let ((all-files
+        (cl-mapcan
+         (lambda (dir)
+           (let ((command
+                  (format "%s %s %s -type f -print0"
+                          grep-find-program
+                          dir
+                          (xref--find-ignores-arguments
+                           (project-ignores project dir)
+                           (expand-file-name dir)))))
+             (split-string (shell-command-to-string command) "\0" t)))
+         dirs)))
+    (lambda (string pred action)
+      (cond
+       ((eq action 'metadata)
+       '(metadata . ((category . project-file))))
+       (t
+       (complete-with-action action all-files string pred))))))
+
+(cl-defmethod project-roots ((project (head transient)))
+  (list (cdr project)))
+
 (defgroup project-vc nil
   "Project implementation using the VC package."
   :version "25.1"
@@ -264,7 +298,6 @@ DIRS must contain directory names."
     (symbol-value var)))
 
 (declare-function grep-read-files "grep")
-(declare-function xref-collect-matches "xref")
 (declare-function xref--show-xrefs "xref")
 (declare-function xref-backend-identifier-at-point "xref")
 (declare-function xref--find-ignores-arguments "xref")
@@ -295,8 +328,8 @@ pattern to search for."
     (project--find-regexp-in dirs regexp pr)))
 
 (defun project--read-regexp ()
-  (read-regexp "Find regexp"
-               (xref-backend-identifier-at-point (xref-find-backend))))
+  (let ((id (xref-backend-identifier-at-point (xref-find-backend))))
+    (read-regexp "Find regexp" (and id (regexp-quote id)))))
 
 (defun project--find-regexp-in (dirs regexp project)
   (require 'grep)
@@ -314,51 +347,55 @@ pattern to search for."
 
 ;;;###autoload
 (defun project-find-file ()
-  "Visit a file in the current project's roots.
-
-This is like `find-file', but it limits the file-name completion
-candidates to the files within the current project roots."
+  "Visit a file (with completion) in the current project's roots.
+The completion default is the filename at point, if one is
+recognized."
   (interactive)
   (let* ((pr (project-current t))
          (dirs (project-roots pr)))
-    (project--find-file-in dirs pr)))
+    (project-find-file-in (thing-at-point 'filename) dirs pr)))
 
 ;;;###autoload
 (defun project-or-external-find-file ()
-  "Visit a file in the current project's roots or external roots.
-
-This is like `find-file', but it limits the file-name completion
-candidates to the files within the current project roots and external roots."
+  "Visit a file (with completion) in the current project's roots or external roots.
+The completion default is the filename at point, if one is
+recognized."
   (interactive)
   (let* ((pr (project-current t))
          (dirs (append
                 (project-roots pr)
                 (project-external-roots pr))))
-    (project--find-file-in dirs pr)))
-
-;; FIXME: Uniquely abbreviate the roots?
-(defun project--find-file-in (dirs project)
-  (require 'xref)
-  (let* ((all-files
-          (cl-mapcan
-           (lambda (dir)
-             (let ((command
-                    (format "%s %s %s -type f -print0"
-                            find-program
-                            dir
-                            (xref--find-ignores-arguments
-                             (project-ignores project dir)
-                             (expand-file-name dir)))))
-               (split-string (shell-command-to-string command) "\0" t)))
-           dirs))
-         (table (lambda (string pred action)
-                  (cond
-                   ((eq action 'metadata)
-                    '(metadata . ((category . project-file))))
-                   (t
-                    (complete-with-action action all-files string pred))))))
-    (find-file
-     (completing-read "Find file: " table nil t))))
+    (project-find-file-in (thing-at-point 'filename) dirs pr)))
+
+(defun project-find-file-in (filename dirs project)
+  "Complete FILENAME in DIRS in PROJECT and visit the result."
+  (let* ((table (project-file-completion-table project dirs))
+         (file (project--completing-read-strict
+                "Find file" table nil nil
+                filename)))
+    (if (string= file "")
+        (user-error "You didn't specify the file")
+      (find-file file))))
+
+(defun project--completing-read-strict (prompt
+                                        collection &optional predicate
+                                        hist default inherit-input-method)
+  ;; Tried both expanding the default before showing the prompt, and
+  ;; removing it when it has no matches.  Neither seems natural
+  ;; enough.  Removal is confusing; early expansion makes the prompt
+  ;; too long.
+  (let* ((new-prompt (if default
+                         (format "%s (default %s): " prompt default)
+                       (format "%s: " prompt)))
+         (res (completing-read new-prompt
+                               collection predicate t
+                               nil hist default inherit-input-method)))
+    (if (and (equal res default)
+             (not (test-completion res collection predicate)))
+        (completing-read (format "%s: " prompt)
+                         collection predicate t res hist nil
+                         inherit-input-method)
+      res)))
 
 (provide 'project)
 ;;; project.el ends here