From 225cd6d72a1b71b5db41a1bb8e9806aab1d15291 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 29 Oct 2024 04:27:00 +0200 Subject: [PATCH] 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. (cherry picked from commit c0cb369ab188ea7ae0d3271d19c0cecce7be0329) --- lisp/progmodes/project.el | 87 +++++++++++++++++++++------------------ 1 file changed, 48 insertions(+), 39 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 10200c8e278..f87c379c203 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1148,9 +1148,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 @@ -1200,47 +1200,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)) @@ -1299,17 +1286,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 () -- 2.39.5