[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 9aad8f1 1/5: In uniquify-files, factor out file-complete.e
|
From: |
Stephen Leake |
|
Subject: |
[elpa] master 9aad8f1 1/5: In uniquify-files, factor out file-complete.el |
|
Date: |
Thu, 11 Jul 2019 21:11:10 -0400 (EDT) |
branch: master
commit 9aad8f126de50c0331ca24149c824a80698b1b5a
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
In uniquify-files, factor out file-complete.el
* packages/path-iterator/path-iterator-resources/alice-1/bar-file1.text:
New file.
* packages/path-iterator/path-iterator-test.el: Add trailing "/" where
needed; anything that is known to be a directory ends in "/".
* packages/uniquify-files/file-complete-root-relative-test.el:
(test-fc-root-rel-test-completion-1): Update to use
completion-current-style.
* packages/uniquify-files/file-complete.el: New file, factored out from
uniquify-file.el, file-complete-root-relative.el.
* packages/path-iterator/path-iterator.el: Add trailing "/" where needed;
anything that is known to be a directory ends in "/".
(path-iter--to-truename): Handle users passing a single string.
* packages/uniquify-files/file-complete-root-relative.el: Use
file-complete functions. Use completion-current-style.
(fc-root-rel-completion-table-iter): Call file-complete-completion-table.
(fc-root-rel--pcm-regex-list): Rename from fc-root-rel--pcm-pattern-list.
(fc-root-rel-completion-table-list): Implement test-completion. Use
test-completion, try-completion.
* packages/uniquify-files/uniquify-files-test.el (uft-iter): Add Alice,
Bob directories.
(test-uniq-file-completion-table): Delete; tested in
file-complete-test.el.
(test-uniq-file-all-completions-noface-1): Add a test.
(test-uniq-file-try-completion-1): Update tests.
* packages/uniquify-files/uniquify-files.el: Use file-complete.
(uniq-file--pcm-pat): New, factored out of uniq-file--pcm-merged-pat.
(uniq-file--pcm-pattern): Delete; use file-complete-pcm-regex.
(uniq-file-completion-table): Use file-complete-completion-table.
---
.../path-iterator-resources/alice-1/bar-file1.text | 1 +
packages/path-iterator/path-iterator-test.el | 83 +++---
packages/path-iterator/path-iterator.el | 14 +-
.../file-complete-root-relative-test.el | 83 +-----
.../uniquify-files/file-complete-root-relative.el | 293 +++++++--------------
packages/uniquify-files/file-complete.el | 192 ++++++++++++++
packages/uniquify-files/uniquify-files-test.el | 163 ++----------
packages/uniquify-files/uniquify-files.el | 183 ++-----------
8 files changed, 408 insertions(+), 604 deletions(-)
diff --git
a/packages/path-iterator/path-iterator-resources/alice-1/bar-file1.text
b/packages/path-iterator/path-iterator-resources/alice-1/bar-file1.text
new file mode 100644
index 0000000..fa6dc6c
--- /dev/null
+++ b/packages/path-iterator/path-iterator-resources/alice-1/bar-file1.text
@@ -0,0 +1 @@
+Alice/alice-1/bar-file1.text
diff --git a/packages/path-iterator/path-iterator-test.el
b/packages/path-iterator/path-iterator-test.el
index 4986842..cf50461 100644
--- a/packages/path-iterator/path-iterator-test.el
+++ b/packages/path-iterator/path-iterator-test.el
@@ -23,7 +23,7 @@
(defconst path-iter-root-dir
(concat
(file-name-directory (or load-file-name (buffer-file-name)))
- "path-iterator-resources"))
+ "path-iterator-resources/"))
(defmacro path-iter-deftest (name-suffix path-non-recursive path-recursive
expected-dirs &optional ignore-function)
"Define an ert test for path-iterator.
@@ -60,49 +60,49 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
(list path-iter-root-dir)
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
- (concat path-iter-root-dir "/bob-1/bob-3")
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
))
(path-iter-deftest non-recursive
(list
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
- (concat path-iter-root-dir "/bob-1/bob-3")
- (concat path-iter-root-dir "/bob-1/bob-4") ;; does not exist
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
+ (concat path-iter-root-dir "bob-1/bob-4/") ;; does not exist
)
nil ;; recursive
(list
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
- (concat path-iter-root-dir "/bob-1/bob-3")
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
))
(path-iter-deftest both
(list
- (concat path-iter-root-dir "/alice-1"))
+ (concat path-iter-root-dir "alice-1/"))
(list
- (concat path-iter-root-dir "/bob-1"))
+ (concat path-iter-root-dir "bob-1/"))
(list
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
- (concat path-iter-root-dir "/bob-1/bob-3")
- (concat path-iter-root-dir "/alice-1")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
+ (concat path-iter-root-dir "alice-1/")
))
(path-iter-deftest dup
(list
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1")) ;; non-recursive
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/")) ;; non-recursive
(list
- (concat path-iter-root-dir "/bob-1")) ;; recursive
+ (concat path-iter-root-dir "bob-1/")) ;; recursive
(list
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
- (concat path-iter-root-dir "/bob-1/bob-3")
- (concat path-iter-root-dir "/alice-1")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
+ (concat path-iter-root-dir "alice-1/")
))
(defvar path-iter-ignore-bob nil
@@ -123,9 +123,9 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
iter
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-3")
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
))
(setq path-iter-ignore-bob "bob-3")
@@ -135,9 +135,9 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
iter
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-3")
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-3/")
))
(path-iter-reset iter);; recomputes path
@@ -145,9 +145,9 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
iter
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")
- (concat path-iter-root-dir "/bob-1")
- (concat path-iter-root-dir "/bob-1/bob-2")
+ (concat path-iter-root-dir "alice-1/")
+ (concat path-iter-root-dir "bob-1/")
+ (concat path-iter-root-dir "bob-1/bob-2/")
))
))
@@ -163,7 +163,7 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
iter
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")
+ (concat path-iter-root-dir "alice-1/")
))
))
@@ -174,10 +174,10 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
(path-iter--to-truename
(list
nil
- (concat path-iter-root-dir "/alice-1")))
+ (concat path-iter-root-dir "alice-1/")))
(list
path-iter-root-dir
- (concat path-iter-root-dir "/alice-1")))
+ (concat path-iter-root-dir "alice-1/")))
)))
@@ -191,10 +191,11 @@ iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE,
IGNORE-FUNCTION."
(equal
(path-iter-all-files iter)
(list
- (concat path-iter-root-dir "/bob-1/bob-3/foo-file3.text")
- (concat path-iter-root-dir "/bob-1/bob-2/foo-file2.text")
- (concat path-iter-root-dir "/alice-1/foo-file1.text")
- (concat path-iter-root-dir "/file-0.text")
+ (concat path-iter-root-dir "bob-1/bob-3/foo-file3.text")
+ (concat path-iter-root-dir "bob-1/bob-2/foo-file2.text")
+ (concat path-iter-root-dir "alice-1/foo-file1.text")
+ (concat path-iter-root-dir "alice-1/bar-file1.text")
+ (concat path-iter-root-dir "file-0.text")
)))
))
diff --git a/packages/path-iterator/path-iterator.el
b/packages/path-iterator/path-iterator.el
index 5598e57..c4b550a 100644
--- a/packages/path-iterator/path-iterator.el
+++ b/packages/path-iterator/path-iterator.el
@@ -121,6 +121,10 @@ relative to `default-directory'.
If an element of PATH is nil, `default-directory' is used."
;; The nil handling is as defined by the `load-path' doc string.
+ (unless (listp path)
+ ;; Users often specify a single root directory, and forget it's
+ ;; supposed to be a list.
+ (setq path (list path)))
(let (result)
(cl-mapc
(lambda (name)
@@ -128,7 +132,7 @@ If an element of PATH is nil, `default-directory' is used."
(expand-file-name name)
default-directory)))
(when (file-directory-p absname)
- (push (directory-file-name (file-truename absname)) result))
+ (push (file-name-as-directory (file-truename absname)) result))
))
path)
(nreverse result)))
@@ -150,9 +154,9 @@ name. Symlinks in the directory part are resolved, but the
nondirectory part is the link name if it is a symlink.
The directories returned by `path-iter-next' are absolute
-directory file truenames; they contain forward slashes, do
-not end in a slash, have casing that matches the existing
-directory file name, and resolve simlinks (see `file-truename')."
+directory file truenames; they contain forward slashes, end in a
+slash, have casing that matches the existing directory file name,
+and resolve simlinks (see `file-truename')."
(cond
((and (listp (path-iter-visited iter))
(not (null (path-iter-path-recursive iter))))
@@ -178,7 +182,7 @@ directory file name, and resolve simlinks (see
`file-truename')."
;; `ignore-function' wants the link name.
(and (path-iter-ignore-function iter)
(funcall (path-iter-ignore-function iter) absname)))
- (push (file-truename absname) subdirs))
+ (push (file-name-as-directory (file-truename absname)) subdirs))
)
(directory-files result t))
diff --git a/packages/uniquify-files/file-complete-root-relative-test.el
b/packages/uniquify-files/file-complete-root-relative-test.el
index ddf863e..8b44d92 100644
--- a/packages/uniquify-files/file-complete-root-relative-test.el
+++ b/packages/uniquify-files/file-complete-root-relative-test.el
@@ -48,66 +48,13 @@
))
(ert-deftest test-fc-root-rel-completion-table-iter ()
- "Test basic functions of table."
- ;; grouped by action
- (should (equal (fc-root-rel-completion-table-iter fc-root-rel-iter "fi" nil
'(boundaries . ".text"))
- '(boundaries . (0 . 5))))
-
+ "Test added functions of table."
(should (equal (fc-root-rel-completion-table-iter fc-root-rel-iter "fi" nil
'metadata)
(cons 'metadata
(list
'(category . project-file)
'(styles . (file-root-rel))
- (cons 'root uft-root)))))
-
- ;; all-completions. We sort the results here to make the test stable
- (should (equal (sort (fc-root-rel-completion-table-iter fc-root-rel-iter ""
nil t) #'string-lessp)
- (list
- (concat uft-alice1 "/bar-file1.text")
- (concat uft-alice1 "/bar-file2.text")
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- (concat uft-alice2 "/bar-file1.text")
- (concat uft-alice2 "/bar-file2.text")
- (concat uft-alice2 "/foo-file1.text")
- (concat uft-alice2 "/foo-file3.text")
- (concat uft-alice2 "/foo-file3.texts")
- (concat uft-Alice-alice3 "/foo-file4.text")
- (concat uft-Bob-alice3 "/foo-file4.text")
- (concat uft-bob1 "/foo-file1.text")
- (concat uft-bob1 "/foo-file2.text")
- (concat uft-bob2 "/foo-file1.text")
- (concat uft-bob2 "/foo-file5.text")
- (concat uft-root "/foo-file1.text")
- (concat uft-root "/foo-file3.texts2")
- )))
-
- (should (equal (sort (fc-root-rel-completion-table-iter fc-root-rel-iter
"a-1/f-fi" nil t) #'string-lessp)
- (list
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- )))
-
- (should (equal (fc-root-rel-completion-table-iter fc-root-rel-iter
"file1.text<uft-alice1/>" nil t)
- ;; some caller did not deuniquify; treated as misspelled; no
match
- nil))
-
-
- ;; This table does not implement try-completion
- (should (equal (fc-root-rel-completion-table-iter fc-root-rel-iter "fi" nil
nil)
- nil))
-
- ;; test-completion
- (should (equal (fc-root-rel-completion-table-iter
- fc-root-rel-iter
- (fc-root-rel-to-table-input "alice-1/foo-file1.text") nil
'lambda)
- nil)) ;; not at root
-
- (should (equal (fc-root-rel-completion-table-iter
- fc-root-rel-iter
- (fc-root-rel-to-table-input "Alice/alice-1/foo-file1.text")
nil 'lambda)
- t)) ;; at root
-
+ (cons 'root (file-name-as-directory uft-root))))))
)
(ert-deftest test-fc-root-rel-completion-table-list ()
@@ -175,35 +122,33 @@
(defun test-fc-root-rel-test-completion-1 (table)
;; In normal operation, 'all-completions' is called before
- ;; test-completion, and it sets the 'completion-style text property.
- (cl-flet ((ss (str)
- (put-text-property 0 1 'completion-style 'file-root-rel str)
- str))
- (should (equal (test-completion (ss "foo-fi") table)
+ ;; test-completion, and it sets completion-current-style.
+ (let ((completion-current-style 'file-root-rel))
+ (should (equal (test-completion "foo-fi" table)
nil))
- (should (equal (test-completion (ss "dir/f-fi") table)
+ (should (equal (test-completion "dir/f-fi" table)
nil))
- (should (equal (test-completion (ss "foo-file1.text") table)
+ (should (equal (test-completion "foo-file1.text" table)
t)) ;; starts at root
- (should (equal (test-completion (ss "alice-1/foo-file1.text") table)
+ (should (equal (test-completion "alice-1/foo-file1.text" table)
nil)) ;; does not start at root
- (should (equal (test-completion (ss "Alice/alice-1/foo-file1.text") table)
+ (should (equal (test-completion "Alice/alice-1/foo-file1.text" table)
t)) ;; starts at root
- (should (equal (test-completion (ss "foo-file3.text") table)
+ (should (equal (test-completion "foo-file3.text" table)
nil))
- (should (equal (test-completion (ss "foo-file3.texts2") table)
+ (should (equal (test-completion "foo-file3.texts2" table)
t))
- (should (equal (test-completion (ss "Alice/alice-/bar-file2.text") table)
+ (should (equal (test-completion "Alice/alice-/bar-file2.text" table)
nil))
- (should (equal (test-completion (ss "Alice/alice-1/bar-file2.text") table)
+ (should (equal (test-completion "Alice/alice-1/bar-file2.text" table)
t))
))
@@ -322,7 +267,5 @@
(completion-ignore-case nil))
(test-fc-root-rel-all-completions-noface-1 table)))
-;; FIXME: more tests
-
(provide 'file-complete-root-relative-test)
;;; file-complete-root-relative-test.el ends here
diff --git a/packages/uniquify-files/file-complete-root-relative.el
b/packages/uniquify-files/file-complete-root-relative.el
index 1724ecc..14d1b1f 100644
--- a/packages/uniquify-files/file-complete-root-relative.el
+++ b/packages/uniquify-files/file-complete-root-relative.el
@@ -44,13 +44,13 @@
(require 'cl-lib)
-(require 'uniquify-files);; FIXME: we share many low-level functions; factor
them out.
+(require 'file-complete)
(defun fc-root-rel--root (table)
"Return root from TABLE."
(cdr (assoc 'root (completion-metadata "" table nil))))
-(defun fc-root-rel-to-table-input (user-string &optional _table _pred _point)
+(defun fc-root-rel-to-table-input (user-string _table _pred)
"Implement `completion-to-table-input' for file-root-rel."
user-string)
@@ -62,8 +62,8 @@
(defun fc-root-rel-to-user (data-string-list root)
"Convert DATA-STRING-LIST to list of user format strings."
- ;; Assume they all start with ROOT
- (let ((prefix-length (1+ (length root)))) ;; don't include leading '/'
+ ;; Assume they all start with ROOT, which ends in /
+ (let ((prefix-length (length root)))
(mapcar
(lambda (abs-file-name)
(substring abs-file-name prefix-length))
@@ -83,11 +83,13 @@ Pattern is in reverse order."
(defun fc-root-rel-try-completion (string table pred point)
"Implement `completion-try-completion' for file-root-rel."
- ;; Returns list of user format strings (uniquified file names), nil, or t.
+ ;; Returns list of user format strings, nil, or t.
(let (result
rel-all
done)
+ (setq completion-current-style 'file-root-rel)
+
;; Compute result, set done.
(cond
((functionp table)
@@ -182,92 +184,21 @@ character after each completion field."
all)))
(defun fc-root-rel-all-completions (user-string table pred point)
- "Implement `completion-all-completions' for uniquify-file."
+ "Implement `completion-all-completions' for root-relative."
;; Returns list of data format strings (abs file names).
- (let* ((table-string (fc-root-rel-to-table-input user-string))
+ (setq completion-current-style 'file-root-rel)
+
+ ;; Note that we never get here with TABLE a list of filenames.
+ (let* ((table-string (fc-root-rel-to-table-input user-string table pred))
(all (funcall table table-string pred t)))
(when all
(setq all (fc-root-rel-to-user all (fc-root-rel--root table)))
- (fc-root-rel--hilit user-string all point)
- (uniq-file--set-style all 'file-root-rel)
+ (setq all (fc-root-rel--hilit user-string all point))
+ all
)))
-(defun fc-root-rel--valid-completion (string all root)
- "Return non-nil if STRING is a valid completion in ALL,
-else return nil. ALL should be the result of `all-completions'.
-STRING should be in completion table input format."
- (let* ((abs-string (concat root "/" string))
- (matched nil)
- name)
-
- (while (and all
- (not matched))
- (setq name (pop all))
- (when (string-equal abs-string name)
- (setq matched t)))
-
- matched))
-
-(defun fc-root-rel--pcm-pattern-iter (string root)
- "Return pcm regexes constructed from STRING (a table format string)."
- ;; In file-name-all-completions, `completion-regexp-list', is
- ;; matched against file names and directories relative to `dir'.
- ;; Thus to handle partial completion delimiters in `string', we
- ;; construct two regexps from `string'; one from the directory
- ;; portion, and one from the non-directory portion.
- (let ((file-name (file-name-nondirectory string))
- (dir-name (directory-file-name (or (file-name-directory string) "")))
- dir-length)
-
- (setq dir-length (length dir-name))
-
- (when (and (< 0 (length file-name))
- (= ?* (aref file-name 0)))
- (setq dir-name (concat dir-name "*")))
-
- ;; `completion-pcm--string->pattern' assumes its argument is
- ;; anchored at the beginning but not the end; that is true
- ;; for `dir-name' once we prepend ROOT. file-name must match
- ;; a directory in "root/dir-name".
- (let* ((dir-pattern (completion-pcm--string->pattern dir-name))
- (file-pattern (completion-pcm--string->pattern string))
- (dir-regex
- (cond
- ((= 0 (length dir-name))
- (if (= 0 (length file-name))
- root
- (concat root
- "\\(\\'\\|/"
- (substring (completion-pcm--pattern->regex
file-pattern) 2) ;; strip \`
- "\\)")))
-
- ((string-equal "*" dir-name)
- (if (or (= 0 dir-length)
- (= 0 (length file-name)))
- (concat root "/?")
-
- ;; else STRING contains an explicit "/"
- (concat root "/")))
-
- (t
- (concat root
- "/"
- (substring (completion-pcm--pattern->regex dir-pattern) 2)
- "\\("
- (substring (completion-pcm--pattern->regex file-pattern)
2)
- "\\)?"))
- ))
-
- ;; file-regex is matched against an absolute file name
- (file-regex
- (concat root
- (if (eq 'star (nth 0 file-pattern)) "/?" "/")
- (substring (completion-pcm--pattern->regex file-pattern)
2)))
- )
- (list dir-regex file-regex))))
-
(defun fc-root-rel-completion-table-iter (path-iter string pred action)
"Implement a completion table for file names in PATH-ITER.
@@ -276,76 +207,24 @@ recursive root, and no non-recursive roots.
STRING, PRED, ACTION are completion table arguments."
- ;; This completion table function combines iterating on files in
- ;; PATH-ITER with filtering on USER-STRING and PRED. This is an
- ;; optimization that minimizes storage use when USER-STRING is not
- ;; empty and PRED is non-nil.
-
- (cond
- ((eq (car-safe action) 'boundaries)
- ;; We don't use boundaries; return the default definition.
- (cons 'boundaries
- (cons 0 (length (cdr action)))))
-
- ((eq action 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- '(styles . (file-root-rel))
- (cons 'root (car (path-iter-path-recursive-init path-iter))))))
-
- ((null action)
- ;; Called from `try-completion'; should never get here (see
- ;; `fc-root-rel-try-completion').
- nil)
-
- ((memq action
- '(lambda ;; Called from `test-completion'
- t)) ;; Called from all-completions
-
- ;; In file-name-all-completions, `completion-regexp-list', is
- ;; matched against file names and directories relative to `dir',
- ;; which is useless for this table.
-
- (pcase-let ((`(,dir-regex ,file-regex)
- (fc-root-rel--pcm-pattern-iter string (car
(path-iter-path-recursive-init path-iter)))))
- (let ((result nil)
- (case-fold-search completion-ignore-case)
- dir)
-
- (path-iter-restart path-iter)
- (while (setq dir (path-iter-next path-iter))
- (when (string-match dir-regex dir)
- (cl-mapc
- (lambda (file-name)
- (let ((absfile (concat (file-name-as-directory dir) file-name)))
- (when (and (not (string-equal "." (substring absfile -1)))
- (not (string-equal ".." (substring absfile -2)))
- (not (file-directory-p absfile))
- (string-match file-regex absfile)
- (or (null pred)
- (funcall pred absfile)))
- (push absfile result))))
- (directory-files dir))
- ))
- (cond
- ((eq action 'lambda)
- ;; Called from `test-completion'
- (fc-root-rel--valid-completion string result (car
(path-iter-path-recursive-init path-iter))))
+ (let ((root (car (path-iter-path-recursive-init path-iter))))
+ (cond
+ ((eq action 'metadata)
+ (cons 'metadata
+ (list
+ '(category . project-file)
+ '(styles . (file-root-rel))
+ (cons 'root root))))
- ((eq action t)
- ;; Called from all-completions
- result)
- ))
- ))
- ))
+ (t
+ (file-complete-completion-table path-iter 'root-relative root string
pred action))
+ )))
-(defun fc-root-rel--pcm-pattern-list (string root)
+(defun fc-root-rel--pcm-regex-list (string root)
"Return pcm regex constructed from STRING (a table format string)."
(let ((pattern (completion-pcm--string->pattern string)))
(concat "\\`"
root
- (when (< 0 (length string)) "/")
(substring (completion-pcm--pattern->regex pattern) 2);; trim \`
)))
@@ -356,52 +235,52 @@ with common prefix ROOT.
STRING, PRED, ACTION are completion table arguments."
;; This completion table function is required to provide access to
- ;; ROOT via metadata.
-
- (cond
- ((eq (car-safe action) 'boundaries)
- ;; We don't use boundaries; return the default definition.
- (cons 'boundaries
- (cons 0 (length (cdr action)))))
-
- ((eq action 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- '(styles . (file-root-rel))
- (cons 'root (directory-file-name root)))))
-
- ((null action)
- ;; Called from `try-completion'; should never get here (see
- ;; `fc-root-rel-try-completion').
- nil)
-
- ((memq action
- '(lambda ;; Called from `test-completion'
- t)) ;; Called from all-completions
-
- (let ((regex (fc-root-rel--pcm-pattern-list string (directory-file-name
root)))
- (result nil)
- (case-fold-search completion-ignore-case))
-
- (cl-mapc
- (lambda (absfile)
- (when (and (string-match regex absfile)
- (or (null pred)
- (funcall pred absfile)))
- (push absfile result)))
- file-list)
+ ;; ROOT via metadata, and the file-root-rel suggested style.
- (cond
- ((eq action 'lambda)
- ;; Called from `test-completion'
- (fc-root-rel--valid-completion string result (directory-file-name
root)))
-
- ((eq action t)
- ;; Called from all-completions
- result)
- )))
- ))
+ ;; `completion-to-table-input' doesn't realize we are dealing with a
+ ;; list, so we have to convert to abs file name.
+ (setq root (file-name-as-directory root))
+ (let ((abs-name (concat (file-name-as-directory root) string)))
+
+ (cond
+ ((eq (car-safe action) 'boundaries)
+ ;; We don't use boundaries; return the default definition.
+ (cons 'boundaries
+ (cons 0 (length (cdr action)))))
+
+ ((eq action 'metadata)
+ (cons 'metadata
+ (list
+ '(category . project-file)
+ '(styles . (file-root-rel))
+ (cons 'root (file-name-as-directory root)))))
+
+ ((memq action
+ '(nil ;; Called from `try-completion'
+ lambda ;; Called from `test-completion'
+ t)) ;; Called from all-completions
+
+ (let ((regex (fc-root-rel--pcm-regex-list string root))
+ (case-fold-search completion-ignore-case)
+ (result nil))
+ (dolist (abs-file-name file-list)
+ (when (and
+ (string-match regex abs-file-name)
+ (or (null pred)
+ (funcall pred abs-file-name)))
+ (push abs-file-name result)))
+
+ (cond
+ ((null action)
+ (try-completion abs-name result))
+
+ ((eq 'lambda action)
+ (test-completion abs-name file-list pred))
+
+ ((eq t action)
+ result)
+ )))
+ )))
(add-to-list 'completion-styles-alist
'(file-root-rel
@@ -411,5 +290,35 @@ STRING, PRED, ACTION are completion table arguments."
fc-root-rel-to-table-input ;; 4 user to table input format
fc-root-rel-to-data)) ;; 5 user to data format
+(defun locate-root-rel-file-iter (iter &optional predicate default prompt)
+ "Return an absolute filename, with file-root-rel completion style.
+ITER is a path-iterator giving the directory path to search; it
+must have exacly one recursive root, and no non-recursive roots.
+If PREDICATE is nil, it is ignored. If non-nil, it must be a
+function that takes one argument; the absolute file name. The
+file name is included in the result if PRED returns
+non-nil. DEFAULT is the default for completion.
+
+In the user input string, `*' is treated as a wildcard."
+ (let* ((table (apply-partially #'fc-root-rel-completion-table-iter iter))
+ (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
+ (completion-category-overrides
+ (list (list 'project-file (cons 'styles table-styles)))))
+
+ (unless (and (= 0 (length (path-iter-path-non-recursive-init iter)))
+ (= 1 (length (path-iter-path-recursive-init iter))))
+ (user-error "iterator does not have exactly one recursive root"))
+
+ (completing-read (format (concat (or prompt "file") " (%s): ") default)
+ table
+ predicate t nil nil default)
+ ))
+
+;; For example:
+;; (locate-root-rel-file-iter
+;; (make-path-iterator
+;; :user-path-non-recursive nil
+;; :user-path-recursive
"c:/Projects/elpa/packages/uniquify-files/uniquify-files-resources"))
+
(provide 'file-complete-root-relative)
;;; file-complete-root-relative.el ends here
diff --git a/packages/uniquify-files/file-complete.el
b/packages/uniquify-files/file-complete.el
new file mode 100644
index 0000000..5a498e8
--- /dev/null
+++ b/packages/uniquify-files/file-complete.el
@@ -0,0 +1,192 @@
+;;; file-complete.el --- core utilities for various file-completion styles and
tables. -*-lexical-binding:t-*-
+
+(defconst file-complete-match-styles '(absolute root-relative basename)
+ "Filename matching styles supported by `file-complete-completion-table'.
+
+- absolute - match entire string against absolute file names,
+ anchored at the string beginning.
+
+- root-relative - match entire string against file name relative
+ to a constant root.
+
+- basename - match basename portion of string against basename
+ portion of file names, and also directory name portions, not anchored.
+ For example, \"foo/c\" will match \"/root/foo/bar/car.text\".")
+
+(defun file-complete--iter-pcm-regex (string match-style root)
+ "Return dir and file regexes constructed from STRING (a partial file name)."
+ ;; `file-complete-completion-table' matches against directories from a
+ ;; `path-iterator', and files within those directories. Thus we
+ ;; construct two regexps from `string'.
+ (let* ((dir-name (file-name-directory string)) ;; nil, or ends in /
+ (file-name (file-name-nondirectory string))
+
+ (file-pattern (completion-pcm--string->pattern file-name))
+ (file-regex (completion-pcm--pattern->regex file-pattern))
+
+ (dir-pattern (and dir-name (completion-pcm--string->pattern dir-name)))
+
+ (dir-regex
+ (cl-ecase match-style
+ (absolute
+ (completion-pcm--pattern->regex dir-pattern))
+
+ (root-relative
+ (cond
+ ((null dir-name)
+ (if (= 0 (length file-name))
+ (concat "\\`" root)
+ (concat "\\`" root
+ (when (eq (car file-pattern) 'star) ".*?")
+ "\\(" (substring
+ (completion-pcm--pattern->regex
+ (append file-pattern (list 'star)))
+ 2) ;; strip \`
+ "\\)?\\'")))
+
+ (t
+ (concat root
+ (substring (completion-pcm--pattern->regex dir-pattern)
2) ;; strip \`
+ (if (= 0 (length file-name))
+ ""
+ (concat
+ "\\("
+ ;; The non-directory portion of STRING may
+ ;; be intended to match the next directory
+ ;; level.
+ (substring (completion-pcm--pattern->regex
file-pattern) 2) ;; strip \`
+ "\\)?"))))
+ ))
+
+ (basename
+ (substring (completion-pcm--pattern->regex dir-pattern) 2)) ;;
strip \`
+ )))
+ (list dir-regex file-regex)))
+
+(defun file-complete-completion-table (path-iter match-style root string pred
action)
+ "Implement a completion table for file names in PATH-ITER.
+
+PATH-ITER is a `path-iterator' object. It will be restarted for
+each call to `file-complete-completion-table'.
+
+MATCH-STYLE is one of `file-complete-match-styles', which see.
+ROOT is only non-nil for root-relative.
+
+STRING, PRED, ACTION are completion table arguments:
+
+STRING is a partial file name. `*' is treated as a wildcard, as
+in a shell glob pattern.
+
+If PRED is nil, it is ignored. If non-nil, it must be a function
+that takes one argument; the absolute file name. The file name
+is included in the result if PRED returns non-nil. In either
+case, `completion-ignored-extensions', `completion-regexp-list',
+`completion-ignore-case' are used as described in
+`file-name-all-completions'.
+
+ACTION is the current completion action; one of:
+
+- nil; return common prefix of all completions of STRING, nil or
+ t; see `try-completion'.
+
+- t; return all completions; see `all-completions'
+
+- lambda; return non-nil if string is a valid completion; see
+ `test-completion'.
+
+- '(boundaries . SUFFIX); return the completion region
+ '(boundaries START . END) within STRING; see
+ `completion-boundaries'.
+
+- 'metadata; return (metadata . ALIST) as defined by
+ `completion-metadata'."
+
+ (cl-assert (memq match-style file-complete-match-styles))
+
+ (cond
+ ((eq (car-safe action) 'boundaries)
+ ;; We don't use boundaries; return the default definition.
+ (cons 'boundaries
+ (cons 0 (length (cdr action)))))
+
+ ((eq action 'metadata)
+ (cons 'metadata
+ (list
+ '(category . project-file)
+ )))
+
+ ((memq action
+ '(nil ;; Called from `try-completion'.
+ lambda ;; Called from `test-completion'.
+ t)) ;; Called from `all-completions'.
+
+ ;; In file-name-all-completions, `completion-regexp-list', is
+ ;; matched against file names and directories relative to `dir'.
+ ;; Thus to handle partial completion delimiters in `string', we
+ ;; construct two regexps from `string'; one from the directory
+ ;; portion, and one from the non-directory portion. We use the
+ ;; directory regexp here, and pass the non-directory regexp to
+ ;; `file-name-all-completions' via `completion-regexp-list'. The
+ ;; `string' input to `file-name-all-completions' is redundant with
+ ;; the regexp, so we always build a regexp, and pass an empty
+ ;; string.
+
+ (pcase-let ((`(,dir-regex ,file-regex)
+ (file-complete--iter-pcm-regex string match-style root)))
+ (let ((result nil))
+
+ (path-iter-restart path-iter)
+
+ (let ((case-fold-search completion-ignore-case)
+ dir)
+ (while (setq dir (path-iter-next path-iter))
+ (when (string-match dir-regex dir)
+ ;; A project that deals only with C files might set
+ ;; `completion-regexp-list' to match only *.c, *.h, so we
+ ;; preserve that here.
+ (let ((completion-regexp-list
+ (if (match-string 1 dir)
+ ;; Non-directory portion of STRING matches
+ ;; dir, so don't match it against files in
+ ;; dir.
+ completion-regexp-list
+ (cons file-regex completion-regexp-list))))
+ (cl-mapc
+ (lambda (file-name)
+ (let ((absfile (concat (file-name-as-directory dir)
file-name)))
+ (when (and (not (directory-name-p file-name))
+ (or (null pred)
+ (funcall pred absfile)))
+ (push absfile result))))
+ (file-name-all-completions "" dir))
+ ))
+ ))
+ (cond
+ ((null action)
+ ;; Called from `try-completion'; find common prefix of `result'.
+ (try-completion "" result))
+
+ ((eq action 'lambda)
+ ;; Called from `test-completion'. Note that this call
+ ;; includes the `completion-to-table-input' advice, which in
+ ;; this case converts STRING to data format (= absolute file
+ ;; name). But that fails for root-relative match-style,
+ ;; because the result list does not know about ROOT. So we
+ ;; have to handle that here.
+ (cl-case match-style
+ ((absolute basename)
+ (test-completion string result))
+
+ (root-relative
+ (test-completion (concat root string) result))
+ ))
+
+ ((eq action t)
+ ;; Called from all-completions
+ result)
+ ))
+ ))
+ ))
+
+(provide 'file-complete)
+;; file-complete.el ends here.
diff --git a/packages/uniquify-files/uniquify-files-test.el
b/packages/uniquify-files/uniquify-files-test.el
index dd64d6c..59968d0 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -55,6 +55,8 @@
(defconst uft-root
(concat
(file-name-directory (or load-file-name (buffer-file-name)))
+ ;; We deliberately leave out the trailing '/' here, because users
+ ;; often do; the code must cope.
"uniquify-files-resources"))
(defconst uft-alice1 (concat uft-root "/Alice/alice-1"))
@@ -68,138 +70,15 @@
(make-path-iterator
:user-path-non-recursive
(list uft-root
+ (concat uft-root "/Alice")
uft-alice1
uft-alice2
uft-Alice-alice3
+ (concat uft-root "/Bob")
uft-Bob-alice3
uft-bob1
uft-bob2)))
-(ert-deftest test-uniq-file-completion-table ()
- "Test basic functions of table, with 'uniquify-file completion style."
- ;; grouped by action
- (let ((completion-current-style 'uniquify-file))
- (should (equal (uniq-file-completion-table uft-iter "fi" nil '(boundaries
. ".text"))
- '(boundaries . (0 . 5))))
-
- (should (equal (uniq-file-completion-table uft-iter "fi" nil 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- '(styles . (uniquify-file))))))
-
- ;; all-completions. We sort the results here to make the test stable
- (should (equal (sort (uniq-file-completion-table uft-iter "-fi" nil t)
#'string-lessp)
- (list
- (concat uft-alice1 "/bar-file1.text")
- (concat uft-alice1 "/bar-file2.text")
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- (concat uft-alice2 "/bar-file1.text")
- (concat uft-alice2 "/bar-file2.text")
- (concat uft-alice2 "/foo-file1.text")
- (concat uft-alice2 "/foo-file3.text")
- (concat uft-alice2 "/foo-file3.texts")
- (concat uft-Alice-alice3 "/foo-file4.text")
- (concat uft-Bob-alice3 "/foo-file4.text")
- (concat uft-bob1 "/foo-file1.text")
- (concat uft-bob1 "/foo-file2.text")
- (concat uft-bob2 "/foo-file1.text")
- (concat uft-bob2 "/foo-file5.text")
- (concat uft-root "/foo-file1.text")
- (concat uft-root "/foo-file3.texts2")
- )))
-
- (should (equal (sort (uniq-file-completion-table uft-iter "a-1/f-fi" nil
t) #'string-lessp)
- (list
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- )))
-
- (should (equal (uniq-file-completion-table uft-iter
"file1.text<uft-alice1/>" nil t)
- ;; some caller did not deuniquify; treated as misspelled; no
match
- nil))
-
-
- ;; try-completion
- (should (equal (uniq-file-completion-table uft-iter "a-1/f-fi" nil nil)
- (concat uft-alice1 "/foo-file")))
-
- ;; test-completion
- (should (equal (uniq-file-completion-table uft-iter
(uniq-file-to-table-input "foo-file1.text<alice-1>") nil 'lambda)
- t))
-
- ))
-
-(ert-deftest test-uniq-file-completion-table-other-style ()
- "Test basic functions of table, with some other file completion style."
- ;; Other file completion styles operate on absolute file names only.
-
- ;; grouped by action
- (let ((completion-current-style nil))
- (should (equal (uniq-file-completion-table uft-iter (concat uft-alice1
"/fi") nil '(boundaries . ".text"))
- '(boundaries . (0 . 5))))
-
- (should (equal (uniq-file-completion-table uft-iter (concat uft-alice1
"/fi") nil 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- '(styles . (uniquify-file))))))
-
- ;; all-completions. We sort the results here to make the test stable
- (should (equal (sort (uniq-file-completion-table uft-iter (concat
uft-alice1 "/-fi") nil t) #'string-lessp)
- (list
- (concat uft-alice1 "/bar-file1.text")
- (concat uft-alice1 "/bar-file2.text")
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- )))
-
- (should (equal (sort (uniq-file-completion-table uft-iter (concat uft-root
"/a-1/f-fi") nil t) #'string-lessp)
- (list
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- )))
-
- ;; try-completion
- (should (equal (uniq-file-completion-table uft-iter uft-alice1 nil nil)
- (concat uft-alice1 "/")))
-
-
- ;; test-completion
- (should (equal (uniq-file-completion-table uft-iter (concat uft-alice1
"/foo-file1.text") nil 'lambda)
- t))
-
- ))
-
-(ert-deftest test-uniq-file-path-completion-table-pred ()
- "Test table with predicate."
- (let ((completion-current-style 'uniquify-file))
- (should (equal (sort (uniq-file-completion-table
- uft-iter
- "-fi"
- (lambda (absfile) (string= (file-name-directory
absfile) (file-name-as-directory uft-alice1)))
- t)
- #'string-lessp)
- (list
- (concat uft-alice1 "/bar-file1.text")
- (concat uft-alice1 "/bar-file2.text")
- (concat uft-alice1 "/foo-file1.text")
- (concat uft-alice1 "/foo-file2.text")
- )))
-
- (should (equal (sort (uniq-file-completion-table
- uft-iter
- "-fi"
- (lambda (absfile) (string= (file-name-nondirectory
absfile) "bar-file1.text"))
- t)
- #'string-lessp)
- (list
- (concat uft-alice1 "/bar-file1.text")
- (concat uft-alice2 "/bar-file1.text")
- )))
-
- ))
(defun test-uniq-file-test-completion-1 (table)
(should (equal (test-completion "foo-fi" table)
@@ -283,6 +162,11 @@
)))
(should (equal
+ (sort (uniq-file-all-completions "a" table nil nil) #'string-lessp)
+ ;; Should _not_ match directory names
+ nil))
+
+ (should (equal
(sort (uniq-file-all-completions "b" table nil nil) #'string-lessp)
(list
"bar-file1.text<alice-1/>"
@@ -376,7 +260,8 @@
)
(should (equal (uniq-file-all-completions "f-file1.text<a-1" table nil nil)
- (list "foo-file1.text<alice-1/>")))
+ ;; Accidentally match "a" with "packages"
+ (list "foo-file1.text<Alice/alice-1/>")))
(let ((completion-ignore-case t))
(should (equal (uniq-file-all-completions "f-file1.text<a-1" table nil nil)
@@ -591,15 +476,11 @@ all positions in POS-LIST in STRING; return new string."
(should (equal (uniq-file-try-completion string table nil (length string))
'("foo-file3.text" . 14)))
- (setq string "f-file1.text<a-1") ;; unique but not valid
+ (setq string "f-file1.text<a-1")
+ ;; Not unique, because "a" accidentally matches "packages" in
+ ;; uft-root-dir, and "-" covers "/". Also not valid.
(should (equal (uniq-file-try-completion string table nil (length string))
- '("foo-file1.text<alice-1/>" . 24)))
-
- (let ((completion-ignore-case t))
- (setq string "f-file1.text<a-1") ;; unique but not valid
- (should (equal (uniq-file-try-completion string table nil (length
string))
- '("foo-file1.text<Alice/alice-1/>" . 30)))
- )
+ '("foo-file1.text<Alice/alice-1/>" . 30)))
(setq string "foo-file1.text") ;; valid but not unique
(should (equal (uniq-file-try-completion string table nil (length string))
@@ -686,25 +567,25 @@ all positions in POS-LIST in STRING; return new string."
))
(ert-deftest test-uniq-file-to-table-input ()
- (should (equal (uniq-file-to-table-input "fi")
+ (should (equal (uniq-file-to-table-input "fi" nil nil)
"fi"))
- (should (equal (uniq-file-to-table-input "fi<di")
+ (should (equal (uniq-file-to-table-input "fi<di" nil nil)
"di/fi"))
- (should (equal (uniq-file-to-table-input "foo-file1.text")
+ (should (equal (uniq-file-to-table-input "foo-file1.text" nil nil)
"foo-file1.text"))
- (should (equal (uniq-file-to-table-input "file1<Alice/alice-2/>")
+ (should (equal (uniq-file-to-table-input "file1<Alice/alice-2/>" nil nil)
"Alice/alice-2/file1"))
- (should (equal (uniq-file-to-table-input "file1<>")
+ (should (equal (uniq-file-to-table-input "file1<>" nil nil)
"file1"))
- (should (equal (uniq-file-to-table-input "file1.text<Alice/alice-2/>")
+ (should (equal (uniq-file-to-table-input "file1.text<Alice/alice-2/>" nil
nil)
"Alice/alice-2/file1.text"))
- (should (equal (uniq-file-to-table-input "bar-file2.text<Alice/alice-")
+ (should (equal (uniq-file-to-table-input "bar-file2.text<Alice/alice-" nil
nil)
"Alice/alice-/bar-file2.text"))
)
diff --git a/packages/uniquify-files/uniquify-files.el
b/packages/uniquify-files/uniquify-files.el
index 62330b8..923e680 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -174,6 +174,7 @@
;;
(require 'cl-lib)
+(require 'file-complete)
(require 'path-iterator)
(defvar completion-current-style nil
@@ -316,7 +317,7 @@ If DIR is non-nil, all elements of NAMES must match DIR."
))
))
-(defun uniq-file-to-table-input (user-string &optional _table _pred)
+(defun uniq-file-to-table-input (user-string _table _pred)
"Implement `completion-to-table-input' for uniquify-file."
(let* ((match (string-match uniq-file--regexp user-string))
(dir (and match (match-string 2 user-string))))
@@ -352,12 +353,9 @@ STRING should be in completion table input format."
matched))
-(defun uniq-file--pcm-merged-pat (string all point)
- "Return a pcm pattern that is the merged completion of STRING in ALL.
-ALL must be a list of table input format strings?
-Pattern is in reverse order."
- (let* ((case-fold-search completion-ignore-case)
- (completion-pcm--delim-wild-regex
+(defun uniq-file--pcm-pat (string point)
+ "Return a pcm pattern that matches STRING (a user format string)."
+ (let* ((completion-pcm--delim-wild-regex
(concat "[" completion-pcm-word-delimiters "<>*]"))
;; If STRING ends in an empty directory part, some valid
;; completions won't have any directory part.
@@ -384,7 +382,13 @@ Pattern is in reverse order."
(push 'any new-pattern)
(push item new-pattern))))
(setq pattern (nreverse new-pattern))))
+ pattern))
+(defun uniq-file--pcm-merged-pat (string all point)
+ "Return a pcm pattern that is the merged completion of STRING in ALL.
+ALL must be a list of user format strings.
+Pattern is in reverse order."
+ (let* ((pattern (uniq-file--pcm-pat string point)))
(completion-pcm--merge-completions all pattern)))
(defun uniq-file-try-completion (user-string table pred point)
@@ -507,7 +511,7 @@ nil otherwise."
"Implement `completion-all-completions' for uniquify-file."
;; Returns list of data format strings (abs file names).
- (let ((table-string (uniq-file-to-table-input user-string))
+ (let ((table-string (uniq-file-to-table-input user-string table pred))
all)
(setq completion-current-style 'uniquify-file)
@@ -518,10 +522,10 @@ nil otherwise."
((and (consp table)
(file-name-absolute-p (car table)))
- ;; TABLE is the original list of absolute file names.
+ ;; TABLE is a list of absolute file names.
(pcase-let ((`(,dir-regex ,file-regex)
- (uniq-file--pcm-pattern table-string)))
+ (file-complete--iter-pcm-regex table-string 'basename nil)))
(let ((completion-regexp-list (cons file-regex completion-regexp-list))
(case-fold-search completion-ignore-case))
(dolist (file-name table)
@@ -536,6 +540,12 @@ nil otherwise."
(when all
(setq all (uniq-file--uniquify all (file-name-directory table-string)))
+
+ ;; Filter accidental matches; see uniquify-files-test.el
+ ;; test-uniq-file-try-completion-1 "f-file1.text<a-1"
+ (let ((regex1 (completion-pcm--pattern->regex (uniq-file--pcm-pat
user-string point))))
+ (setq all (cl-delete-if-not (lambda (name) (string-match regex1 name))
all)))
+
(setq all (uniq-file--hilit user-string all point))
all
)
@@ -546,7 +556,7 @@ nil otherwise."
;; We assume USER-STRING is complete, but it may not be unique, in
;; both the file name and the directory; shortest completion of each
;; portion is the correct one.
- (let ((table-string (uniq-file-to-table-input user-string))
+ (let ((table-string (uniq-file-to-table-input user-string table pred))
all)
(cond
((functionp table)
@@ -578,6 +588,7 @@ nil otherwise."
"");; must return a string, not nil.
))
+;; FIXME: move to file-complete
(defun completion-get-data-string (user-string table pred)
"Return the data string corresponding to USER-STRING."
(let* ((to-data-func (when completion-current-style (nth 5 (assq
completion-current-style completion-styles-alist)))))
@@ -632,83 +643,11 @@ nil otherwise."
uniq-file-to-table-input ;; 4 user to table input format
uniq-file-get-data-string)) ;; 5 user to data format
-(defun uniq-file--pcm-pattern (string)
- "Return pcm regexes constructed from STRING (a table input format string)."
- ;; `uniq-file-completion-table' matches against directories from a
- ;; `path-iterator', and files within those directories. Thus we
- ;; construct two regexps from `string'; one from the entire string
- ;; (which, if `completion-current-style' is not `uniquify-file', may
- ;; end in a partial directory name, rather than a file basename),
- ;; and one from the non-directory portion.
- (let* ((dir-name (directory-file-name (or (file-name-directory string) "")))
- (file-name (file-name-nondirectory string))
-
- (file-pattern (completion-pcm--string->pattern file-name))
- (file-regex (completion-pcm--pattern->regex file-pattern))
-
- ;; `completion-pcm--string->pattern' assumes its argument
- ;; is anchored at the beginning but not the end; that is
- ;; true for `dir-name' only if it is absolute.
- (dir-pattern (completion-pcm--string->pattern
- (if (file-name-absolute-p dir-name) dir-name (concat
"*/" dir-name))))
-
- (dir-regex (completion-pcm--pattern->regex dir-pattern)))
-
- (unless (eq completion-current-style 'uniquify-file)
- ;; We enclose the file-regex part in a group, so
- ;; `uniq-file-completion-table' can tell whether it matched.
- ;; Strip "\`" from file-regex
- (setq dir-regex (concat dir-regex "\\(/" (substring file-regex 2)
"\\)?")))
- (list dir-regex file-regex)))
-
(defun uniq-file-completion-table (path-iter string pred action)
- "Implement a completion table for file names in PATH-ITER.
-
-PATH-ITER is a `path-iterator' object. It will be restarted for
-each call to `uniq-file-completion-table'.
-
-STRING, PRED, ACTION are completion table arguments:
-
-STRING is the entire current user input, which is expected to be
-a non-directory file name, plus enough directory portions to
-identify a unique file. `*' is treated as a wildcard, as in a
-shell glob pattern.
-
-If PRED is nil, it is ignored. If non-nil, it must be a function
-that takes one argument; the absolute file name. The file name
-is included in the result if PRED returns non-nil. In either
-case, `completion-ignored-extensions', `completion-regexp-list',
-`completion-ignore-case' are used as described in
-`file-name-all-completions'.
-
-ACTION is the current completion action; one of:
-
-- nil; return common prefix of all completions of STRING, nil or
- t; see `try-completion'.
-
-- t; return all completions; see `all-completions'
-
-- lambda; return non-nil if string is a valid completion; see
- `test-completion'.
-
-- '(boundaries . SUFFIX); return the completion region
- '(boundaries START . END) within STRING; see
- `completion-boundaries'.
-
-- 'metadata; return (metadata . ALIST) as defined by
- `completion-metadata'."
-
- ;; This completion table function combines iterating on files in
- ;; PATH-ITER with filtering on USER-STRING and PRED. This is an
- ;; optimization that minimizes storage use when USER-STRING is not
- ;; empty and PRED is non-nil.
+ "Implement a completion table for file names in PATH-ITER."
+ ;; We just add `styles' metadata to `path-iter-completion-table'.
(cond
- ((eq (car-safe action) 'boundaries)
- ;; We don't use boundaries; return the default definition.
- (cons 'boundaries
- (cons 0 (length (cdr action)))))
-
((eq action 'metadata)
(cons 'metadata
(list
@@ -716,63 +655,8 @@ ACTION is the current completion action; one of:
'(styles . (uniquify-file))
)))
- ((memq action
- '(nil ;; Called from `try-completion'.
- lambda ;; Called from `test-completion'
- t)) ;; Called from `all-completions'.
-
- ;; In file-name-all-completions, `completion-regexp-list', is
- ;; matched against file names and directories relative to `dir'.
- ;; Thus to handle partial completion delimiters in `string', we
- ;; construct two regexps from `string'; one from the directory
- ;; portion, and one from the non-directory portion. We use the
- ;; directory regexp here, and pass the non-directory regexp to
- ;; `file-name-all-completions' via `completion-regexp-list'. The
- ;; `string' input to `file-name-all-completions' is redundant with
- ;; the regexp, so we always build a regexp, and pass an empty
- ;; string.
-
- (pcase-let ((`(,dir-regex ,file-regex)
- (uniq-file--pcm-pattern string)))
- (let ((result nil))
-
- (path-iter-restart path-iter)
-
- (let ((case-fold-search completion-ignore-case)
- dir)
- (while (setq dir (path-iter-next path-iter))
- (when (string-match dir-regex dir)
- ;; A project that deals only with C files might set
- ;; `completion-regexp-list' to match only *.c, *.h, so we
- ;; preserve that here.
- (let ((completion-regexp-list
- (if (match-string 1 dir)
- completion-regexp-list
- (cons file-regex completion-regexp-list))))
- (cl-mapc
- (lambda (file-name)
- (let ((absfile (concat (file-name-as-directory dir)
file-name)))
- (when (and (not (directory-name-p file-name))
- (or (null pred)
- (funcall pred absfile)))
- (push absfile result))))
- (file-name-all-completions "" dir))
- ))
- ))
- (cond
- ((null action)
- ;; Called from `try-completion'; find common prefix of `result'.
- (try-completion "" result))
-
- ((eq action 'lambda)
- ;; Called from `test-completion'
- (uniq-file--valid-completion string result))
-
- ((eq action t)
- ;; Called from all-completions
- result)
- ))
- ))
+ (t
+ (file-complete-completion-table path-iter 'basename nil string pred
action))
))
(defun locate-uniquified-file (&optional path predicate default prompt)
@@ -795,7 +679,8 @@ In the user input string, `*' is treated as a wildcard."
))
(defun locate-uniquified-file-iter (iter &optional predicate default prompt)
- "Return an absolute filename, with completion in path-iterator ITER.
+ "Return an absolute filename, with uniquify-file completion style.
+ITER is a path-iterator giving the directory path to search.
If PREDICATE is nil, it is ignored. If non-nil, it must be a
function that takes one argument; the absolute file name. The
file name is included in the result if PRED returns
@@ -812,17 +697,5 @@ In the user input string, `*' is treated as a wildcard."
predicate t nil nil default)
))
-(defun locate-uniquified-file-iter-2 (iter &optional predicate default prompt)
- "Same as `locate-uniquified-file-iter', but the internal
-completion table is the list returned by `path-iter-all-files'."
- (let* ((table (path-iter-all-files iter))
- (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
- (completion-category-overrides
- (list (list 'project-file (cons 'styles table-styles)))))
- (completing-read (format (concat (or prompt "file") " (%s): ") default)
- table
- predicate t nil nil default)
- ))
-
(provide 'uniquify-files)
;;; uniquify-files.el ends here
- [elpa] master updated (5b562e4 -> 67dcbc4), Stephen Leake, 2019/07/11
- [elpa] master b13820c 2/5: Merge commit '98405112baa5ce2a118d1c65184c005d8ddaa1a9', Stephen Leake, 2019/07/11
- [elpa] master 9aad8f1 1/5: In uniquify-files, factor out file-complete.el,
Stephen Leake <=
- [elpa] master b3034e0 3/5: In uniquify-files, rewrite to use an alist, clean up tests to match, Stephen Leake, 2019/07/11
- [elpa] master 67dcbc4 5/5: In ada-mode, wisi; release ada-mode 6.1.1, wisi 2.1.1, Stephen Leake, 2019/07/11
- [elpa] master 280522c 4/5: Merge commit '5b562e4ddfc449cd61c82ef7646a6c501b913b6c', Stephen Leake, 2019/07/11