[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/uniquify-files f264c36 15/22: In uniquify-files, factor
From: |
Stefan Monnier |
Subject: |
[elpa] externals/uniquify-files f264c36 15/22: In uniquify-files, factor out file-complete.el |
Date: |
Tue, 1 Dec 2020 17:36:21 -0500 (EST) |
branch: externals/uniquify-files
commit f264c36890568fc3b94ce73b65991c1349c9723d
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>
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.
---
file-complete-root-relative-test.el | 83 ++--------
file-complete-root-relative.el | 293 +++++++++++++-----------------------
file-complete.el | 192 +++++++++++++++++++++++
uniquify-files-test.el | 163 +++-----------------
uniquify-files.el | 183 ++++------------------
5 files changed, 356 insertions(+), 558 deletions(-)
diff --git a/file-complete-root-relative-test.el
b/file-complete-root-relative-test.el
index ddf863e..8b44d92 100644
--- a/file-complete-root-relative-test.el
+++ b/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/file-complete-root-relative.el b/file-complete-root-relative.el
index 1724ecc..14d1b1f 100644
--- a/file-complete-root-relative.el
+++ b/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/file-complete.el b/file-complete.el
new file mode 100644
index 0000000..5a498e8
--- /dev/null
+++ b/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/uniquify-files-test.el b/uniquify-files-test.el
index dd64d6c..59968d0 100644
--- a/uniquify-files-test.el
+++ b/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/uniquify-files.el b/uniquify-files.el
index 62330b8..923e680 100644
--- a/uniquify-files.el
+++ b/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] externals/uniquify-files 3509563 09/22: Improve uniquify-files in corner case, (continued)
- [elpa] externals/uniquify-files 3509563 09/22: Improve uniquify-files in corner case, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files f2d8f76 12/22: In uniquify-files/file-complete-root-relative.el, delete extra paren, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 95acec3 19/22: In ada-mode and wisi, release ada-mode 6.2.1, wisi 2.2.1; fix packaging bugs, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 45a4eb3 21/22: In uniquify-files.el uniq-file-completion-table, fix compatibility with 25.3, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files ba4f850 07/22: In uniquify-files, add another file completion style, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files bce1da7 10/22: Fix bugs in uniquify-files, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 4ebe003 14/22: In uniquify-files, improve completion table to work with other styles, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 2257858 18/22: Release path-iterator.el, uniquify-files.el, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 8d2322c 06/22: Improve uniquify-files-test.el, improve uniquify-files to handle new tests, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 4edece3 17/22: In packages/uniquify-files/uniquify-files.el: fix typo, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files f264c36 15/22: In uniquify-files, factor out file-complete.el,
Stefan Monnier <=
- [elpa] externals/uniquify-files 991703e 20/22: In uniquify-files.el, improve integration with project.el, bump version, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 7b15736 22/22: * .gitignore: New file, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files ca881b6 11/22: In uniquify-files, use text property to pass completion style, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files 949fd35 13/22: Improve uniquify-files, Stefan Monnier, 2020/12/01
- [elpa] externals/uniquify-files d3ea093 16/22: In uniquify-files, rewrite to use an alist, clean up tests to match, Stefan Monnier, 2020/12/01