diff options
author | Stephen Leake <stephen_leake@stephe-leake.org> | 2019-04-25 16:29:36 -0700 |
---|---|---|
committer | Stephen Leake <stephen_leake@stephe-leake.org> | 2019-04-25 16:29:36 -0700 |
commit | d2a5283a065fd03d6dc606cc7ec29822e544dffb (patch) | |
tree | 275e0ea3a813d77fd9319832b3b87d66b14ca6d4 /lisp/progmodes/project.el | |
parent | 1486eadf7c9469f873fcd04beafd03f21564d580 (diff) | |
download | emacs-scratch/project-uniquify-files.tar.gz |
Add new file completion tables, change project.el to allow using themscratch/project-uniquify-files
* lisp/file-complete-root-relative.el: New file.
* lisp/uniquify-files.el: New file.
* test/lisp/progmodes/uniquify-files-resources/: New directory
containing files for testing uniquify-files.
* test/lisp/progmodes/uniquify-files-test.el: New file; test
uniquify-files.
* lisp/files.el (path-files): New function; useful with new completion
tables.
* lisp/progmodes/project.el (project-file-completion-table): Use
file-complete-root-relative completion table.
(project-find-file): Add optional FILENAME parameter.
(project--completing-read-strict): Rewrite to just use the given
completion table; extracting the common directory is now done by
file-complete-root-relative. This also allows using the new
uniquify-files completion table.
* lisp/minibuffer.el (completion-category-defaults): Add
uniquify-file.
(completing-read-default): Add final step to call completion table
with 'alist action if supported.
Diffstat (limited to 'lisp/progmodes/project.el')
-rw-r--r-- | lisp/progmodes/project.el | 70 |
1 files changed, 26 insertions, 44 deletions
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 11a2ef40094..0b10e0935b2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -88,6 +88,7 @@ ;;; Code: (require 'cl-generic) +(require 'file-complete-root-relative) (defvar project-find-functions (list #'project-try-vc) "Special hook to find the project containing a given directory. @@ -162,14 +163,12 @@ end it with `/'. DIR must be one of `project-roots' or 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)))))) +The default implementation gets a file list from `project-files', +and uses the `file-root-rel' completion style." + (when (= 1 (length dirs)) + (let* ((all-files (project-files project dirs)) + (alist (fc-root-rel-to-alist (car dirs) all-files))) + (apply-partially #'fc-root-rel-completion-table alist)))) (cl-defmethod project-roots ((project (head transient))) (list (cdr project))) @@ -449,14 +448,14 @@ pattern to search for." (read-regexp "Find regexp" (and id (regexp-quote id))))) ;;;###autoload -(defun project-find-file () +(defun project-find-file (&optional filename) "Visit a file (with completion) in the current project's roots. -The completion default is the filename at point, if one is -recognized." +The completion default is FILENAME, or if nil, the filename at +point, if one is recognized." (interactive) (let* ((pr (project-current t)) (dirs (project-roots pr))) - (project-find-file-in (thing-at-point 'filename) dirs pr))) + (project-find-file-in (or filename (thing-at-point 'filename)) dirs pr))) ;;;###autoload (defun project-or-external-find-file () @@ -483,42 +482,25 @@ recognized." (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* ((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 - (format "%s (default %s): " prompt default) - (format "%s: " prompt))) - (res (completing-read new-prompt - new-collection predicate t - nil ;; initial-input - hist default inherit-input-method))) + (let* ((prompt (if (and default (< 0 (length default))) + (format "%s (default %s): " prompt default) + (format "%s: " prompt))) + (res (completing-read prompt + collection predicate + t ;; require-match + nil ;; initial-input + hist default inherit-input-method))) (when (and (equal res default) (not (test-completion res collection predicate))) + ;; 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. (setq res - (completing-read (format "%s: " prompt) - new-collection predicate t res hist nil + (completing-read prompt + collection predicate t res hist nil inherit-input-method))) - (concat common-parent-directory res))) + res)) (declare-function fileloop-continue "fileloop" ()) |