branch: master commit 29c1537360536d53c0eb156760c490d5d273a977 Author: Stephen Leake <stephen_le...@stephe-leake.org> Commit: Stephen Leake <stephen_le...@stephe-leake.org>
Improve uniquify-files; add tests. Add path-iterator tests * packages/uniquify-files/uniquify-files-resources/: New directory. * packages/uniquify-files/uniquify-files-test.el: New file. * packages/uniquify-files/uniquify-files.el: Delete uniquify-files-style; not useful. * packages/path-iterator/path-iterator-resources/: New directory. * packages/path-iterator/path-iterator-test.el: New file. --- .../path-iterator-resources/file-0.text | 1 + packages/path-iterator/path-iterator-test.el | 172 ++++++ .../Alice/alice-1/bar-file1.text | 1 + .../Alice/alice-1/bar-file2.text | 1 + .../Alice/alice-1/foo-file1.text | 1 + .../Alice/alice-1/foo-file2.text | 1 + .../Alice/alice-2/bar-file1.text | 1 + .../Alice/alice-2/bar-file2.text | 1 + .../Alice/alice-2/foo-file1.text | 1 + .../Alice/alice-2/foo-file3.text | 1 + .../Alice/alice-2/foo-file3.texts | 1 + .../Bob/bob-1/foo-file1.text | 1 + .../Bob/bob-1/foo-file2.text | 1 + .../Bob/bob-2/foo-file1.text | 1 + .../Bob/bob-2/foo-file5.text | 1 + .../uniquify-files-resources/foo-file1.text | 1 + .../uniquify-files-resources/foo-file3.texts2 | 1 + packages/uniquify-files/uniquify-files-test.el | 643 +++++++++++++++++++++ packages/uniquify-files/uniquify-files.el | 100 ++-- 19 files changed, 869 insertions(+), 62 deletions(-) diff --git a/packages/path-iterator/path-iterator-resources/file-0.text b/packages/path-iterator/path-iterator-resources/file-0.text new file mode 100644 index 0000000..0c7a9ac --- /dev/null +++ b/packages/path-iterator/path-iterator-resources/file-0.text @@ -0,0 +1 @@ +just a file diff --git a/packages/path-iterator/path-iterator-test.el b/packages/path-iterator/path-iterator-test.el new file mode 100644 index 0000000..09c01da --- /dev/null +++ b/packages/path-iterator/path-iterator-test.el @@ -0,0 +1,172 @@ +;;; path-iterator-test.el --- test for path-iterator.el. -*-lexical-binding:t-*- + +;; Copyright (C) 2015, 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: +(require 'path-iterator) + +(defconst path-iter-root-dir + (concat + (file-name-directory (or load-file-name (buffer-file-name))) + "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. +EXPECTED-DIRS is a list of directory file names; it is compared +with `equal' to a list of the results of running the path +iterator built from PATH-NON-RECURSIVE, PATH-RECURSIVE, IGNORE-FUNCTION." + (declare (indent defun) + (debug (symbolp "name-suffix"))) + `(ert-deftest ,(intern (concat "path-iter-test-" (symbol-name name-suffix))) () + (path-iter-test-run ,path-non-recursive ,path-recursive ,expected-dirs ,ignore-function) + )) + +(defun path-iter-test-run-1 (iter expected-dirs) + (let (computed-dirs) + (while (not (path-iter-done iter)) + (push (path-iter-next iter) computed-dirs)) + (should (null (path-iter-next iter))) + (setq computed-dirs (nreverse computed-dirs)) + (should (equal computed-dirs expected-dirs)) + )) + +(defun path-iter-test-run (path-non-recursive path-recursive expected-dirs ignore-function) + (let ((iter (make-path-iterator + :user-path-non-recursive path-non-recursive + :user-path-recursive path-recursive + :ignore-function ignore-function))) + (path-iter-test-run-1 iter expected-dirs) + (path-iter-restart iter) + (path-iter-test-run-1 iter expected-dirs) + )) + +(path-iter-deftest recursive + nil ;; non-recursive + (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") + )) + +(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 + ) + 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") + )) + +(path-iter-deftest both + (list + (concat path-iter-root-dir "/alice-1")) + (list + (concat path-iter-root-dir "/bob-1")) + (list + (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") + )) + +(defvar path-iter-ignore-bob nil + "Set during test to change visited directories.") + +(defun path-iter-ignore-bob (dir) + (string-equal path-iter-ignore-bob (file-name-nondirectory dir))) + +(ert-deftest path-iter-ignores-restart () + (let ((iter + (make-path-iterator + :user-path-non-recursive nil + :user-path-recursive (list path-iter-root-dir) + :ignore-function #'path-iter-ignore-bob))) + + (setq path-iter-ignore-bob "bob-2") + (path-iter-test-run-1 + 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") + )) + + (setq path-iter-ignore-bob "bob-3") + + (path-iter-restart iter);; not reset; does not recompute path + (path-iter-test-run-1 + 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") + )) + + (path-iter-reset iter);; recomputes path + (path-iter-test-run-1 + 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") + )) + )) + +(ert-deftest path-iter-ignore-2 () + (let ((iter + (make-path-iterator + :user-path-non-recursive nil + :user-path-recursive (list path-iter-root-dir) + :ignore-function #'path-iter-ignore-bob))) + + (setq path-iter-ignore-bob "bob-1") ;; has child directories + (path-iter-test-run-1 + iter + (list + path-iter-root-dir + (concat path-iter-root-dir "/alice-1") + )) + )) + +(ert-deftest path-iter-truename-nil () + (let ((default-directory path-iter-root-dir)) + (should + (equal + (path-iter-to-truename + (list + nil + (concat path-iter-root-dir "/alice-1"))) + (list + path-iter-root-dir + (concat path-iter-root-dir "/alice-1"))) + + ))) + +(provide 'path-iterator-test) +;;; path-iterator.el ends here diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text new file mode 100644 index 0000000..86a25bf --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text @@ -0,0 +1 @@ +alice-1/bar-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text new file mode 100644 index 0000000..ede9208 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text @@ -0,0 +1 @@ +alice-1/bar-file2.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text new file mode 100644 index 0000000..d83a9f4 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text @@ -0,0 +1 @@ +alice-1/foo-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text new file mode 100644 index 0000000..70af0ae --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text @@ -0,0 +1 @@ +alice-1/foo-file2.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file1.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file1.text new file mode 100644 index 0000000..24ca29e --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file1.text @@ -0,0 +1 @@ +alice-2/bar-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file2.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file2.text new file mode 100644 index 0000000..e3d8e7b --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/bar-file2.text @@ -0,0 +1 @@ +alice-2/bar-file2.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file1.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file1.text new file mode 100644 index 0000000..ac4ffaa --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file1.text @@ -0,0 +1 @@ +alice-2/foo-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.text b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.text new file mode 100644 index 0000000..dbf803b --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.text @@ -0,0 +1 @@ +alice-2/foo-file3.text diff --git a/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.texts b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.texts new file mode 100644 index 0000000..124d83e --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Alice/alice-2/foo-file3.texts @@ -0,0 +1 @@ +This file name is a strict extension of foo-file3.text, to test a corner case diff --git a/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file1.text b/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file1.text new file mode 100644 index 0000000..ba2e142 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file1.text @@ -0,0 +1 @@ +bob-1/foo-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file2.text b/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file2.text new file mode 100644 index 0000000..6bd9bdb --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Bob/bob-1/foo-file2.text @@ -0,0 +1 @@ +bob-1/foo-file2.text diff --git a/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file1.text b/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file1.text new file mode 100644 index 0000000..754a1f1 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file1.text @@ -0,0 +1 @@ +bob-2/foo-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file5.text b/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file5.text new file mode 100644 index 0000000..2a3b1e9 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/Bob/bob-2/foo-file5.text @@ -0,0 +1 @@ +bob-2/foo-file5.text diff --git a/packages/uniquify-files/uniquify-files-resources/foo-file1.text b/packages/uniquify-files/uniquify-files-resources/foo-file1.text new file mode 100644 index 0000000..00b4928 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/foo-file1.text @@ -0,0 +1 @@ +foo-file1.text diff --git a/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2 b/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2 new file mode 100644 index 0000000..625ab98 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2 @@ -0,0 +1 @@ +This file name is a strict extension of alice-1/foo-file3.texts, but in a directory that is shorter diff --git a/packages/uniquify-files/uniquify-files-test.el b/packages/uniquify-files/uniquify-files-test.el new file mode 100644 index 0000000..59e4d47 --- /dev/null +++ b/packages/uniquify-files/uniquify-files-test.el @@ -0,0 +1,643 @@ +;;; uniquify-files-test.el - Test functions in uniquify-files.el -*- lexical-binding:t no-byte-compile:t -*- +;; +;; Copyright (C) 2017, 2019 Free Software Foundation, Inc. +;; +;; Author: Stephen Leake <stephen_le...@stephe-leake.org> +;; Maintainer: Stephen Leake <stephen_le...@stephe-leake.org> +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;;; +;; This is not a complete test of the completion style; the way the +;; completion functions interact with completing-read is not fully +;; tested. The following table gives useful test cases for a manual +;; interactive test (copy it to an org-mode buffer). +;; +;; | input | display | result | works/comment | +;; |-----------------------------------------------+--------------------------------------------------------------------------+-------------------------------------+-----------------------------------------------| +;; | "f-file1" <ret> | f-file1(foo-file1.text<){*>*, *A*lice/alice-1/>, *A*lice/alice-2>, ... } | <root>/foo-file1.text | works | +;; | "f-file1" <right> <ret> | f-file1(foo-file1.text<){*Alice/alice-1/>*. *A*lice/alice-2/>, ... } | <root>/Alice/alice-1/foo-file1.text | works | +;; | "f-file1" <right> <tab> <ret> | foo-file1.text<{*>*. *A*lice/alice-1/>. *A*lice/alice-2/>, ... } | <root>/foo-file1.text | works | +;; | "f-file1" <tab> <tab> <ret> | shows *Completion* buffer | <root>/foo-file1.text | works | +;; | "f-file1" <C-tab> <C-tab> <ret> | cycles foo-file1.text<> [Matched] | <root>/Alice/alice-1foo-file1.text | works | +;; | "f-file1<a-2" <ret> | f-file1<a-2 [Matched] | <root>/Alice/alice-2/foo-file1.text | works | +;; | "b-file2" <tab> <ret> | bar-file2.text<./alice-{*1*/> *2*/>} | <root>/Alice/alice-1/bar-file2.text | works except display has bad glyph (./alice-) | +;; | "b-file2" <tab> <tab> <ret> | bar-file2.text<Alice/alice-{1/> 2/>} | "" | works | +;; | "b-file2" <tab> <tab> <tab> <ret> | shows *Completion* buffer | "" | works | +;; | "f-file3" <ret> | f-file3(foo-file3.text) [Matched] | <root>/Alice/alice-2/foo-file3.text | works | +;; | "f-file3" <tab> <ret> | foo-file3.text [Matched] | <root>/Alice/alice-2/foo-file3.text | works | +;; | "fil" | fil (No matches) | - | works | +;; | "*-file1" <tab> <ret> | *-file1.text<{*f*oo-file1.text<*A*lice/alice-2/> ... } | <root>/Alice/alice-2/foo-file1.text | works | +;; | "*-file1" <tab> A <tab> 1 <tab> <ret> | *^-file1.text<Alice/alice-1/>{*bar-file1.text<Alice/alice-1/>*, ...} | <root>/Alice/alice-1/bar-file1.text | works | +;; | "*-file1" <tab> A <tab> 1 <tab> <del> f <tab> | foo-file1.text<Alice/alice-1/> [Matched] | <root>/Alice/alice-1/foo-file1.text | works | +;; | "foo-file1.text<Alice/alice-1> <ret> | foo-file1.text<Alice/alice-1(/>) [Matched] | "" | works | + + +;; See `test-uniquify-file-all-completions-face' below for an explanation of `no-byte-compile'. + +(require 'ert) +(require 'uniquify-files) + +(defconst uft-root + (concat + (file-name-directory (or load-file-name (buffer-file-name))) + "uniquify-files-resources")) + +(defconst uft-alice1 (concat uft-root "/Alice/alice-1")) +(defconst uft-alice2 (concat uft-root "/Alice/alice-2")) +(defconst uft-bob1 (concat uft-root "/Bob/bob-1")) +(defconst uft-bob2 (concat uft-root "/Bob/bob-2")) + +(defconst uft-iter + (make-path-iterator + :user-path-non-recursive + (list uft-root + uft-alice1 + uft-alice2 + uft-bob1 + uft-bob2))) + +(ert-deftest test-uniq-file-path-completion-table () + "Test basic functions of table." + ;; grouped by action + (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 . uniq-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-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)) + + + ;; This table does not implement try-completion + (should (equal (uniq-file-completion-table uft-iter "fi" nil nil) + nil)) + + ;; This table does not implement test-completion + (should (equal (uniq-file-completion-table uft-iter "fi" nil 'lambda) + nil)) + + ) + +(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") + ))) + + ) + +(ert-deftest test-uniq-file-test-completion () + (let ((table (apply-partially 'uniq-file-completion-table uft-iter))) + + (should (equal (test-completion "foo-fi" table) + nil)) + + (should (equal (test-completion "f-fi<dir" table) + nil)) + + (should (equal (test-completion "foo-file1.text<>" table) + t)) + + (should (equal (test-completion "foo-file1.text" table) + t)) + + (should (equal (test-completion "foo-file1.text<alice-1/>" table) + t)) + + (should (equal (test-completion "foo-file3.text" table) + t)) + + (should (equal (test-completion "foo-file3.texts" table) + t)) + + (should (equal (test-completion "foo-file3.texts2" table) + t)) + + (should (equal (test-completion "bar-file2.text<Alice/alice-" table) + nil)) + + )) + +(ert-deftest test-uniquify-file-all-completions-noface () + (let ((table (apply-partially 'uniq-file-completion-table uft-iter))) + + (should (equal + (sort (completion-uniquify-file-all-completions "" table nil nil) #'string-lessp) + (list + "bar-file1.text<alice-1/>" + "bar-file1.text<alice-2/>" + "bar-file2.text<alice-1/>" + "bar-file2.text<alice-2/>" + "foo-file1.text<>" + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + "foo-file2.text<Alice/alice-1/>" + "foo-file2.text<Bob/bob-1/>" + "foo-file3.text" + "foo-file3.texts" + "foo-file3.texts2" + "foo-file5.text" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "*-fi" table nil nil) #'string-lessp) + (list + "bar-file1.text<alice-1/>" + "bar-file1.text<alice-2/>" + "bar-file2.text<alice-1/>" + "bar-file2.text<alice-2/>" + "foo-file1.text<>" + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + "foo-file2.text<Alice/alice-1/>" + "foo-file2.text<Bob/bob-1/>" + "foo-file3.text" + "foo-file3.texts" + "foo-file3.texts2" + "foo-file5.text" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "b" table nil nil) #'string-lessp) + (list + "bar-file1.text<alice-1/>" + "bar-file1.text<alice-2/>" + "bar-file2.text<alice-1/>" + "bar-file2.text<alice-2/>" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "foo" table nil nil) #'string-lessp) + (list + "foo-file1.text<>" + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + "foo-file2.text<Alice/alice-1/>" + "foo-file2.text<Bob/bob-1/>" + "foo-file3.text" + "foo-file3.texts" + "foo-file3.texts2" + "foo-file5.text" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "f-file2" table nil nil) #'string-lessp) + (list + "foo-file2.text<Alice/alice-1/>" + "foo-file2.text<Bob/bob-1/>" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "b-fi<" table nil nil) #'string-lessp) + (list + "bar-file1.text<alice-1/>" + "bar-file1.text<alice-2/>" + "bar-file2.text<alice-1/>" + "bar-file2.text<alice-2/>" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "f-file<" table nil nil) #'string-lessp) + (list + "foo-file1.text<>" + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + "foo-file2.text<Alice/alice-1/>" + "foo-file2.text<Bob/bob-1/>" + "foo-file3.text" + "foo-file3.texts" + "foo-file3.texts2" + "foo-file5.text" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "b-fi<a-" table nil nil) #'string-lessp) + ;; FIXME: This result reflects a bug in + ;; `completion-pcm--pattern->regex'; "a-" becomes + ;; "a.*?-", but it should be (concat "a[^" + ;; wildcards "]*-". + (list + "bar-file1.text<Alice/alice-1/>" + "bar-file1.text<Alice/alice-2/>" + "bar-file2.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-2/>" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "b-fi<a-1" table nil nil) #'string-lessp) + (list "bar-file1.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-1/>"))) + + (should (equal (completion-uniquify-file-all-completions "f-file1.text<a-1" table nil nil) + (list "foo-file1.text<Alice/alice-1/>"))) + + (should (equal (completion-uniquify-file-all-completions "f-file5" table nil nil) + (list "foo-file5.text"))) + + (should (equal (completion-uniquify-file-all-completions "foo-file1.text<Alice/alice-1/>" table nil nil) + (list "foo-file1.text<Alice/alice-1/>"))) + + (should (equal + (sort (completion-uniquify-file-all-completions "b-fi<a>" table nil nil) #'string-lessp) + (list + "bar-file1.text<Alice/alice-1/>" + "bar-file1.text<Alice/alice-2/>" + "bar-file2.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-2/>" + ))) + + (should (equal + (sort (completion-uniquify-file-all-completions "foo-file1.text<>" table nil nil) #'string-lessp) + ;; This is complete but not unique, because the directory part matches multiple directories. + (list + "foo-file1.text<>" + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + ))) + )) + +(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." + (while pos-list + (let ((pos (pop pos-list))) + (put-text-property pos (1+ pos) 'face 'completions-first-difference string))) + string) + +(ert-deftest test-uniquify-file-all-completions-face () + ;; all-completions tested above without considering face text + ;; properties; here we test just those properties. Test cases are + ;; the same as above. + ;; + ;; FIXME: byte-compiling this test makes it fail; it appears to be + ;; sharing strings that should not be shared because they have + ;; different text properties. + (let ((table (apply-partially 'uniq-file-completion-table uft-iter))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "" table nil nil) #'string-lessp) + (list + (test-uniq-file-hilit '(0) "bar-file1.text<alice-1/>") + (test-uniq-file-hilit '(0) "bar-file1.text<alice-2/>") + (test-uniq-file-hilit '(0) "bar-file2.text<alice-1/>") + (test-uniq-file-hilit '(0) "bar-file2.text<alice-2/>") + (test-uniq-file-hilit '(0) "foo-file1.text<>") + (test-uniq-file-hilit '(0) "foo-file1.text<Alice/alice-1/>") + (test-uniq-file-hilit '(0) "foo-file1.text<Alice/alice-2/>") + (test-uniq-file-hilit '(0) "foo-file1.text<Bob/bob-1/>") + (test-uniq-file-hilit '(0) "foo-file1.text<Bob/bob-2/>") + (test-uniq-file-hilit '(0) "foo-file2.text<Alice/alice-1/>") + (test-uniq-file-hilit '(0) "foo-file2.text<Bob/bob-1/>") + (test-uniq-file-hilit '(0) "foo-file3.text") + (test-uniq-file-hilit '(0) "foo-file3.texts") + (test-uniq-file-hilit '(0) "foo-file3.texts2") + (test-uniq-file-hilit '(0) "foo-file5.text") + ))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "*-fi" table nil nil) #'string-lessp) + (list + (test-uniq-file-hilit '(0 8) "bar-file1.text<alice-1/>") + (test-uniq-file-hilit '(0 8) "bar-file1.text<alice-2/>") + (test-uniq-file-hilit '(0 8) "bar-file2.text<alice-1/>") + (test-uniq-file-hilit '(0 8) "bar-file2.text<alice-2/>") + (test-uniq-file-hilit '(0 8) "foo-file1.text<>") + (test-uniq-file-hilit '(0 8) "foo-file1.text<Alice/alice-1/>") + (test-uniq-file-hilit '(0 8) "foo-file1.text<Alice/alice-2/>") + (test-uniq-file-hilit '(0 8) "foo-file1.text<Bob/bob-1/>") + (test-uniq-file-hilit '(0 8) "foo-file1.text<Bob/bob-2/>") + (test-uniq-file-hilit '(0 8) "foo-file2.text<Alice/alice-1/>") + (test-uniq-file-hilit '(0 8) "foo-file2.text<Bob/bob-1/>") + (test-uniq-file-hilit '(0 8) "foo-file3.text") + (test-uniq-file-hilit '(0 8) "foo-file3.texts") + (test-uniq-file-hilit '(0 8) "foo-file3.texts2") + (test-uniq-file-hilit '(0 8) "foo-file5.text") + ))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "b" table nil nil) #'string-lessp) + (list + (test-uniq-file-hilit '(8) "bar-file1.text<alice-1/>") + (test-uniq-file-hilit '(8) "bar-file1.text<alice-2/>") + (test-uniq-file-hilit '(8) "bar-file2.text<alice-1/>") + (test-uniq-file-hilit '(8) "bar-file2.text<alice-2/>") + ))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "foo" table nil nil) #'string-lessp) + (list + (test-uniq-file-hilit '(8) "foo-file1.text<>") + (test-uniq-file-hilit '(8) "foo-file1.text<Alice/alice-1/>") + (test-uniq-file-hilit '(8) "foo-file1.text<Alice/alice-2/>") + (test-uniq-file-hilit '(8) "foo-file1.text<Bob/bob-1/>") + (test-uniq-file-hilit '(8) "foo-file1.text<Bob/bob-2/>") + (test-uniq-file-hilit '(8) "foo-file2.text<Alice/alice-1/>") + (test-uniq-file-hilit '(8) "foo-file2.text<Bob/bob-1/>") + (test-uniq-file-hilit '(8) "foo-file3.text") + (test-uniq-file-hilit '(8) "foo-file3.texts") + (test-uniq-file-hilit '(8) "foo-file3.texts2") + (test-uniq-file-hilit '(8) "foo-file5.text") + ))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "f-file2" table nil nil) #'string-lessp) + (list + (test-uniq-file-hilit '(15) "foo-file2.text<Alice/alice-1/>") + (test-uniq-file-hilit '(15) "foo-file2.text<Bob/bob-1/>") + ))) + + (should (equal-including-properties + (sort (completion-uniquify-file-all-completions "foo-file3.text" table nil nil) #'string-lessp) + (list + "foo-file3.text" + (test-uniq-file-hilit '(14) "foo-file3.texts") + (test-uniq-file-hilit '(14) "foo-file3.texts2") + ))) + + )) + +(ert-deftest test-uniquify-file-try-completion () + (let ((table (apply-partially 'uniq-file-completion-table uft-iter)) + string) + + (setq string "fo") + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("foo-file" . 8))) + + (setq string "b") + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("bar-file" . 8))) + + (setq string "fo<al") + (should (equal (completion-uniquify-file-try-completion string table nil 2) + '("foo-file<Alice/" . 8))) + (should (equal (completion-uniquify-file-try-completion string table nil 5) + '("foo-file<Alice/" . 15))) + + (setq string "foo-file3") ;; not unique, not valid + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("foo-file3.text" . 14))) + + (setq string "f-file1.text<a-1") ;; unique but not valid + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("foo-file1.text<Alice/alice-1/>" . 30))) + + (setq string "foo-file1.text") ;; valid but not unique + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + (cons "foo-file1.text<" 15))) + + (setq string "foo-file1<") ;; not valid + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + (cons "foo-file1.text<" 15))) + + (setq string "foo-file1.text<>") ;; valid but not unique + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + (cons "foo-file1.text<>" 15))) + + (setq string "foo-file1.text<alice-1/>") ;; valid and unique + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + t)) + + (setq string "foo-file3.texts") ;; not unique, valid + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("foo-file3.texts" . 15))) + + (setq string "foo-file3.texts2") ;; unique and valid + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + t)) + + (setq string "fil2") ;; misspelled + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + nil)) + + ;; User input sequence: b-file2 + (setq string "b-file2") + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("bar-file2.text<alice-" . 21))) + + ;; prev + <tab>; input is prev output + (setq string "bar-file2.text<alice-") + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("bar-file2.text<Alice/alice-" . 27))) + + ;; prev + <tab>; input is prev output + (setq string "bar-file2.text<Alice/alice-") + (should (equal (completion-uniquify-file-try-completion string table nil (length string)) + '("bar-file2.text<Alice/alice-" . 27))) + + ;; completion-try-completion called from icomplete-completions with + ;; result of all-completions instead of table function, but with table metadata. + (setq string "f-file<") + (let ((comps (completion-uniquify-file-all-completions string table nil nil))) + (should (equal (completion-uniquify-file-try-completion string comps nil (length string)) + (cons "foo-file" 8)))) + )) + +(ert-deftest test-uniquify-file-get-data-string () + (let ((table (apply-partially 'uniq-file-completion-table uft-iter))) + + (should (equal (completion-uniquify-file-get-data-string "foo-file1.text<alice-1>" table nil) + (concat uft-alice1 "/foo-file1.text"))) + + (should (equal (completion-uniquify-file-get-data-string "foo-file3.text" table nil) + (concat uft-alice2 "/foo-file3.text"))) + + (should (equal (completion-uniquify-file-get-data-string "foo-file3.texts" table nil) + (concat uft-alice2 "/foo-file3.texts"))) + + (should (equal (completion-uniquify-file-get-data-string "foo-file3.texts2" table nil) + (concat uft-root "/foo-file3.texts2"))) + )) + +(ert-deftest test-uniq-file-normalize () + (should (equal (uniq-file-normalize "fi") + "fi")) + + (should (equal (uniq-file-normalize "fi<di") + "di/fi")) + + (should (equal (uniq-file-normalize "foo-file1.text") + "foo-file1.text")) + + (should (equal (uniq-file-normalize "file1<Alice/alice-2/>") + "Alice/alice-2/file1")) + + (should (equal (uniq-file-normalize "file1<>") + "file1")) + + (should (equal (uniq-file-normalize "file1.text<Alice/alice-2/>") + "Alice/alice-2/file1.text")) + + (should (equal (uniq-file-normalize "bar-file2.text<Alice/alice-") + "Alice/alice-/bar-file2.text")) + + ) + +(ert-deftest test-uniq-file-uniquify () + (should (equal (uniq-file-uniquify + '("/Alice/alice1/file1.text" "/Alice/alice1/file2.text" + "/Alice/alice2/file1.text" "/Alice/alice2/file3.text" + "/Bob/bob1/file1.text") + nil) + (list "file1.text<Alice/alice1/>" + "file1.text<Alice/alice2/>" + "file1.text<Bob/bob1/>" + "file2.text" + "file3.text"))) + + (should (equal (uniq-file-uniquify '("/Alice/alice1/file1.text" "/Alice/alice2/file1.text") nil) + (list "file1.text<alice1/>" "file1.text<alice2/>"))) + + (should (equal (uniq-file-uniquify '("/alice1/file2.text") nil) + (list "file2.text"))) + + (should (equal (uniq-file-uniquify + '("c:/tmp/test/alice-1/bar-file1.text" + "c:/tmp/test/alice-1/bar-file2.text") + "a-1") + (list "bar-file1.text<alice-1/>" "bar-file2.text<alice-1/>"))) + + (should (equal (uniq-file-uniquify + '("c:/tmp/Alice/alice-1/bar-file1.text" + "c:/tmp/Alice/alice-1/bar-file2.text" + "c:/tmp/Alice/alice-2/bar-file2.text") + "a-") + + ;; FIXME: This result reflects a bug in + ;; `completion-pcm--pattern->regex'; "a-" becomes + ;; "a.*?-", but it should be (concat "a[^" + ;; wildcards "]*-". + + (list "bar-file1.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-2/>"))) + + (should (equal (uniq-file-uniquify + '("c:/tmp/Alice/alice-1/bar-file1.text" + "c:/tmp/Alice/alice-1/bar-file2.text" + "c:/tmp/Alice/alice-2/bar-file2.text") + "Al/a-") + (list "bar-file1.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-1/>" + "bar-file2.text<Alice/alice-2/>"))) + + ;; From "foo-file1.text<>" + (should (equal (uniq-file-uniquify + (list + (concat uft-alice1 "/foo-file1.text") + (concat uft-alice2 "/foo-file1.text") + (concat uft-bob1 "/foo-file1.text") + (concat uft-bob2 "/foo-file1.text") + (concat uft-root "/foo-file1.text") + ) + "") + '( + "foo-file1.text<Alice/alice-1/>" + "foo-file1.text<Alice/alice-2/>" + "foo-file1.text<Bob/bob-1/>" + "foo-file1.text<Bob/bob-2/>" + "foo-file1.text<>" + ))) + + ;; from cedet-global-test + (should (equal (uniq-file-uniquify + (list + (concat uft-alice1 "/bar-file1.c") + (concat uft-alice1 "/bar-file2.c") + (concat uft-alice2 "/bar-file1.c") + (concat uft-alice2 "/bar-file2.c") + (concat uft-bob1 "/foo-file1.c") ;; 'b' in directory part; accidental match + (concat uft-bob1 "/foo-file2.c") + (concat uft-bob2 "/foo-file1.c") + (concat uft-bob2 "/foo-file5.c") + ) + nil) + '( + "bar-file1.c<alice-1/>" + "bar-file1.c<alice-2/>" + "bar-file2.c<alice-1/>" + "bar-file2.c<alice-2/>" + "foo-file1.c<bob-1/>" + "foo-file1.c<bob-2/>" + "foo-file2.c" + "foo-file5.c" + ))) + ) + +(provide 'uniquify-files-test) +;;; uniquify-files-test.el ends here diff --git a/packages/uniquify-files/uniquify-files.el b/packages/uniquify-files/uniquify-files.el index 6f23bf4..4b28644 100644 --- a/packages/uniquify-files/uniquify-files.el +++ b/packages/uniquify-files/uniquify-files.el @@ -7,7 +7,7 @@ ;; Keywords: completion table ;; uniquify ;; Version: 0 -;; package-requires: ((emacs "25.0")) +;; package-requires: ((emacs "25.0") (path-iterator "1.0")) ;; ;; This file is part of GNU Emacs. ;; @@ -103,9 +103,12 @@ ;; the string replaces the string typed by the user, so it must be ;; in this format. ;; -;; The displayed completion list consists of the strings returned by -;; `completion-all-completions' with the common prefix deleted; -;; `completion-all-completions' must return strings in this format. +;; The text displayed by `completing-read' consists of the current +;; input string followed by a completion list. The completion list +;; consists of the strings returned by `completion-all-completions' +;; with the common prefix deleted (the common prefix is in the +;; completion string); `completion-all-completions' must return +;; strings in this format. ;; ;; When the user selects a displayed completion, the string is ;; passed to `test-completion'; it must accept strings in this format @@ -160,13 +163,6 @@ (require 'cl-lib) (require 'path-iterator) -(defvar uniquify-files-style 'abbrev - ;; FIXME: change to defcustom - "Style used to format uniquifying directories. -One of: -- 'abbrev : minimal directories required to identify a unique file (may be empty) -- 'full : absolute directory path or empty") - (defconst uniq-files-regexp "^\\(.*\\)<\\([^>]*\\)>?$" ;; The trailing '>' is optional so the user can type "<dir" in the ;; input buffer to complete directories. @@ -245,10 +241,7 @@ Match 1 is the filename, match 2 is the relative directory.") (when (not (string-equal dir1 first-non-common)) (setq non-common (concat dir1 "/" non-common))))) - (concat (file-name-nondirectory name) - "<" - non-common - ">"))) + (concat (file-name-nondirectory name) "<" non-common ">"))) conflicts) )) @@ -262,37 +255,32 @@ include at least the completion of DIR. If DIR is non-nil, all elements of NAMES must match DIR." (when names - (cl-ecase uniquify-files-style - (abbrev - (let (result - conflicts ;; list of names where all non-directory names are the same. - ) - - ;; Sort names so duplicates are grouped together - (setq names (sort names (lambda (a b) - (string< (file-name-nondirectory a) (file-name-nondirectory b))))) - - (while names - (setq conflicts (list (pop names))) - (while (and names - (string= (file-name-nondirectory (car conflicts)) (file-name-nondirectory (car names)))) - (push (pop names) conflicts)) - - (if (= 1 (length conflicts)) - (let ((completed-dir (and dir (uniq-file-dir-match dir (file-name-directory (car conflicts)))))) - (push - (if completed-dir - (concat (file-name-nondirectory (car conflicts)) "<" completed-dir ">") - (concat (file-name-nondirectory (car conflicts)))) - result)) - - (setq result (append (uniq-files-conflicts conflicts dir) result))) - ) - (nreverse result) - )) - - (full - names) + (let (result + conflicts ;; list of names where all non-directory names are the same. + ) + + ;; Sort names so duplicates are grouped together + (setq names (sort names (lambda (a b) + (string< (file-name-nondirectory a) (file-name-nondirectory b))))) + + (while names + (setq conflicts (list (pop names))) + (while (and names + (string= (file-name-nondirectory (car conflicts)) (file-name-nondirectory (car names)))) + (push (pop names) conflicts)) + + (if (= 1 (length conflicts)) + (let ((completed-dir (and dir (uniq-file-dir-match dir (file-name-directory (car conflicts)))))) + (push + (if completed-dir + (concat (file-name-nondirectory (car conflicts)) "<" completed-dir ">") + + (concat (file-name-nondirectory (car conflicts)))) + result)) + + (setq result (append (uniq-files-conflicts conflicts dir) result))) + ) + (nreverse result) ))) (defun uniq-file-normalize (user-string) @@ -350,11 +338,7 @@ STRING should be in completion table input format." ;; Find merged completion of uniqified file names (let* ((uniq-all (uniq-file-uniquify abs-all (file-name-directory table-string))) (completion-pcm--delim-wild-regex - (cl-ecase uniquify-files-style - (abbrev - (concat "[" completion-pcm-word-delimiters "<>*]")) - (full - completion-pcm--delim-wild-regex))) + (concat "[" completion-pcm-word-delimiters "<>*]")) (pattern (completion-pcm--string->pattern string point)) (merged-pat (completion-pcm--merge-completions uniq-all pattern)) @@ -397,11 +381,7 @@ STRING should be in completion table input format." ;; Find merged completion of uniqified file names (let* ((completion-pcm--delim-wild-regex - (cl-ecase uniquify-files-style - (abbrev - (concat "[" completion-pcm-word-delimiters "<>*]")) - (full - 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. (trimmed-string @@ -443,12 +423,7 @@ character after each completion field." ;; IMPROVEME: duplicates `completion-uniquify-file-try-completion'; ;; consider refactor and cache. (let* ((completion-pcm--delim-wild-regex - (cl-ecase uniquify-files-style - (abbrev - (concat "[" completion-pcm-word-delimiters "<>*]")) - (full - 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. (trimmed-string @@ -709,3 +684,4 @@ In the user input string, `*' is treated as a wildcard." ) (provide 'uniquify-files) +;;; uniquify-files.el ends here