branch: master commit e9db4b499b88fd43f2df4f3e449329fc652bfed3 Author: Stephen Leake <stephen_le...@stephe-leake.org> Commit: Stephen Leake <stephen_le...@stephe-leake.org>
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))