project--completing-read-strict: Move some common processing here

* lisp/progmodes/project.el (project--completing-read-strict):
Add new optional argument, COMMON-PARENT-DIRECTORY.  Move the
absolute->relative processing of MB-DEFAULT and the contents of
HIST here.
(project--read-file-cpd-relative): From here.  So that
'project--read-file-absolute' can also benefit from those
conversions.
(project--read-file-absolute): Pass the new argument.
(project-read-file-name-function): Update value tags.

1 files changed, 48 insertions, 39 deletions

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index aae4b708b7b..cf1c94a6d20 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1146,9 +1146,9 @@ for VCS directories listed in `vc-directory-exclusion-list'."
 (defcustom project-read-file-name-function #'project--read-file-cpd-relative
   "Function to call to read a file name from a list.
 For the arguments list, see `project--read-file-cpd-relative'."
-  :type '(choice (const :tag "Read with completion from relative names"
+  :type '(choice (const :tag "Read with completion from relative file names"
                         project--read-file-cpd-relative)
-                 (const :tag "Read with completion from absolute names"
+                 (const :tag "Read with completion from file names"
                         project--read-file-absolute)
                  (function :tag "Custom function" nil))
   :group 'project
@@ -1198,47 +1198,34 @@ by the user at will."
                           (file-name-absolute-p (car all-files)))
                      prompt
                    (concat prompt (format " in %s" common-parent-directory))))
-         (mb-default (mapcar (lambda (mb-default)
-                               (if (and common-parent-directory
-                                        mb-default
-                                        (file-name-absolute-p mb-default))
-                                   (file-relative-name
-                                    mb-default common-parent-directory)
-                                 mb-default))
-                             (if (listp mb-default) mb-default (list mb-default))))
          (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files))
          (new-collection (project--file-completion-table substrings))
-         (abs-cpd (expand-file-name common-parent-directory))
-         (abs-cpd-length (length abs-cpd))
-         (relname (cl-letf* ((non-essential t) ;Avoid new Tramp connections.
-                             ((symbol-value hist)
-                              (mapcan
-                               (lambda (s)
-                                 (setq s (expand-file-name s))
-                                 (and (string-prefix-p abs-cpd s)
-                                      (not (eq abs-cpd-length (length s)))
-                                      (list (substring s abs-cpd-length))))
-                               (symbol-value hist))))
-                    (project--completing-read-strict prompt
-                                                     new-collection
-                                                     predicate
-                                                     hist mb-default)))
+         (relname (project--completing-read-strict prompt
+                                                   new-collection
+                                                   predicate
+                                                   hist mb-default
+                                                   (unless (equal common-parent-directory "")
+                                                     common-parent-directory)))
          (absname (expand-file-name relname common-parent-directory)))
     absname))
 
 (defun project--read-file-absolute (prompt
                                     all-files &optional predicate
                                     hist mb-default)
-  (let* ((new-prompt (if (file-name-absolute-p (car all-files))
+  (let* ((names-absolute (file-name-absolute-p (car all-files)))
+         (new-prompt (if names-absolute
                          prompt
                        (concat prompt " in " default-directory)))
-         ;; FIXME: Map relative names to absolute?
+         ;; TODO: The names are intentionally not absolute in many cases.
+         ;; Probably better to rename this function.
          (ct (project--file-completion-table all-files))
          (file
           (project--completing-read-strict new-prompt
                                            ct
                                            predicate
-                                           hist mb-default)))
+                                           hist mb-default
+                                           (unless names-absolute
+                                             default-directory))))
     (unless (file-name-absolute-p file)
       (setq file (expand-file-name file)))
     file))
@@ -1297,17 +1284,39 @@ directories listed in `vc-directory-exclusion-list'."
 
 (defun project--completing-read-strict (prompt
                                         collection &optional predicate
-                                        hist mb-default)
-  (minibuffer-with-setup-hook
-      (lambda ()
-        (setq-local minibuffer-default-add-function
-                    (lambda ()
-                      (let ((minibuffer-default mb-default))
-                        (minibuffer-default-add-completions)))))
-    (completing-read (format "%s: " prompt)
-                     collection predicate 'confirm
-                     nil
-                     hist)))
+                                        hist mb-default
+                                        common-parent-directory)
+  (cl-letf* ((mb-default (mapcar (lambda (mb-default)
+                                   (if (and common-parent-directory
+                                            mb-default
+                                            (file-name-absolute-p mb-default))
+                                       (file-relative-name
+                                        mb-default common-parent-directory)
+                                     mb-default))
+                                 (if (listp mb-default) mb-default (list mb-default))))
+             (abs-cpd (expand-file-name (or common-parent-directory "")))
+             (abs-cpd-length (length abs-cpd))
+             (non-essential t)          ;Avoid new Tramp connections.
+             ((symbol-value hist)
+              (if common-parent-directory
+                  (mapcan
+                   (lambda (s)
+                     (setq s (expand-file-name s))
+                     (and (string-prefix-p abs-cpd s)
+                          (not (eq abs-cpd-length (length s)))
+                          (list (substring s abs-cpd-length))))
+                   (symbol-value hist))
+                (symbol-value hist))))
+    (minibuffer-with-setup-hook
+        (lambda ()
+          (setq-local minibuffer-default-add-function
+                      (lambda ()
+                        (let ((minibuffer-default mb-default))
+                          (minibuffer-default-add-completions)))))
+      (completing-read (format "%s: " prompt)
+                       collection predicate 'confirm
+                       nil
+                       hist))))
 
 ;;;###autoload
 (defun project-find-dir ()