[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master e9db4b4 3/3: In uniquify-files, improve completion table t
|
From: |
Stephen Leake |
|
Subject: |
[elpa] master e9db4b4 3/3: In uniquify-files, improve completion table to work with other styles |
|
Date: |
Fri, 22 Mar 2019 22:02:18 -0400 (EDT) |
branch: master
commit e9db4b499b88fd43f2df4f3e449329fc652bfed3
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
In uniquify-files, improve completion table to work with other styles
* packages/uniquify-files/uniquify-files.el (uniq-file--pcm-pattern): Use
completion-current-style to control dir-regex result.
(uniq-file--set-style): Delete; no longer used.
(uniq-file-all-completions): No longer set text property on result
strings.
(uniq-file-completion-table): Implement try-completion. If current
completion style is not uniquify-file, allow non-directory part of string
to match a directory (as other styles require).
(locate-file-iter): New; demonstrates using completion table with default
file completion styles.
* packages/uniquify-files/uniquify-files-test.el: Update all tests, add
non-uniquify-file style tests.
---
packages/uniquify-files/uniquify-files-test.el | 228 +++++++++++++++----------
packages/uniquify-files/uniquify-files.el | 116 ++++++-------
2 files changed, 190 insertions(+), 154 deletions(-)
diff --git a/packages/uniquify-files/uniquify-files-test.el
b/packages/uniquify-files/uniquify-files-test.el
index 13214a4..dd64d6c 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -76,121 +76,160 @@
uft-bob2)))
(ert-deftest test-uniq-file-completion-table ()
- "Test basic functions of table."
+ "Test basic functions of table, with 'uniquify-file completion style."
;; grouped by action
- (should (equal (uniq-file-completion-table uft-iter "fi" nil '(boundaries .
".text"))
+ (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))))))
+ (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")
- )))
+ ;; 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))
+ (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))
- ;; This table does not implement try-completion
- (should (equal (uniq-file-completion-table uft-iter "fi" nil nil)
- 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))
+ ;; 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."
- (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")
- )))
+ (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)
- ;; 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 'uniquify-file str)
- str))
- (should (equal (test-completion (ss "foo-fi") table)
- nil))
+ (should (equal (test-completion "foo-fi" table)
+ nil))
- (should (equal (test-completion (ss "f-fi<dir") table)
- nil))
+ (should (equal (test-completion "f-fi<dir" table)
+ nil))
- (should (equal (test-completion (ss "foo-file1.text<>") table)
- t))
+ (should (equal (test-completion "foo-file1.text<>" table)
+ t))
- (should (equal (test-completion (ss "foo-file1.text") table)
- t))
+ (should (equal (test-completion "foo-file1.text" table)
+ t))
- (should (equal (test-completion (ss "foo-file1.text<alice-1/>") table)
- t))
+ (should (equal (test-completion "foo-file1.text<alice-1/>" table)
+ t))
- (should (equal (test-completion (ss "foo-file3.tex") table) ;; partial
file name
- nil))
+ (should (equal (test-completion "foo-file3.tex" table) ;; partial file name
+ nil))
- (should (equal (test-completion (ss "foo-file3.texts2") table)
- t))
+ (should (equal (test-completion "foo-file3.texts2" table)
+ t))
- (should (equal (test-completion (ss "bar-file2.text<Alice/alice-") table)
- nil))
- ))
+ (should (equal (test-completion "bar-file2.text<Alice/alice-" table)
+ nil))
+ )
(ert-deftest test-uniq-file-test-completion-func ()
- (let ((table (apply-partially 'uniq-file-completion-table uft-iter)))
+ (let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+ (completion-current-style 'uniquify-file))
(test-uniq-file-test-completion-1 table)))
(ert-deftest test-uniq-file-test-completion-list ()
@@ -405,6 +444,7 @@
(ert-deftest test-uniq-file-all-completions-noface-func ()
(let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+ (completion-current-style 'uniquify-file)
(completion-ignore-case nil))
(test-uniq-file-all-completions-noface-1 table)))
@@ -416,9 +456,7 @@
(defun test-uniq-file-hilit (pos-list string)
"Set 'face text property to 'completions-first-difference at
-all positions in POS-LIST in STRING; return new string.
-Also set 'completion-style."
- (put-text-property 0 1 'completion-style 'uniquify-file string)
+all positions in POS-LIST in STRING; return new string."
(while pos-list
(let ((pos (pop pos-list)))
(put-text-property pos (1+ pos) 'face 'completions-first-difference
string)))
@@ -433,6 +471,7 @@ Also set 'completion-style."
;; sharing strings that should not be shared because they have
;; different text properties.
(let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+ (completion-current-style 'uniquify-file)
(completion-ignore-case nil))
(should (equal-including-properties
@@ -620,6 +659,7 @@ Also set 'completion-style."
(ert-deftest test-uniq-file-try-completion-func ()
(let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+ (completion-current-style 'uniquify-file)
(completion-ignore-case nil))
(test-uniq-file-try-completion-1 table)))
diff --git a/packages/uniquify-files/uniquify-files.el
b/packages/uniquify-files/uniquify-files.el
index 9c8ffc7..62330b8 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -352,27 +352,6 @@ STRING should be in completion table input format."
matched))
-(defun uniq-file--pcm-pattern (string)
- "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* ((dir-name (directory-file-name (or (file-name-directory string) "")))
- (file-name (file-name-nondirectory string))
-
- ;; `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))
-
- (file-pattern (completion-pcm--string->pattern file-name))
- (file-regex (completion-pcm--pattern->regex file-pattern)))
- (list dir-regex file-regex)))
-
(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?
@@ -524,15 +503,6 @@ nil otherwise."
(setq result nil)))
result))
-(defun uniq-file--set-style (all style)
- "Set completion-style text property on each string in ALL to STYLE.
-Return a new list."
- (mapcar
- (lambda (str)
- (put-text-property 0 1 'completion-style style str)
- str)
- all))
-
(defun uniq-file-all-completions (user-string table pred point)
"Implement `completion-all-completions' for uniquify-file."
;; Returns list of data format strings (abs file names).
@@ -567,7 +537,6 @@ Return a new list."
(when all
(setq all (uniq-file--uniquify all (file-name-directory table-string)))
(setq all (uniq-file--hilit user-string all point))
- (setq all (uniq-file--set-style all 'uniquify-file))
all
)
))
@@ -663,6 +632,35 @@ Return a new list."
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.
@@ -686,7 +684,7 @@ case, `completion-ignored-extensions',
`completion-regexp-list',
ACTION is the current completion action; one of:
- nil; return common prefix of all completions of STRING, nil or
- t; see `try-completion'. This table always returns nil.
+ t; see `try-completion'.
- t; return all completions; see `all-completions'
@@ -698,19 +696,13 @@ ACTION is the current completion action; one of:
`completion-boundaries'.
- 'metadata; return (metadata . ALIST) as defined by
- `completion-metadata'.
-
-Return a list of absolute file names matching STRING."
+ `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.
- ;; We don't use cl-assert on the path here, because that would be
- ;; called more often than necessary, and because throwing an error
- ;; from inside completing-read and/or icomplete is not helpful.
-
(cond
((eq (car-safe action) 'boundaries)
;; We don't use boundaries; return the default definition.
@@ -724,14 +716,10 @@ Return a list of absolute file names matching STRING."
'(styles . (uniquify-file))
)))
- ((null action)
- ;; Called from `try-completion'; should never get here (see
- ;; `uniq-file-try-completion').
- nil)
-
((memq action
- '(lambda ;; Called from `test-completion'
- t)) ;; Called from all-completions
+ '(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'.
@@ -746,11 +734,7 @@ Return a list of absolute file names matching STRING."
(pcase-let ((`(,dir-regex ,file-regex)
(uniq-file--pcm-pattern string)))
- (let (;; A project that deals only with C files might set
- ;; `completion-regexp-list' to match only *.c, *.h, so we
- ;; preserve that here.
- (completion-regexp-list (cons file-regex completion-regexp-list))
- (result nil))
+ (let ((result nil))
(path-iter-restart path-iter)
@@ -758,16 +742,28 @@ Return a list of absolute file names matching STRING."
dir)
(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 (directory-name-p file-name))
- (or (null pred)
- (funcall pred absfile)))
- (push absfile result))))
- (file-name-all-completions "" 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))