diff options
| -rw-r--r-- | etc/NEWS | 2 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 2 | ||||
| -rw-r--r-- | lisp/progmodes/project.el | 95 |
3 files changed, 57 insertions, 42 deletions
@@ -1983,6 +1983,8 @@ returns a regexp that never matches anything, which is an identity for this operation. Previously, the empty string was returned in this case. +** New variable project-read-file-name-function. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index dbd24dfa0a3..d11a5cf574d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -846,6 +846,8 @@ styles for specific categories, such as files, buffers, etc." (defvar completion-category-defaults '((buffer (styles . (basic substring))) (unicode-name (styles . (basic substring))) + ;; A new style that combines substring and pcm might be better, + ;; e.g. one that does not anchor to bos. (project-file (styles . (substring))) (info-menu (styles . (basic substring)))) "Default settings for specific completion categories. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7c8ca15868e..ddb4f3354cd 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -157,19 +157,13 @@ 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 delegates to `project-files'." - (let ((all-files (project-files project dirs))) - (lambda (string pred action) - (cond - ((eq action 'metadata) - '(metadata . ((category . project-file)))) - (t - (complete-with-action action all-files string pred)))))) +(defun project--file-completion-table (all-files) + (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))) @@ -470,55 +464,72 @@ recognized." (project-external-roots pr)))) (project-find-file-in (thing-at-point 'filename) dirs pr))) +(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 '(repeat (choice (const :tag "Read with completion from relative names" + project--read-file-cpd-relative) + (const :tag "Read with completion from absolute names" + project--read-file-absolute) + (function :tag "custom function" nil)))) + +(defun project--read-file-cpd-relative (prompt + all-files &optional predicate + hist default) + (let* ((common-parent-directory + (let ((common-prefix (try-completion "" all-files))) + (if (> (length common-prefix) 0) + (file-name-directory common-prefix)))) + (cpd-length (length common-parent-directory)) + (prompt (if (zerop cpd-length) + prompt + (concat prompt (format " in %s" common-parent-directory)))) + (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files)) + (new-collection (project--file-completion-table substrings)) + (res (project--completing-read-strict prompt + new-collection + predicate + hist default))) + (concat common-parent-directory res))) + +(defun project--read-file-absolute (prompt + all-files &optional predicate + hist default) + (project--completing-read-strict prompt + (project--file-completion-table all-files) + predicate + hist default)) + (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))) + (let* ((all-files (project-files project dirs)) + (file (funcall project-read-file-name-function + "Find file" all-files 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) + hist default) ;; 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* ((common-parent-directory - (let ((common-prefix (try-completion "" collection))) - (if (> (length common-prefix) 0) - (file-name-directory common-prefix)))) - (cpd-length (length common-parent-directory)) - (prompt (if (zerop cpd-length) - prompt - (concat prompt (format " in %s" common-parent-directory)))) - ;; XXX: This requires collection to be "flat" as well. - (substrings (mapcar (lambda (s) (substring s cpd-length)) - (all-completions "" collection))) - (new-collection - (lambda (string pred action) - (cond - ((eq action 'metadata) - (if (functionp collection) (funcall collection nil nil 'metadata))) - (t - (complete-with-action action substrings string pred))))) - (new-prompt (if default + (let* ((new-prompt (if default (format "%s (default %s): " prompt default) (format "%s: " prompt))) (res (completing-read new-prompt - new-collection predicate t + collection predicate t nil ;; initial-input - hist default inherit-input-method))) + hist default))) (when (and (equal res default) (not (test-completion res collection predicate))) (setq res (completing-read (format "%s: " prompt) - new-collection predicate t res hist nil - inherit-input-method))) - (concat common-parent-directory res))) + collection predicate t res hist nil))) + res)) (declare-function fileloop-continue "fileloop" ()) |