branch: master
commit b3034e07ecac291b2d368c4a9ba115986dd4797c
Author: Stephen Leake <stephen_le...@stephe-leake.org>
Commit: Stephen Leake <stephen_le...@stephe-leake.org>
In uniquify-files, rewrite to use an alist, clean up tests to match
* packages/uniquify-files/file-complete-root-relative-test.el: Delete.
* packages/uniquify-files/file-complete-root-relative.el: Delete.
* packages/uniquify-files/file-complete.el: Delete.
* packages/uniquify-files/uniquify-files-resources/
wisitoken-generate-packrat-test.text: New file.
* packages/uniquify-files/uniquify-files-resources/
wisitoken-syntax_trees-test.text: New file.
* packages/uniquify-files/uniquify-files-resources/
wisitoken-text_io_trace.text: New file.
* packages/uniquify-files/uniquify-files-test.el (uft-path): Delete
dependence on path-iterator. Simplify tests to work with rewritten
uniquify-files.
* packages/uniquify-files/uniquify-files.el: Rewrite to use alist of abs
. uniquified.
(uniq-file-read): New for Emacs 27 project.el.
---
.../file-complete-root-relative-test.el | 271 ---------
.../uniquify-files/file-complete-root-relative.el | 324 ----------
packages/uniquify-files/file-complete.el | 192 ------
.../wisitoken-generate-packrat-test.text | 1 +
.../wisitoken-syntax_trees-test.text | 1 +
.../wisitoken-text_io_trace.text | 1 +
packages/uniquify-files/uniquify-files-test.el | 672 ++++++++-------------
packages/uniquify-files/uniquify-files.el | 598 ++++--------------
8 files changed, 350 insertions(+), 1710 deletions(-)
diff --git a/packages/uniquify-files/file-complete-root-relative-test.el
b/packages/uniquify-files/file-complete-root-relative-test.el
deleted file mode 100644
index 8b44d92..0000000
--- a/packages/uniquify-files/file-complete-root-relative-test.el
+++ /dev/null
@@ -1,271 +0,0 @@
-;;; file-complete-root-relative-test.el - Test for
file-complete-root-relative.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/>.
-
-(require 'ert)
-(require 'uniquify-files-test) ;; We share the test directory tree.
-(require 'file-complete-root-relative)
-
-(defconst fc-root-rel-iter (make-path-iterator :user-path-recursive (list
uft-root)))
-
-(defconst fc-root-rel-file-list
- (list
- (concat uft-root "/foo-file1.text")
- (concat uft-root "/foo-file3.texts2")
- (concat uft-root "/Alice/alice-1/bar-file1.text")
- (concat uft-root "/Alice/alice-1/bar-file2.text")
- (concat uft-root "/Alice/alice-1/foo-file1.text")
- (concat uft-root "/Alice/alice-1/foo-file2.text")
- (concat uft-root "/Alice/alice-2/bar-file1.text")
- (concat uft-root "/Alice/alice-2/bar-file2.text")
- (concat uft-root "/Alice/alice-2/foo-file1.text")
- (concat uft-root "/Alice/alice-2/foo-file3.text")
- (concat uft-root "/Alice/alice-2/foo-file3.texts")
- (concat uft-root "/Alice/alice-3/foo-file4.text")
- (concat uft-root "/Bob/alice-3/foo-file4.text")
- (concat uft-root "/Bob/bob-1/foo-file1.text")
- (concat uft-root "/Bob/bob-1/foo-file2.text")
- (concat uft-root "/Bob/bob-2/foo-file1.text")
- (concat uft-root "/Bob/bob-2/foo-file5.text")
- ))
-
-(ert-deftest test-fc-root-rel-completion-table-iter ()
- "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 (file-name-as-directory uft-root))))))
- )
-
-(ert-deftest test-fc-root-rel-completion-table-list ()
- "Test basic functions of table."
- ;; grouped by action
- (should (equal (fc-root-rel-completion-table-list fc-root-rel-file-list
uft-root "fi" nil '(boundaries . ".text"))
- '(boundaries . (0 . 5))))
-
- (should (equal (fc-root-rel-completion-table-list fc-root-rel-file-list
uft-root "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-list
fc-root-rel-file-list uft-root "" 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-list
- fc-root-rel-file-list uft-root "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-list fc-root-rel-file-list
uft-root "uft-alice1/file1.text" nil t)
- ;; misspelled; no match
- nil))
-
- ;; This table does not implement try-completion
- (should (equal (fc-root-rel-completion-table-list fc-root-rel-file-list
uft-root "fi" nil nil)
- nil))
-
- ;; test-completion
- (should (equal (fc-root-rel-completion-table-list
- fc-root-rel-file-list uft-root
- (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
- )
-
-(defun test-fc-root-rel-test-completion-1 (table)
- ;; In normal operation, 'all-completions' is called before
- ;; 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 "dir/f-fi" table)
- nil))
-
- (should (equal (test-completion "foo-file1.text" table)
- t)) ;; starts at root
-
- (should (equal (test-completion "alice-1/foo-file1.text" table)
- nil)) ;; does not start at root
-
- (should (equal (test-completion "Alice/alice-1/foo-file1.text" table)
- t)) ;; starts at root
-
- (should (equal (test-completion "foo-file3.text" table)
- nil))
-
- (should (equal (test-completion "foo-file3.texts2" table)
- t))
-
- (should (equal (test-completion "Alice/alice-/bar-file2.text" table)
- nil))
-
- (should (equal (test-completion "Alice/alice-1/bar-file2.text" table)
- t))
- ))
-
-(ert-deftest test-fc-root-rel-test-completion-iter ()
- (let ((table (apply-partially 'fc-root-rel-completion-table-iter
fc-root-rel-iter))
- (completion-category-overrides '(project-file (styles .
file-root-rel))))
- (test-fc-root-rel-test-completion-1 table)))
-
-(ert-deftest test-fc-root-rel-test-completion-list ()
- (let ((table (apply-partially 'fc-root-rel-completion-table-list
fc-root-rel-file-list uft-root))
- (completion-category-overrides '(project-file (styles .
file-root-rel))))
- (test-fc-root-rel-test-completion-1 table)))
-
-(defun test-fc-root-rel-all-completions-noface-1 (table)
- (should (equal
- (sort (fc-root-rel-all-completions "" table nil nil) #'string-lessp)
- (list
- "Alice/alice-1/bar-file1.text"
- "Alice/alice-1/bar-file2.text"
- "Alice/alice-1/foo-file1.text"
- "Alice/alice-1/foo-file2.text"
- "Alice/alice-2/bar-file1.text"
- "Alice/alice-2/bar-file2.text"
- "Alice/alice-2/foo-file1.text"
- "Alice/alice-2/foo-file3.text"
- "Alice/alice-2/foo-file3.texts"
- "Alice/alice-3/foo-file4.text"
- "Bob/alice-3/foo-file4.text"
- "Bob/bob-1/foo-file1.text"
- "Bob/bob-1/foo-file2.text"
- "Bob/bob-2/foo-file1.text"
- "Bob/bob-2/foo-file5.text"
- "foo-file1.text"
- "foo-file3.texts2"
- )))
-
- (should (equal
- (sort (fc-root-rel-all-completions "*-fi" table nil nil)
#'string-lessp)
- (list
- "Alice/alice-1/bar-file1.text"
- "Alice/alice-1/bar-file2.text"
- "Alice/alice-1/foo-file1.text"
- "Alice/alice-1/foo-file2.text"
- "Alice/alice-2/bar-file1.text"
- "Alice/alice-2/bar-file2.text"
- "Alice/alice-2/foo-file1.text"
- "Alice/alice-2/foo-file3.text"
- "Alice/alice-2/foo-file3.texts"
- "Alice/alice-3/foo-file4.text"
- "Bob/alice-3/foo-file4.text"
- "Bob/bob-1/foo-file1.text"
- "Bob/bob-1/foo-file2.text"
- "Bob/bob-2/foo-file1.text"
- "Bob/bob-2/foo-file5.text"
- "foo-file1.text"
- "foo-file3.texts2"
- )))
-
- (should (equal
- (sort (fc-root-rel-all-completions "b" table nil nil) #'string-lessp)
- nil))
-
- (let ((completion-ignore-case t))
- (should (equal
- (sort (fc-root-rel-all-completions "b" table nil nil)
#'string-lessp)
- (list
- "Bob/alice-3/foo-file4.text"
- "Bob/bob-1/foo-file1.text"
- "Bob/bob-1/foo-file2.text"
- "Bob/bob-2/foo-file1.text"
- "Bob/bob-2/foo-file5.text"
- )))
- )
-
- (should (equal
- (sort (fc-root-rel-all-completions "*/foo" table nil nil)
#'string-lessp)
- (list
- "Alice/alice-1/foo-file1.text"
- "Alice/alice-1/foo-file2.text"
- "Alice/alice-2/foo-file1.text"
- "Alice/alice-2/foo-file3.text"
- "Alice/alice-2/foo-file3.texts"
- "Alice/alice-3/foo-file4.text"
- "Bob/alice-3/foo-file4.text"
- "Bob/bob-1/foo-file1.text"
- "Bob/bob-1/foo-file2.text"
- "Bob/bob-2/foo-file1.text"
- "Bob/bob-2/foo-file5.text"
- )))
-
- (should (equal
- (sort (fc-root-rel-all-completions "Alice/alice-1/" table nil nil)
#'string-lessp)
- (list
- "Alice/alice-1/bar-file1.text"
- "Alice/alice-1/bar-file2.text"
- "Alice/alice-1/foo-file1.text"
- "Alice/alice-1/foo-file2.text"
- )))
-
- (should (equal
- (sort (fc-root-rel-all-completions "Alice/alice-1/f-file2" table nil
nil) #'string-lessp)
- (list
- "Alice/alice-1/foo-file2.text"
- )))
- )
-
-(ert-deftest test-fc-root-rel-all-completions-noface-iter ()
- (let ((table (apply-partially 'fc-root-rel-completion-table-iter
fc-root-rel-iter))
- (completion-category-overrides '(project-file (styles . file-root-rel)))
- (completion-ignore-case nil))
- (test-fc-root-rel-all-completions-noface-1 table)))
-
-(ert-deftest test-fc-root-rel-all-completions-noface-list ()
- (let ((table (apply-partially 'fc-root-rel-completion-table-list
fc-root-rel-file-list uft-root))
- (completion-category-overrides '(project-file (styles . file-root-rel)))
- (completion-ignore-case nil))
- (test-fc-root-rel-all-completions-noface-1 table)))
-
-(provide 'file-complete-root-relative-test)
-;;; file-complete-root-relative-test.el ends here
diff --git a/packages/uniquify-files/file-complete-root-relative.el
b/packages/uniquify-files/file-complete-root-relative.el
deleted file mode 100644
index 14d1b1f..0000000
--- a/packages/uniquify-files/file-complete-root-relative.el
+++ /dev/null
@@ -1,324 +0,0 @@
-;;; file-complete-root-relative.el --- Completion style for files -*-
lexical-binding:t -*-
-;;
-;; Copyright (C) 2019 Free Software Foundation, Inc.
-;;
-;; Author: Stephen Leake <stephen_le...@stephe-leake.org>
-;; Maintainer: Stephen Leake <stephen_le...@stephe-leake.org>
-;; Keywords: completion
-;; Version: 0
-;; package-requires: ((emacs "25.0"))
-;;
-;; 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
-
-;; A file completion style in which the root directory is left out of
-;; the completion string displayed to the user.
-;;
-;; Following the Design section in uniquify-files.el, this completion
-;; style has the following string formats:
-;;
-;; - user: file name relative to a root directory
-;;
-;; - completion table input: same as user
-;;
-;; - data: absolute file name
-;;
-;; The completion style requires knowlege of the root directory;
-;; currently, this requires use of a completion function to provide a
-;; place to store it.
-
-(require 'cl-lib)
-
-(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 _table _pred)
- "Implement `completion-to-table-input' for file-root-rel."
- user-string)
-
-(defun fc-root-rel-to-data (user-string table _pred)
- "Implement `completion-get-data-string' for file-root-rel."
- ;; We assume USER-STRING is complete and unique.
- (let ((root (fc-root-rel--root table)))
- (concat root user-string)))
-
-(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, which ends in /
- (let ((prefix-length (length root)))
- (mapcar
- (lambda (abs-file-name)
- (substring abs-file-name prefix-length))
- data-string-list)
- ))
-
-(defun fc-root-rel--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
- (concat "[" completion-pcm-word-delimiters "*]"))
- (pattern (completion-pcm--string->pattern string point)))
- (completion-pcm--merge-completions all pattern)
- ))
-
-(defun fc-root-rel-try-completion (string table pred point)
- "Implement `completion-try-completion' for file-root-rel."
- ;; 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)
- (setq rel-all (fc-root-rel-all-completions string table pred point))
-
- (cond
- ((null rel-all) ;; No matches.
- (setq result nil)
- (setq done t))
-
- ((= 1 (length rel-all)) ;; One match; unique.
- (setq done t)
-
- ;; Check for valid completion
- (if (string-equal string (car rel-all))
- (setq result t)
-
- (setq result (car rel-all))
- (setq result (cons result (length result)))))
-
- (t ;; Multiple matches
- (setq done nil))
- ))
-
- ;; The following cases handle being called from
- ;; icomplete-completions with the result of `all-completions'
- ;; instead of the real table function. TABLE is a list of
- ;; relative file names.
-
- ((null table) ;; No matches.
- (setq result nil)
- (setq done t))
-
- (t
- (setq rel-all table)
- (setq done nil))
- )
-
- (if done
- result
-
- ;; Find merged completion of relative file names
- (let* ((merged-pat (fc-root-rel--pcm-merged-pat string rel-all point))
-
- ;; `merged-pat' is in reverse order. Place new point at:
- (point-pat (or (memq 'point merged-pat) ;; the old point
- (memq 'any merged-pat) ;; a place where there's
something to choose
- (memq 'star merged-pat) ;; ""
- merged-pat)) ;; the end
-
- ;; `merged-pat' does not contain 'point when the field
- ;; containing 'point is fully completed.
-
- (new-point (length (completion-pcm--pattern->string point-pat)))
-
- ;; Compute this after `new-point' because `nreverse'
- ;; changes `point-pat' by side effect.
- (merged (completion-pcm--pattern->string (nreverse merged-pat))))
-
- (cons merged new-point)))
- ))
-
-(defun fc-root-rel--hilit (string all point)
- "Apply face text properties to each element of ALL.
-STRING is the current user input.
-ALL is a list of strings in user format.
-POINT is the position of point in STRING.
-Returns new list.
-
-Adds the face `completions-first-difference' to the first
-character after each completion field."
- (let* ((merged-pat (nreverse (fc-root-rel--pcm-merged-pat string all point)))
- (field-count 0)
- (regex (completion-pcm--pattern->regex merged-pat '(any star any-delim
point)))
- )
- (dolist (x merged-pat)
- (when (not (stringp x))
- (setq field-count (1+ field-count))))
-
- (mapcar
- (lambda (str)
- (when (string-match regex str)
- (cl-loop
- for i from 1 to field-count
- do
- (when (and
- (match-beginning i)
- (<= (1+ (match-beginning i)) (length str)))
- (put-text-property (match-beginning i) (1+ (match-beginning i))
'face 'completions-first-difference str))
- ))
- str)
- all)))
-
-(defun fc-root-rel-all-completions (user-string table pred point)
- "Implement `completion-all-completions' for root-relative."
- ;; Returns list of data format strings (abs file names).
-
- (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)))
- (setq all (fc-root-rel--hilit user-string all point))
- all
- )))
-
-(defun fc-root-rel-completion-table-iter (path-iter string pred action)
- "Implement a completion table for file names in PATH-ITER.
-
-PATH-ITER is a `path-iterator' object; it must have exacly one
-recursive root, and no non-recursive roots.
-
-STRING, PRED, ACTION are completion table arguments."
-
- (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))))
-
- (t
- (file-complete-completion-table path-iter 'root-relative root string
pred action))
- )))
-
-(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
- (substring (completion-pcm--pattern->regex pattern) 2);; trim \`
- )))
-
-(defun fc-root-rel-completion-table-list (file-list root string pred action)
- "Implement a completion table for file names in FILE-LIST,
-with common prefix ROOT.
-
-STRING, PRED, ACTION are completion table arguments."
-
- ;; This completion table function is required to provide access to
- ;; ROOT via metadata, and the file-root-rel suggested style.
-
- ;; `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
- fc-root-rel-try-completion
- fc-root-rel-all-completions
- "root relative hierarchical filenames."
- fc-root-rel-to-table-input ;; 4 user to table input format
- fc-root-rel-to-data)) ;; 5 user to data format
-
-(defun locate-root-rel-file-iter (iter &optional predicate default prompt)
- "Return an absolute filename, with file-root-rel completion style.
-ITER is a path-iterator giving the directory path to search; it
-must have exacly one recursive root, and no non-recursive roots.
-If PREDICATE is nil, it is ignored. If non-nil, it must be a
-function that takes one argument; the absolute file name. The
-file name is included in the result if PRED returns
-non-nil. DEFAULT is the default for completion.
-
-In the user input string, `*' is treated as a wildcard."
- (let* ((table (apply-partially #'fc-root-rel-completion-table-iter iter))
- (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
- (completion-category-overrides
- (list (list 'project-file (cons 'styles table-styles)))))
-
- (unless (and (= 0 (length (path-iter-path-non-recursive-init iter)))
- (= 1 (length (path-iter-path-recursive-init iter))))
- (user-error "iterator does not have exactly one recursive root"))
-
- (completing-read (format (concat (or prompt "file") " (%s): ") default)
- table
- predicate t nil nil default)
- ))
-
-;; For example:
-;; (locate-root-rel-file-iter
-;; (make-path-iterator
-;; :user-path-non-recursive nil
-;; :user-path-recursive
"c:/Projects/elpa/packages/uniquify-files/uniquify-files-resources"))
-
-(provide 'file-complete-root-relative)
-;;; file-complete-root-relative.el ends here
diff --git a/packages/uniquify-files/file-complete.el
b/packages/uniquify-files/file-complete.el
deleted file mode 100644
index 5a498e8..0000000
--- a/packages/uniquify-files/file-complete.el
+++ /dev/null
@@ -1,192 +0,0 @@
-;;; file-complete.el --- core utilities for various file-completion styles and
tables. -*-lexical-binding:t-*-
-
-(defconst file-complete-match-styles '(absolute root-relative basename)
- "Filename matching styles supported by `file-complete-completion-table'.
-
-- absolute - match entire string against absolute file names,
- anchored at the string beginning.
-
-- root-relative - match entire string against file name relative
- to a constant root.
-
-- basename - match basename portion of string against basename
- portion of file names, and also directory name portions, not anchored.
- For example, \"foo/c\" will match \"/root/foo/bar/car.text\".")
-
-(defun file-complete--iter-pcm-regex (string match-style root)
- "Return dir and file regexes constructed from STRING (a partial file name)."
- ;; `file-complete-completion-table' matches against directories from a
- ;; `path-iterator', and files within those directories. Thus we
- ;; construct two regexps from `string'.
- (let* ((dir-name (file-name-directory string)) ;; nil, or ends in /
- (file-name (file-name-nondirectory string))
-
- (file-pattern (completion-pcm--string->pattern file-name))
- (file-regex (completion-pcm--pattern->regex file-pattern))
-
- (dir-pattern (and dir-name (completion-pcm--string->pattern dir-name)))
-
- (dir-regex
- (cl-ecase match-style
- (absolute
- (completion-pcm--pattern->regex dir-pattern))
-
- (root-relative
- (cond
- ((null dir-name)
- (if (= 0 (length file-name))
- (concat "\\`" root)
- (concat "\\`" root
- (when (eq (car file-pattern) 'star) ".*?")
- "\\(" (substring
- (completion-pcm--pattern->regex
- (append file-pattern (list 'star)))
- 2) ;; strip \`
- "\\)?\\'")))
-
- (t
- (concat root
- (substring (completion-pcm--pattern->regex dir-pattern)
2) ;; strip \`
- (if (= 0 (length file-name))
- ""
- (concat
- "\\("
- ;; The non-directory portion of STRING may
- ;; be intended to match the next directory
- ;; level.
- (substring (completion-pcm--pattern->regex
file-pattern) 2) ;; strip \`
- "\\)?"))))
- ))
-
- (basename
- (substring (completion-pcm--pattern->regex dir-pattern) 2)) ;;
strip \`
- )))
- (list dir-regex file-regex)))
-
-(defun file-complete-completion-table (path-iter match-style root string pred
action)
- "Implement a completion table for file names in PATH-ITER.
-
-PATH-ITER is a `path-iterator' object. It will be restarted for
-each call to `file-complete-completion-table'.
-
-MATCH-STYLE is one of `file-complete-match-styles', which see.
-ROOT is only non-nil for root-relative.
-
-STRING, PRED, ACTION are completion table arguments:
-
-STRING is a partial file name. `*' is treated as a wildcard, as
-in a shell glob pattern.
-
-If PRED is nil, it is ignored. If non-nil, it must be a function
-that takes one argument; the absolute file name. The file name
-is included in the result if PRED returns non-nil. In either
-case, `completion-ignored-extensions', `completion-regexp-list',
-`completion-ignore-case' are used as described in
-`file-name-all-completions'.
-
-ACTION is the current completion action; one of:
-
-- nil; return common prefix of all completions of STRING, nil or
- t; see `try-completion'.
-
-- t; return all completions; see `all-completions'
-
-- lambda; return non-nil if string is a valid completion; see
- `test-completion'.
-
-- '(boundaries . SUFFIX); return the completion region
- '(boundaries START . END) within STRING; see
- `completion-boundaries'.
-
-- 'metadata; return (metadata . ALIST) as defined by
- `completion-metadata'."
-
- (cl-assert (memq match-style file-complete-match-styles))
-
- (cond
- ((eq (car-safe action) 'boundaries)
- ;; We don't use boundaries; return the default definition.
- (cons 'boundaries
- (cons 0 (length (cdr action)))))
-
- ((eq action 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- )))
-
- ((memq action
- '(nil ;; Called from `try-completion'.
- lambda ;; Called from `test-completion'.
- t)) ;; Called from `all-completions'.
-
- ;; In file-name-all-completions, `completion-regexp-list', is
- ;; matched against file names and directories relative to `dir'.
- ;; Thus to handle partial completion delimiters in `string', we
- ;; construct two regexps from `string'; one from the directory
- ;; portion, and one from the non-directory portion. We use the
- ;; directory regexp here, and pass the non-directory regexp to
- ;; `file-name-all-completions' via `completion-regexp-list'. The
- ;; `string' input to `file-name-all-completions' is redundant with
- ;; the regexp, so we always build a regexp, and pass an empty
- ;; string.
-
- (pcase-let ((`(,dir-regex ,file-regex)
- (file-complete--iter-pcm-regex string match-style root)))
- (let ((result nil))
-
- (path-iter-restart path-iter)
-
- (let ((case-fold-search completion-ignore-case)
- dir)
- (while (setq dir (path-iter-next path-iter))
- (when (string-match dir-regex dir)
- ;; A project that deals only with C files might set
- ;; `completion-regexp-list' to match only *.c, *.h, so we
- ;; preserve that here.
- (let ((completion-regexp-list
- (if (match-string 1 dir)
- ;; Non-directory portion of STRING matches
- ;; dir, so don't match it against files in
- ;; dir.
- completion-regexp-list
- (cons file-regex completion-regexp-list))))
- (cl-mapc
- (lambda (file-name)
- (let ((absfile (concat (file-name-as-directory dir)
file-name)))
- (when (and (not (directory-name-p file-name))
- (or (null pred)
- (funcall pred absfile)))
- (push absfile result))))
- (file-name-all-completions "" dir))
- ))
- ))
- (cond
- ((null action)
- ;; Called from `try-completion'; find common prefix of `result'.
- (try-completion "" result))
-
- ((eq action 'lambda)
- ;; Called from `test-completion'. Note that this call
- ;; includes the `completion-to-table-input' advice, which in
- ;; this case converts STRING to data format (= absolute file
- ;; name). But that fails for root-relative match-style,
- ;; because the result list does not know about ROOT. So we
- ;; have to handle that here.
- (cl-case match-style
- ((absolute basename)
- (test-completion string result))
-
- (root-relative
- (test-completion (concat root string) result))
- ))
-
- ((eq action t)
- ;; Called from all-completions
- result)
- ))
- ))
- ))
-
-(provide 'file-complete)
-;; file-complete.el ends here.
diff --git
a/packages/uniquify-files/uniquify-files-resources/wisitoken-generate-packrat-test.text
b/packages/uniquify-files/uniquify-files-resources/wisitoken-generate-packrat-test.text
new file mode 100644
index 0000000..988f655
--- /dev/null
+++
b/packages/uniquify-files/uniquify-files-resources/wisitoken-generate-packrat-test.text
@@ -0,0 +1 @@
+Wisitoken-generate-packrat-test.text
diff --git
a/packages/uniquify-files/uniquify-files-resources/wisitoken-syntax_trees-test.text
b/packages/uniquify-files/uniquify-files-resources/wisitoken-syntax_trees-test.text
new file mode 100644
index 0000000..5035ff7
--- /dev/null
+++
b/packages/uniquify-files/uniquify-files-resources/wisitoken-syntax_trees-test.text
@@ -0,0 +1 @@
+Wisitoken-syntax_trees-test.text
diff --git
a/packages/uniquify-files/uniquify-files-resources/wisitoken-text_io_trace.text
b/packages/uniquify-files/uniquify-files-resources/wisitoken-text_io_trace.text
new file mode 100644
index 0000000..a2d8f82
--- /dev/null
+++
b/packages/uniquify-files/uniquify-files-resources/wisitoken-text_io_trace.text
@@ -0,0 +1 @@
+Wisitoken-text_io_trace.text
diff --git a/packages/uniquify-files/uniquify-files-test.el
b/packages/uniquify-files/uniquify-files-test.el
index 59968d0..a75638c 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -26,28 +26,9 @@
;; 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'.
+
+;; See `test-uniquify-file-all-completions-face' below for an
+;; explanation of `no-byte-compile'.
(require 'ert)
(require 'uniquify-files)
@@ -66,9 +47,7 @@
(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
+(defconst uft-path
(list uft-root
(concat uft-root "/Alice")
uft-alice1
@@ -77,267 +56,220 @@
(concat uft-root "/Bob")
uft-Bob-alice3
uft-bob1
- uft-bob2)))
+ uft-bob2))
+
+(defun uft-table ()
+ (let (files)
+ (dolist (dir uft-path)
+ (mapc
+ (lambda (absfile)
+ (when (and (not (string-equal "." (substring absfile -1)))
+ (not (string-equal ".." (substring absfile -2)))
+ (not (file-directory-p absfile)))
+ (push absfile files)))
+ (directory-files dir t)))
+ (apply-partially 'uniq-file-completion-table (uniq-file-uniquify files))))
+
+(ert-deftest test-uniq-file-test-completion ()
+ (let ((table (uft-table)))
+ (should (equal (test-completion "foo-fi" table)
+ nil))
+ (should (equal (test-completion "f-fi<dir" table)
+ nil))
-(defun test-uniq-file-test-completion-1 (table)
- (should (equal (test-completion "foo-fi" table)
- nil))
+ (should (equal (test-completion "foo-file1.text<>" table)
+ t))
- (should (equal (test-completion "f-fi<dir" table)
- nil))
+ (should (equal (test-completion "foo-file1.text" table)
+ nil))
- (should (equal (test-completion "foo-file1.text<>" table)
- t))
+ (should (equal (test-completion "foo-file1.text<Alice/alice-1/>" table)
+ t))
- (should (equal (test-completion "foo-file1.text" table)
- t))
+ (should (equal (test-completion "foo-file3.tex" table) ;; partial file name
+ nil))
+
+ (should (equal (test-completion "foo-file3.texts2" table)
+ t))
- (should (equal (test-completion "foo-file1.text<alice-1/>" table)
- t))
+ (should (equal (test-completion "bar-file2.text<Alice/alice-" table)
+ nil))
+ ))
- (should (equal (test-completion "foo-file3.tex" table) ;; partial file name
- nil))
+(ert-deftest test-uniq-file-all-completions-noface ()
+ (let ((table (uft-table))
+ (completion-ignore-case nil))
+ (should (equal
+ (sort (uniq-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-file4.text<Alice/alice-3/>"
+ "foo-file4.text<Bob/alice-3/>"
+ "foo-file5.text"
+ "wisitoken-generate-packrat-test.text"
+ "wisitoken-syntax_trees-test.text"
+ "wisitoken-text_io_trace.text"
+ )))
- (should (equal (test-completion "foo-file3.texts2" table)
- t))
+ (should (equal
+ (sort (uniq-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-file4.text<Alice/alice-3/>"
+ "foo-file4.text<Bob/alice-3/>"
+ "foo-file5.text"
+ )))
- (should (equal (test-completion "bar-file2.text<Alice/alice-" table)
- nil))
- )
+ (should (equal
+ (sort (uniq-file-all-completions "a" table nil nil) #'string-lessp)
+ ;; Should _not_ match directory names
+ nil))
-(ert-deftest test-uniq-file-test-completion-func ()
- (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 ()
- (let ((table (path-iter-all-files uft-iter))
- (completion-styles '(uniquify-file))) ;; FIXME: need a way to specify
category
- (test-uniq-file-test-completion-1 table)))
-
-(defun test-uniq-file-all-completions-noface-1 (table)
- (should (equal
- (sort (uniq-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-file4.text<Alice/alice-3/>"
- "foo-file4.text<Bob/alice-3/>"
- "foo-file5.text"
- )))
-
- (should (equal
- (sort (uniq-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-file4.text<Alice/alice-3/>"
- "foo-file4.text<Bob/alice-3/>"
- "foo-file5.text"
- )))
-
- (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/>"
- "bar-file1.text<alice-2/>"
- "bar-file2.text<alice-1/>"
- "bar-file2.text<alice-2/>"
- )))
-
- (should (equal
- (sort (uniq-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-file4.text<Alice/alice-3/>"
- "foo-file4.text<Bob/alice-3/>"
- "foo-file5.text"
- )))
-
- (should (equal
- (sort (uniq-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 (uniq-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 (uniq-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-file4.text<Alice/alice-3/>"
- "foo-file4.text<Bob/alice-3/>"
- "foo-file5.text"
- )))
-
- (should (equal
- (sort (uniq-file-all-completions "b-fi<a-" 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/>"
- )))
-
- (let ((completion-ignore-case t))
(should (equal
- (sort (uniq-file-all-completions "b-fi<a-" table nil nil)
#'string-lessp)
+ (sort (uniq-file-all-completions "b" 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/>"
+ "bar-file1.text<alice-1/>"
+ "bar-file1.text<alice-2/>"
+ "bar-file2.text<alice-1/>"
+ "bar-file2.text<alice-2/>"
)))
- )
- (should (equal
- (sort (uniq-file-all-completions "b-fi<a-1" table nil nil)
#'string-lessp)
- (list "bar-file1.text<alice-1/>"
- "bar-file2.text<alice-1/>")))
+ (should (equal
+ (sort (uniq-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-file4.text<Alice/alice-3/>"
+ "foo-file4.text<Bob/alice-3/>"
+ "foo-file5.text"
+ )))
- (let ((completion-ignore-case t))
(should (equal
- (sort (uniq-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/>")))
- )
+ (sort (uniq-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 (uniq-file-all-completions "f-file1.text<a-1" table nil nil)
- ;; Accidentally match "a" with "packages"
- (list "foo-file1.text<Alice/alice-1/>")))
+ (should (equal
+ (sort (uniq-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 (uniq-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-file4.text<Alice/alice-3/>"
+ "foo-file4.text<Bob/alice-3/>"
+ "foo-file5.text"
+ )))
+
+ (should (equal
+ (sort (uniq-file-all-completions "b-fi<a-" 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 (uniq-file-all-completions "b-fi<a-1" table nil nil)
#'string-lessp)
+ (list "bar-file1.text<alice-1/>"
+ "bar-file2.text<alice-1/>")))
- (let ((completion-ignore-case t))
(should (equal (uniq-file-all-completions "f-file1.text<a-1" table nil nil)
(list "foo-file1.text<Alice/alice-1/>")))
- )
- (should (equal (sort (uniq-file-all-completions "f-file1.text<al" table nil
nil) #'string-lessp)
- (list
- "foo-file1.text<alice-1/>"
- "foo-file1.text<alice-2/>")))
-
- (let ((completion-ignore-case t))
(should (equal (sort (uniq-file-all-completions "f-file1.text<al" table
nil nil) #'string-lessp)
(list
"foo-file1.text<Alice/alice-1/>"
"foo-file1.text<Alice/alice-2/>")))
- )
-
- (should (equal (sort (uniq-file-all-completions "f-file4.text<a-3" table nil
nil) #'string-lessp)
- (list
- "foo-file4.text<Alice/alice-3/>"
- "foo-file4.text<Bob/alice-3/>")))
- (should (equal (sort (uniq-file-all-completions "foo-file4.text<Bob" table
nil nil) #'string-lessp)
- (list
- "foo-file4.text<Bob/alice-3/>")))
+ (should (equal (sort (uniq-file-all-completions "f-file4.text<a-3" table
nil nil) #'string-lessp)
+ (list
+ "foo-file4.text<Alice/alice-3/>"
+ "foo-file4.text<Bob/alice-3/>")))
- (should (equal (uniq-file-all-completions "f-file5" table nil nil)
- (list "foo-file5.text")))
+ (should (equal (sort (uniq-file-all-completions "foo-file4.text<Bob" table
nil nil) #'string-lessp)
+ (list
+ "foo-file4.text<Bob/alice-3/>")))
- (should (equal (uniq-file-all-completions "foo-file1.text<Alice/alice-1/>"
table nil nil)
- (list "foo-file1.text<Alice/alice-1/>")))
+ (should (equal (uniq-file-all-completions "f-file5" table nil nil)
+ (list "foo-file5.text")))
- (should (equal
- (sort (uniq-file-all-completions "b-fi<a>" 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 (uniq-file-all-completions "foo-file1.text<Alice/alice-1/>"
table nil nil)
+ (list "foo-file1.text<Alice/alice-1/>")))
- (let ((completion-ignore-case t))
(should (equal
(sort (uniq-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/>"
+ "bar-file1.text<alice-1/>"
+ "bar-file1.text<alice-2/>"
+ "bar-file2.text<alice-1/>"
+ "bar-file2.text<alice-2/>"
)))
- )
-
- (should (equal
- (sort (uniq-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/>"
- )))
- )
-(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)))
-
-(ert-deftest test-uniq-file-all-completions-noface-list ()
- (let ((table (path-iter-all-files uft-iter))
- (completion-ignore-case nil)
- (completion-styles '(uniquify-file))) ;; FIXME: need a way to specify
category
- (test-uniq-file-all-completions-noface-1 table)))
+ (should (equal
+ (sort (uniq-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
@@ -348,62 +280,17 @@ all positions in POS-LIST in STRING; return new string."
string)
(ert-deftest test-uniq-file-all-completions-face ()
- ;; all-completions tested above without considering face text
+ ;; `all-completions' tested above without considering face text
;; properties; here we test just those properties. Test cases are
;; the same as above.
;;
;; WORKAROUND: 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))
- (completion-current-style 'uniquify-file)
+ (let ((table (uft-table))
(completion-ignore-case nil))
(should (equal-including-properties
- (sort (uniq-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-file4.text<Alice/alice-3/>")
- (test-uniq-file-hilit '(0) "foo-file4.text<Bob/alice-3/>")
- (test-uniq-file-hilit '(0) "foo-file5.text")
- )))
-
- (should (equal-including-properties
- (sort (uniq-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-file4.text<Alice/alice-3/>")
- (test-uniq-file-hilit '(0 8) "foo-file4.text<Bob/alice-3/>")
- (test-uniq-file-hilit '(0 8) "foo-file5.text")
- )))
-
- (should (equal-including-properties
(sort (uniq-file-all-completions "b" table nil nil) #'string-lessp)
(list
(test-uniq-file-hilit '(8) "bar-file1.text<alice-1/>")
@@ -445,10 +332,20 @@ all positions in POS-LIST in STRING; return new string."
(test-uniq-file-hilit '(14) "foo-file3.texts2")
)))
+ ;; Two places for possible completion, with different intervening text
+ (should (equal-including-properties
+ (sort (uniq-file-all-completions "wisi-te" table nil 5)
#'string-lessp)
+ (list ;; 0 10 20 30
+ (test-uniq-file-hilit '(10 18)
"wisitoken-generate-packrat-test.text")
+ (test-uniq-file-hilit '(10 25) "wisitoken-syntax_trees-test.text")
+ (test-uniq-file-hilit '(10 12) "wisitoken-text_io_trace.text")
+ )))
))
-(defun test-uniq-file-try-completion-1 (table)
- (let (string)
+(ert-deftest test-uniq-file-try-completion ()
+ (let ((table (uft-table))
+ (completion-ignore-case nil)
+ string)
(setq string "fo")
(should (equal (uniq-file-try-completion string table nil (length string))
@@ -460,14 +357,14 @@ all positions in POS-LIST in STRING; return new string."
(setq string "fo<al")
(should (equal (uniq-file-try-completion string table nil 2)
- '("foo-file<alice-" . 8)))
+ '("foo-file.text<alice-" . 8)))
(should (equal (uniq-file-try-completion string table nil 5)
'("foo-file<alice-" . 15)))
(let ((completion-ignore-case t))
(setq string "fo<al")
(should (equal (uniq-file-try-completion string table nil 2)
- '("foo-file<alice" . 8)))
+ '("foo-file.text<alice" . 8)))
(should (equal (uniq-file-try-completion string table nil 5)
'("foo-file<alice" . 14)))
)
@@ -494,16 +391,10 @@ all positions in POS-LIST in STRING; return new string."
(should (equal (uniq-file-try-completion string table nil (length string))
(cons "foo-file1.text<>" 15)))
- (setq string "foo-file1.text<alice-1/>") ;; valid and unique
+ (setq string "foo-file1.text<Alice/alice-1/>") ;; valid and unique
(should (equal (uniq-file-try-completion string table nil (length string))
t))
- (let ((completion-ignore-case t))
- (setq string "foo-file1.text<alice-1/>") ;; valid and unique, but
accidental match on Alice
- (should (equal (uniq-file-try-completion string table nil (length
string))
- '("foo-file1.text<Alice/alice-1/>" . 30)))
- )
-
(setq string "foo-file3.texts") ;; not unique, valid
(should (equal (uniq-file-try-completion string table nil (length string))
'("foo-file3.texts" . 15)))
@@ -538,147 +429,58 @@ all positions in POS-LIST in STRING; return new string."
(cons "foo-file" 8))))
))
-(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)))
-
-(ert-deftest test-uniq-file-try-completion-list ()
- (let ((table (path-iter-all-files uft-iter))
- (completion-ignore-case nil)
- (completion-styles '(uniquify-file))) ;; FIXME: need a way to specify
category
- (test-uniq-file-try-completion-1 table)))
-
-(ert-deftest test-uniq-file-get-data-string ()
- (let ((table (apply-partially 'uniq-file-completion-table uft-iter)))
-
- (should (equal (uniq-file-get-data-string "foo-file1.text<alice-1>" table
nil)
- (concat uft-alice1 "/foo-file1.text")))
-
- (should (equal (uniq-file-get-data-string "foo-file3.text" table nil)
- (concat uft-alice2 "/foo-file3.text")))
-
- (should (equal (uniq-file-get-data-string "foo-file3.texts" table nil)
- (concat uft-alice2 "/foo-file3.texts")))
-
- (should (equal (uniq-file-get-data-string "foo-file3.texts2" table nil)
- (concat uft-root "/foo-file3.texts2")))
- ))
-
-(ert-deftest test-uniq-file-to-table-input ()
- (should (equal (uniq-file-to-table-input "fi" nil nil)
- "fi"))
-
- (should (equal (uniq-file-to-table-input "fi<di" nil nil)
- "di/fi"))
-
- (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/>" nil nil)
- "Alice/alice-2/file1"))
-
- (should (equal (uniq-file-to-table-input "file1<>" nil nil)
- "file1"))
-
- (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-" nil
nil)
- "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
+ (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"))
+ (list
+ '("file3.text" . "/Alice/alice2/file3.text")
+ '("file2.text" . "/Alice/alice1/file2.text")
+ '("file1.text<Bob/bob1/>" . "/Bob/bob1/file1.text")
+ '("file1.text<Alice/alice2/>" . "/Alice/alice2/file1.text")
+ '("file1.text<Alice/alice1/>" . "/Alice/alice1/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
+ (cons "foo-file1.text<>" (concat uft-root
"/foo-file1.text"))
+ (cons "foo-file1.text<Bob/bob-2/>" (concat uft-bob2
"/foo-file1.text"))
+ (cons "foo-file1.text<Bob/bob-1/>" (concat uft-bob1
"/foo-file1.text"))
+ (cons "foo-file1.text<Alice/alice-2/>" (concat uft-alice2
"/foo-file1.text"))
+ (cons "foo-file1.text<Alice/alice-1/>" (concat uft-alice1
"/foo-file1.text"))
+ )))
+
+ (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-file1.c")
(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"
- )))
+ ))
+ (list
+ (cons "foo-file5.c" (concat uft-bob2
"/foo-file5.c"))
+ (cons "foo-file2.c" (concat uft-bob1
"/foo-file2.c"))
+ (cons "foo-file1.c<bob-2/>" (concat uft-bob2
"/foo-file1.c"))
+ (cons "foo-file1.c<bob-1/>" (concat uft-bob1
"/foo-file1.c"))
+ (cons "bar-file2.c<alice-2/>" (concat uft-alice2
"/bar-file2.c"))
+ (cons "bar-file2.c<alice-1/>" (concat uft-alice1
"/bar-file2.c"))
+ (cons "bar-file1.c<alice-2/>" (concat uft-alice2
"/bar-file1.c"))
+ (cons "bar-file1.c<alice-1/>" (concat uft-alice1
"/bar-file1.c"))
+ )))
)
(provide 'uniquify-files-test)
diff --git a/packages/uniquify-files/uniquify-files.el
b/packages/uniquify-files/uniquify-files.el
index 923e680..a74a450 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -1,6 +1,6 @@
-;;; uniquify-files.el --- Completion style for files in a path -*-
lexical-binding:t -*-
+4;;; uniquify-files.el --- Completion style for files, minimizing directories
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2017, 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2019 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_le...@stephe-leake.org>
;; Maintainer: Stephen Leake <stephen_le...@stephe-leake.org>
@@ -24,161 +24,18 @@
;; 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
-;;; Discussion
-;;;
-;; These are the driving requirements for this completion style:
-;;
-;; 1. Allow the strings entered by the user and displayed in the
-;; completion list to be rearranged abbreviations of the absolute
-;; file name returned by `completing-read'.
-;;
-;; 2. Allow partial completion on the directory and filename portions
-;; of the abbreviated strings.
-;;
-;; "partial completion" means file names are partitioned at "_-/"
-;; characters, so "fo-ba" completes to "foo-bar".
-;;
-;; 3. The style should be usable with the completion table function
-;; provided here, or with a list of absolute file names.
-
-;; Requirement 1 has the most effect on the design. There are two
-;; common ways to select the result of a completion:
-;;
-;; - `minibuffer-complete-and-exit' - by default bound to <ret> in the
-;; minibuffer when `icomplete-mode' is enabled.
-;;
-;; - `minibuffer-force-complete-and-exit' - some users bind this to
-;; <ret> or other keys, so that it is easier to select the first
-;; completion.
-;;
-;; One possible design is to have `completion-try-completion' return
-;; an absolute file name (rather than an abbreviated file name) when
-;; the completed string is a valid completion. That sometimes works
-;; with `minibuffer-complete-and-exit', but it does not work with
-;; `minibuffer-force-complete-and-exit'; details follow.
-
-;; The nominal path thru `minibuffer-complete-and-exit' in effect
-;; calls `test-completion'. If that returns nil, it calls
-;; `completion-try-completion' with the same string, and then
-;; `test-completion' on that result. If that returns non-nil, the
-;; completed string is returned as the result of
-;; `completing-read'. Thus `test-completion' could return nil for user
-;; format strings, and t for data format strings; and `try-completion'
-;; could convert user format strings that are valid completions to data
-;; format strings. However, the full logic is complex (see the code in
-;; minibuffer.el for more details), and often ends up not converting
-;; the user string to a data string.
-;;
-;; `minibuffer-force-complete-and-exit' calls
-;; `minibuffer-force-complete', which replaces the buffer text with
-;; the first completion. Then it calls `test-completion', but _not_
-;; `try-completion' if that fails. So there is no opportunity to
-;; convert the user string to a data string.
-;;
-;; Thus the design we use here adds an explicit conversion from user
-;; to data format, via advice on completing-read.
-;;
-;; We did not meet the third requirement; the completion table
-;; implements part of the completion style.
-
-;;; Design
-;;
-;; There are three string formats involved in completion. For most
-;; styles, they are all the same; the following table describes them
-;; for the uniquify-file style.
-;;
-;; - user
-;;
-;; The format typed by the user in the minibuffer, and shown in the
-;; displayed completion list.
-;;
-;; The user input is passed to `completion-try-completion', so it must
-;; accept this format.
-;;
-;; The string returned by `completion-try-completion' when it extends
-;; the string replaces the string typed by the user, so it must be
-;; 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
-;; and return t.
-;;
-;; For the uniquify-file style, this is a partial or complete file
-;; base name with any required uniquifying directories appended.
-;;
-;; - completion table input
-;;
-;; The string input to the completion table function, or, if the
-;; table is a list of absolute filenames, the string matched against
-;; the table.
-;;
-;; The `completion-try-completion' and `completion-all-completion'
-;; `test-completion' functions must convert user format strings to
-;; completion table input format strings when calling the
-;; corresponding low-level completion functions that call the
-;; completion table function.
-;;
-;; For the uniquify-file style, this contains the complete or
-;; partial directory name or no directory name, followed by the
-;; partial or complete file base name, in normal elisp filename
-;; format.
-;;
-;; A completion table input string is a valid completion if the
-;; string equals (respecting `completion-ignore-case') the tail of
-;; an existing file name, starting after a directory separator and
-;; ending at the end of the file name.
-;;
-;; - data
-;;
-;; The string format desired as the result of `completing-read'.
-;;
-;; In order to keep style-dependent code out of the completion table
-;; function, the completion table function returns a list of strings
-;; in this format when action is t; `completion-all-completions'
-;; converts them to user format strings.
-;;
-;; For the uniquify-file style, this is an absolute file name.
-;;
-;;
-;; As of Emacs 25.1, `completion-try-completion' and
-;; `completion-all-completion' support style-specific implementations
-;; via `completion-style-alist', but `test-completion' does not. So we
-;; advise `test-completion' to convert to the appropriate format first.
-;;
-;; Similarly, the current completion code does not have a provision
-;; for converting from user format to data format after a completion
-;; is selected; we add that via advice on `completing-read-default'. A
-;; future version may add this conversion in
-;; `completion--complete-and-exit' instead.
-;;
-;; In order to allow other completion styles that have different user
-;; and data string formats, we extend `completion-styles-alist' with
-;; two entries:
-;;
-;; - fourth entry contains a function that takes one argument
-;; USER-STRING and returns a table input format string. This is used
-;; by `completion-to-table-input' - advice for `test-completion'.
-;;
-;; - fifth entry contains a function that takes three arguments
-;; USER-STRING, TABLE, PREDICATE, and returns a list of data string
-;; format strings matching USER-STRING. This is used by
-;; `completion-get-data-string'.
+;; A file completion style in which the completion string displayed to
+;; the user consists of the file basename followed by enough of the
+;; directory part to make the string identify a unique file.
;;
+;; We accomplish this by preprocessing the list of absolute file names
+;; to be in that style, in an alist with the original absolute file
+;; names, and do completion on that alist.
(require 'cl-lib)
-(require 'file-complete)
-(require 'path-iterator)
-
-(defvar completion-current-style nil
- "Current active completion style.")
+(require 'files)
(defconst uniq-file--regexp "^\\(.*\\)<\\([^>]*\\)>?$"
;; The trailing '>' is optional so the user can type "<dir" in the
@@ -186,37 +43,7 @@
"Regexp matching uniqufied file name.
Match 1 is the filename, match 2 is the relative directory.")
-(defun uniq-file--dir-match (partial abs)
- "Return the portion of ABS that matches PARTIAL; both are directories."
- (cond
- ((and partial
- (< 0 (length partial)))
- (let* ((pattern (completion-pcm--string->pattern partial nil))
- (regex (completion-pcm--pattern->regex pattern)))
-
- ;; `regex' is anchored at the beginning; delete the anchor to
- ;; match a directory in the middle of ABS.
- (setq regex (substring regex 2))
-
- ;; Include the preceding and following '/' .
- (unless (= ?/ (aref regex 0))
- (setq regex (concat "/" regex)))
- (unless (= ?/ (aref regex (1- (length regex))))
- (setq regex (concat regex "[^/]*/" )))
-
- (when (string-match regex abs);; Should never fail, but gives obscure
error if it does
-
- ;; Drop the leading '/', include all trailing directories;
- ;; consider Bob/alice-3/foo, Alice/alice-3/foo.
- (substring abs (1+ (match-beginning 0))))
- ))
-
- (t
- ;; no partial; nothing matches
- "")
- ))
-
-(defun uniq-file--conflicts (conflicts dir)
+(defun uniq-file-conflicts (conflicts)
"Subroutine of `uniq-file-uniquify'."
(let ((common-root ;; shared prefix of dirs in conflicts - may be nil
(fill-common-string-prefix (file-name-directory (nth 0 conflicts))
(file-name-directory (nth 1 conflicts)))))
@@ -236,125 +63,47 @@ Match 1 is the filename, match 2 is the relative
directory.")
(cl-mapcar
(lambda (name)
- ;; The set of `non-common' is unique, but we also need to
- ;; include all of `completed-dir' in the result.
- ;;
- ;; examples
- ;; 1. uniquify-files-test.el test-uniq-file-uniquify, dir "Al/a-"
- ;; conflicts:
- ;; .../Alice/alice-1/bar-file1.text
- ;; .../Alice/alice-1/bar-file2.text
- ;; .../Alice/alice-2/bar-file2.text
- ;; common : .../Alice/
- ;; non-common : alice-1/, alice-2/
- ;; completed-dir : Alice/alice-1/, Alice/alice-2/
- ;;
- ;; 2. uniquify-files-test.el test-uniq-file-all-completions-noface-1
"f-file4.text<a-3"
- ;; conflicts:
- ;; .../uniquify-files-resources/Alice/alice-3/foo-file4.text
- ;; .../uniquify-files-resources/Bob/alice-3/foo-file4.text
- ;; common : .../uniquify-files-resources
- ;; non-common : Alice/alice-3/, Bob/alice-3/
- ;; completed-dir : alice-3/
- ;;
- (let ((completed-dir (and dir (uniq-file--dir-match dir
(file-name-directory name))))
- (non-common (substring (file-name-directory name) (length
common-root))))
-
- (when (and completed-dir
- (not (string-match completed-dir non-common)))
- ;; case 1.
- (let* ((completed-dirs (and completed-dir (nreverse (split-string
completed-dir "/" t))))
- (first-non-common (substring non-common 0 (string-match "/"
non-common))))
- (while completed-dirs
- (let ((dir1 (pop completed-dirs)))
- (when (not (string-equal dir1 first-non-common))
- (setq non-common (concat dir1 "/" non-common)))))))
- ;; else case 2; non-common is correct
-
- (concat (file-name-nondirectory name) "<" non-common ">")
- ))
+ (cons (concat (file-name-nondirectory name)
+ "<"
+ (substring (file-name-directory name) (length
common-root))
+ ">")
+ name))
conflicts)
))
-(defun uniq-file--uniquify (names dir)
- "Return a uniquified list of names built from NAMES.
-NAMES contains absolute file names.
-
-The result contains non-directory filenames with partial
-directory paths appended. The partial directory path will always
-include at least the completion of DIR.
-
-If DIR is non-nil, all elements of NAMES must match DIR."
- ;; AKA uniq-file-to-user; convert list of data format strings to list of
user format strings.
- (let ((case-fold-search completion-ignore-case))
- (when names
- (let (result
- conflicts ;; list of names where all non-directory names are the
same.
- )
-
- ;; Sort names on basename 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-file--conflicts conflicts dir) result)))
- )
- (nreverse result)
- ))
- ))
-
-(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))))
-
- (if match
- (if (= 0 (length dir)) ;; ie "file<"
- (match-string 1 user-string)
- (concat (file-name-as-directory dir) (match-string 1 user-string)))
-
- ;; else not uniquified
- user-string)))
-
-(defun uniq-file--valid-regexp (string)
- "Return a regexp matching STRING (in table input format) to an absolute file
name.
-Regexp matches if the file name is a valid completion."
- (concat (unless (file-name-absolute-p string) "/") string "\\'"))
-
-(defun uniq-file--valid-completion (string all)
- "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."
- ;; STRING is a valid completion if it is a tail of at least one
- ;; element of ALL, including at least the base name.
- (let* ((regexp (uniq-file--valid-regexp string))
- (matched nil)
- name)
-
- (while (and all
- (not matched))
- (setq name (pop all))
- (when (string-match regexp name)
- (setq matched t)))
-
- matched))
+(defun uniq-file-uniquify (names)
+ "Return an alist of uniquified names built from NAMES.
+NAMES is a list containing absolute file names.
+
+The result contains file basenames with partial directory paths
+appended."
+ (let ((case-fold-search completion-ignore-case)
+ result
+ conflicts ;; list of names where all non-directory names are the same.
+ )
+
+ ;; Sort names on basename 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))
+ (push (cons
+ (concat (file-name-nondirectory (car conflicts)))
+ (car conflicts))
+ result)
+
+ (setq result (append (uniq-file-conflicts conflicts) result)))
+ )
+ result))
(defun uniq-file--pcm-pat (string point)
- "Return a pcm pattern that matches STRING (a user format string)."
+ "Return a pcm pattern that matches STRING (a uniquified file name)."
(let* ((completion-pcm--delim-wild-regex
(concat "[" completion-pcm-word-delimiters "<>*]"))
;; If STRING ends in an empty directory part, some valid
@@ -386,27 +135,20 @@ STRING should be in completion table input format."
(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.
+ALL must be a list of uniquified file names.
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)
"Implement `completion-try-completion' for uniquify-file."
- ;; Returns common leading substring of completions of USER-STRING in table,
- ;; consed with new point (length of common substring).
(let (result
uniq-all
done)
- (setq completion-current-style 'uniquify-file)
-
;; Compute result or uniq-all, set done.
(cond
- ((or
- (functionp table) ;; TABLE is a wrapper function that calls
uniq-file-completion-table.
- (and (consp table)
- (file-name-absolute-p (car table)))) ;; TABLE is the original list
of absolute file names.
+ ((functionp table) ;; TABLE is a wrapper function that calls
uniq-file-completion-table.
(setq uniq-all (uniq-file-all-completions user-string table pred point))
@@ -486,6 +228,9 @@ character after each completion field."
(mapcar
(lambda (str)
+ ;; First remove previously applied face; `str' may be a reference
+ ;; to a list used in a previous completion.
+ (remove-text-properties 0 (length str) '(face
completions-first-difference) str)
(when (string-match regex str)
(cl-loop
for i from 1 to field-count
@@ -498,204 +243,81 @@ character after each completion field."
str)
all)))
-(defun uniq-file--match-list (regexp-list file-name)
- "Return non-nil if FILE-NAME matches all regular expressions in REGEXP-LIST,
-nil otherwise."
- (let ((result t))
- (dolist (regexp regexp-list)
- (unless (string-match regexp file-name)
- (setq result nil)))
- result))
-
-(defun uniq-file-all-completions (user-string table pred point)
+(defun uniq-file-all-completions (string table pred point)
"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 table pred))
- all)
-
- (setq completion-current-style 'uniquify-file)
-
- (cond
- ((functionp table)
- (setq all (funcall table table-string pred t)))
-
- ((and (consp table)
- (file-name-absolute-p (car table)))
- ;; TABLE is a list of absolute file names.
-
- (pcase-let ((`(,dir-regex ,file-regex)
- (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)
- (when (and
- (string-match dir-regex (directory-file-name file-name))
- (uniq-file--match-list completion-regexp-list
(file-name-nondirectory file-name))
- (or (null pred)
- (funcall pred file-name)))
- (push file-name all)))
- )))
- )
-
+ (let ((all (all-completions string table pred)))
(when all
- (setq all (uniq-file--uniquify all (file-name-directory table-string)))
+ (uniq-file--hilit string all point))
+ ))
- ;; 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)))
+(defun uniq-file-completion-table (files string pred action)
+ "Implement a completion table for uniquified file names in FILES.
+FILES is an alist of (UNIQIFIED-NAME . ABS-NAME). Completion is
+done on UNIQIFIED-NAME, PRED is called with ABS-NAME."
+ (cond
+ ((eq action 'alist)
+ (cdr (assoc string files #'string-equal)))
- (setq all (uniq-file--hilit user-string all point))
- all
- )
- ))
+ ((eq (car-safe action) 'boundaries)
+ ;; We don't use boundaries; return the default definition.
+ (cons 'boundaries
+ (cons 0 (length (cdr action)))))
-(defun uniq-file-get-data-string (user-string table pred)
- "Implement `completion-get-data-string' for 'uniqify-file."
- ;; 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 table pred))
- all)
- (cond
- ((functionp table)
- (setq all (all-completions table-string table pred)))
-
- (t
- ;; TABLE is list of absolute file names. Match table-string
- ;; against tail of table entry.
- (let ((regexp (uniq-file--valid-regexp table-string)))
- (dolist (entry table)
- (when (string-match regexp entry)
- (push entry all)))
- ))
- )
+ ((eq action 'metadata)
+ (cons 'metadata
+ (list
+ ;; category controls what completion styles are appropriate.
+ '(category . uniquify-file)
+ )))
- (setq
- all
- (sort all
- (lambda (a b)
- (let ((lfa (length (file-name-nondirectory a)))
- (lfb (length (file-name-nondirectory b))))
- (if (= lfa lfb)
- (< (length a) (length b))
- (< lfa lfb))
- ))
- ))
-
- (or (car all)
- "");; must return a string, not nil.
- ))
+ ((memq action
+ '(nil ;; Called from `try-completion'
+ lambda ;; Called from `test-completion'
+ t)) ;; Called from all-completions
+
+ (let ((regex (completion-pcm--pattern->regex
+ (uniq-file--pcm-pat string (length string))))
+ (case-fold-search completion-ignore-case)
+ (result nil))
+ (dolist (pair files)
+ (when (and
+ (string-match regex (car pair))
+ (or (null pred)
+ (funcall pred (cdr pair))))
+ (push (car pair) result)))
-;; 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)))))
- (if to-data-func
- (funcall to-data-func user-string table pred)
- user-string))
- )
-
-(defun completion-to-table-input (orig-fun user-string table &optional pred)
- "Convert user string to table input."
- (let* ((table-string
- (let ((to-table-func (if (functionp table)
- (nth 4 (assq completion-current-style
completion-styles-alist)) ;; user to table
-
- ;; TABLE is a list of absolute file names
- (nth 5 (assq completion-current-style
completion-styles-alist)) ;; user to data
- )))
- (if to-table-func
- (funcall to-table-func user-string table pred)
- user-string))))
- (funcall orig-fun table-string table pred)
- )
- )
-
-(advice-add #'test-completion :around #'completion-to-table-input)
-
-(defun uniq-file-completing-read-default-advice (orig-fun prompt collection
&optional predicate
- require-match
initial-input hist def
- inherit-input-method)
- "Advice for `completing-read-default'; convert user string to data string."
- (let* ((completion-current-style nil)
- (user-string (funcall orig-fun prompt collection
- predicate require-match initial-input hist def
- inherit-input-method)))
-
- (unless completion-current-style
- ;; If completion-current-style is not set here, it's because the
- ;; user invoked `exit-minibuffer' to use the default string, or
- ;; because the completion functions did not set it (they are
- ;; legacy).
- (setq completion-current-style (car (cdr (assq 'styles
(completion-metadata "" collection nil))))))
- (completion-get-data-string user-string collection predicate)
- ))
+ (cond
+ ((null action)
+ (try-completion string result))
-(advice-add #'completing-read-default :around
#'uniq-file-completing-read-default-advice)
+ ((eq 'lambda action)
+ (test-completion string files pred))
+
+ ((eq t action)
+ result)
+ )))
+ ))
(add-to-list 'completion-styles-alist
'(uniquify-file
uniq-file-try-completion
uniq-file-all-completions
- "display uniquified filenames."
- uniq-file-to-table-input ;; 4 user to table input format
- uniq-file-get-data-string)) ;; 5 user to data format
+ "display uniquified file names."))
-(defun uniq-file-completion-table (path-iter string pred action)
- "Implement a completion table for file names in PATH-ITER."
+;;; Integration with project.el
- ;; We just add `styles' metadata to `path-iter-completion-table'.
- (cond
- ((eq action 'metadata)
- (cons 'metadata
- (list
- '(category . project-file)
- '(styles . (uniquify-file))
- )))
+;;;###autoload
+(defun uniq-file-read (prompt all-files &optional predicate hist default)
+ "For `project-read-file-name-function'."
+ (let* ((alist (uniq-file-uniquify all-files))
+ (table (apply-partially #'uniq-file-completion-table alist))
+ (found (project--completing-read-strict
+ prompt table predicate hist default)))
+ (cdr (assoc found alist))))
- (t
- (file-complete-completion-table path-iter 'basename nil string pred
action))
- ))
-
-(defun locate-uniquified-file (&optional path predicate default prompt)
- "Return an absolute filename, with completion in non-recursive PATH
-\(default `load-path'). 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."
- (interactive)
- (let* ((iter (make-path-iterator :user-path-non-recursive (or path
load-path)))
- (table (apply-partially #'uniq-file-completion-table iter))
- (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
- (completion-category-overrides
- (list (list 'project-file (cons 'styles table-styles)))))
- (completing-read (or prompt "file: ")
- table
- predicate t nil nil default)
- ))
-
-(defun locate-uniquified-file-iter (iter &optional predicate default prompt)
- "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
-non-nil. DEFAULT is the default for completion.
-
-In the user input string, `*' is treated as a wildcard."
- (let* ((table (apply-partially #'uniq-file-completion-table 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)
- ))
+;;;###autoload
+(setq-default project-read-file-name-function #'uniq-file-read)
(provide 'uniquify-files)
;;; uniquify-files.el ends here
