[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/project-uniquify-files d2a5283: Add new file compl
|
From: |
Stephen Leake |
|
Subject: |
[Emacs-diffs] scratch/project-uniquify-files d2a5283: Add new file completion tables, change project.el to allow using them |
|
Date: |
Fri, 26 Apr 2019 08:02:59 -0400 (EDT) |
branch: scratch/project-uniquify-files
commit d2a5283a065fd03d6dc606cc7ec29822e544dffb
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Add new file completion tables, change project.el to allow using them
* lisp/file-complete-root-relative.el: New file.
* lisp/uniquify-files.el: New file.
* test/lisp/progmodes/uniquify-files-resources/: New directory
containing files for testing uniquify-files.
* test/lisp/progmodes/uniquify-files-test.el: New file; test
uniquify-files.
* lisp/files.el (path-files): New function; useful with new completion
tables.
* lisp/progmodes/project.el (project-file-completion-table): Use
file-complete-root-relative completion table.
(project-find-file): Add optional FILENAME parameter.
(project--completing-read-strict): Rewrite to just use the given
completion table; extracting the common directory is now done by
file-complete-root-relative. This also allows using the new
uniquify-files completion table.
* lisp/minibuffer.el (completion-category-defaults): Add
uniquify-file.
(completing-read-default): Add final step to call completion table
with 'alist action if supported.
---
lisp/file-complete-root-relative.el | 81 ++++
lisp/files.el | 26 ++
lisp/minibuffer.el | 8 +
lisp/progmodes/project.el | 70 ++-
lisp/uniquify-files.el | 329 ++++++++++++++
.../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 +
.../Alice/alice-3/foo-file4.text | 1 +
.../Bob/alice-3/foo-file4.text | 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 +
.../wisitoken-generate-packrat-test.text | 1 +
.../wisitoken-syntax_trees-test.text | 1 +
.../wisitoken-text_io_trace.text | 1 +
test/lisp/progmodes/uniquify-files-test.el | 481 +++++++++++++++++++++
26 files changed, 971 insertions(+), 44 deletions(-)
diff --git a/lisp/file-complete-root-relative.el
b/lisp/file-complete-root-relative.el
new file mode 100644
index 0000000..5c90cab
--- /dev/null
+++ b/lisp/file-complete-root-relative.el
@@ -0,0 +1,81 @@
+;;; file-complete-root-relative.el --- Completion style for files -*-
lexical-binding:t -*-
+;;
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <address@hidden>
+;; Maintainer: Stephen Leake <address@hidden>
+;;
+;; 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.
+;;
+;; 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)
+
+(defun fc-root-rel-to-alist (root files)
+ "Return a file-root-rel alist with file names from FILES.
+Result is a list (REL-NAME . ABS-NAME), where REL-NAME is ABS-NAME with ROOT
deleted.
+An error is signaled if any name in FILES does not begin with ROOT."
+ (let ((root-len (length root))
+ result)
+ (mapc
+ (lambda (abs-name)
+ (unless (string-equal root (substring abs-name 0 root-len))
+ (error "%s does not begin with %s" abs-name root))
+ (push (cons (substring abs-name root-len) abs-name) result))
+ files)
+ result))
+
+(defun fc-root-rel-completion-table (files string pred action)
+ "Implement a completion table for file names in FILES,
+FILES is a list of (REL-NAME . ABS-NAME).
+
+STRING, PRED, ACTION are completion table arguments."
+ (cond
+ ((eq action 'alist)
+ (cdr (assoc string files)))
+
+ ((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
+ '(alist . t)
+ '(category . project-file))))
+
+ ((null action)
+ (try-completion string files pred))
+
+ ((eq 'lambda action)
+ (test-completion string files pred))
+
+ ((eq t action)
+ (all-completions string files pred))
+
+ ))
+
+(provide 'file-complete-root-relative)
+;;; file-complete-root-relative.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index c05d70a..47ee197 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -842,6 +842,32 @@ output directories whose names match REGEXP."
(push (expand-file-name file dir) files)))))
(nconc result (nreverse files))))
+(defun path-files (path &optional pred)
+ "Return a list of all files matching PRED in PATH.
+PATH is flat; no subdirectories of entries in PATH are
+visited (unless they are also in PATH). PRED is a function
+taking one argument; an absolute file name."
+ (let (visited ;; list of already visited directories, to avoid duplication
+ result)
+ (dolist (dir path)
+ (while (member dir visited)
+ (setq dir (pop path)))
+ (when (and dir
+ (file-directory-p dir))
+ (push dir visited)
+ (mapc
+ (lambda (rel-file)
+ (let ((absfile (concat (file-name-as-directory dir) rel-file)))
+ (when (and (not (string-equal "." (substring absfile -1)))
+ (not (string-equal ".." (substring absfile -2)))
+ (not (file-directory-p absfile))
+ (or (null pred)
+ (funcall pred absfile)))
+ (push absfile result))))
+ (file-name-all-completions "" dir));; uses completion-regexp-list
+ ))
+ result))
+
(defvar module-file-suffix)
(defun load-file (file)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index dbd24df..969f82a 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -846,6 +846,7 @@ styles for specific categories, such as files, buffers,
etc."
(defvar completion-category-defaults
'((buffer (styles . (basic substring)))
(unicode-name (styles . (basic substring)))
+ (uniquify-file (styles . (uniquify-file)))
(project-file (styles . (substring)))
(info-menu (styles . (basic substring))))
"Default settings for specific completion categories.
@@ -3582,6 +3583,13 @@ See `completing-read' for the meaning of the arguments."
nil hist def inherit-input-method)))
(when (and (equal result "") def)
(setq result (if (consp def) (car def) def)))
+
+ (when (completion-metadata-get (completion-metadata "" collection nil)
'alist)
+ (setq result (funcall collection result nil 'alist)))
+
+ ;; If collection is itself an alist, we could also fetch that
+ ;; result here, but that would not be backward compatible.
+
result))
;; Miscellaneous
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 11a2ef4..0b10e09 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -88,6 +88,7 @@
;;; Code:
(require 'cl-generic)
+(require 'file-complete-root-relative)
(defvar project-find-functions (list #'project-try-vc)
"Special hook to find the project containing a given directory.
@@ -162,14 +163,12 @@ end it with `/'. DIR must be one of `project-roots' or
DIRS is a list of absolute directories; it should be some
subset of the project roots and external roots.
-The default implementation delegates to `project-files'."
- (let ((all-files (project-files project dirs)))
- (lambda (string pred action)
- (cond
- ((eq action 'metadata)
- '(metadata . ((category . project-file))))
- (t
- (complete-with-action action all-files string pred))))))
+The default implementation gets a file list from `project-files',
+and uses the `file-root-rel' completion style."
+ (when (= 1 (length dirs))
+ (let* ((all-files (project-files project dirs))
+ (alist (fc-root-rel-to-alist (car dirs) all-files)))
+ (apply-partially #'fc-root-rel-completion-table alist))))
(cl-defmethod project-roots ((project (head transient)))
(list (cdr project)))
@@ -449,14 +448,14 @@ pattern to search for."
(read-regexp "Find regexp" (and id (regexp-quote id)))))
;;;###autoload
-(defun project-find-file ()
+(defun project-find-file (&optional filename)
"Visit a file (with completion) in the current project's roots.
-The completion default is the filename at point, if one is
-recognized."
+The completion default is FILENAME, or if nil, the filename at
+point, if one is recognized."
(interactive)
(let* ((pr (project-current t))
(dirs (project-roots pr)))
- (project-find-file-in (thing-at-point 'filename) dirs pr)))
+ (project-find-file-in (or filename (thing-at-point 'filename)) dirs pr)))
;;;###autoload
(defun project-or-external-find-file ()
@@ -483,42 +482,25 @@ recognized."
(defun project--completing-read-strict (prompt
collection &optional predicate
hist default inherit-input-method)
- ;; Tried both expanding the default before showing the prompt, and
- ;; removing it when it has no matches. Neither seems natural
- ;; enough. Removal is confusing; early expansion makes the prompt
- ;; too long.
- (let* ((common-parent-directory
- (let ((common-prefix (try-completion "" collection)))
- (if (> (length common-prefix) 0)
- (file-name-directory common-prefix))))
- (cpd-length (length common-parent-directory))
- (prompt (if (zerop cpd-length)
- prompt
- (concat prompt (format " in %s" common-parent-directory))))
- ;; XXX: This requires collection to be "flat" as well.
- (substrings (mapcar (lambda (s) (substring s cpd-length))
- (all-completions "" collection)))
- (new-collection
- (lambda (string pred action)
- (cond
- ((eq action 'metadata)
- (if (functionp collection) (funcall collection nil nil
'metadata)))
- (t
- (complete-with-action action substrings string pred)))))
- (new-prompt (if default
- (format "%s (default %s): " prompt default)
- (format "%s: " prompt)))
- (res (completing-read new-prompt
- new-collection predicate t
- nil ;; initial-input
- hist default inherit-input-method)))
+ (let* ((prompt (if (and default (< 0 (length default)))
+ (format "%s (default %s): " prompt default)
+ (format "%s: " prompt)))
+ (res (completing-read prompt
+ collection predicate
+ t ;; require-match
+ nil ;; initial-input
+ hist default inherit-input-method)))
(when (and (equal res default)
(not (test-completion res collection predicate)))
+ ;; Tried both expanding the default before showing the prompt, and
+ ;; removing it when it has no matches. Neither seems natural
+ ;; enough. Removal is confusing; early expansion makes the prompt
+ ;; too long.
(setq res
- (completing-read (format "%s: " prompt)
- new-collection predicate t res hist nil
+ (completing-read prompt
+ collection predicate t res hist nil
inherit-input-method)))
- (concat common-parent-directory res)))
+ res))
(declare-function fileloop-continue "fileloop" ())
diff --git a/lisp/uniquify-files.el b/lisp/uniquify-files.el
new file mode 100644
index 0000000..fd6769f
--- /dev/null
+++ b/lisp/uniquify-files.el
@@ -0,0 +1,329 @@
+;;; uniquify-files.el --- Completion style for files, minimizing directories
-*- lexical-binding:t -*-
+;;
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <address@hidden>
+;; Maintainer: Stephen Leake <address@hidden>
+;;
+;; 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 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 'files)
+
+
+(defconst uniq-file--regexp "^\\(.*\\)<\\([^>]*\\)>?$"
+ ;; The trailing '>' is optional so the user can type "<dir" in the
+ ;; input buffer to complete directories.
+ "Regexp matching uniqufied file name.
+Match 1 is the filename, match 2 is the relative directory.")
+
+(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)))))
+
+ (let ((temp (cddr conflicts)))
+ (while (and common-root
+ temp)
+ (setq common-root (fill-common-string-prefix common-root
(file-name-directory (pop temp))))))
+
+ (when common-root
+ ;; Trim `common-root' back to last '/'
+ (let ((i (1- (length common-root))))
+ (while (and (> i 0)
+ (not (= (aref common-root i) ?/)))
+ (setq i (1- i)))
+ (setq common-root (substring common-root 0 (1+ i)))))
+
+ (cl-mapcar
+ (lambda (name)
+ (cons (concat (file-name-nondirectory name)
+ "<"
+ (substring (file-name-directory name) (length
common-root))
+ ">")
+ name))
+ conflicts)
+ ))
+
+(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 uniquified file name)."
+ (let* ((completion-pcm--delim-wild-regex
+ (concat "[" completion-pcm-word-delimiters "<>*]"))
+ ;; If STRING ends in an empty directory part, some valid
+ ;; completions won't have any directory part.
+ (trimmed-string
+ (if (and (< 0 (length string))
+ (= (aref string (1- (length string))) ?<))
+ (substring string 0 -1)
+ string))
+ dir-start
+ (pattern (completion-pcm--string->pattern trimmed-string point)))
+
+ ;; If trimmed-string has a directory part, allow uniquifying
+ ;; directories.
+ (when (and (setq dir-start (string-match "<" trimmed-string))
+ (< dir-start (1- (length trimmed-string))))
+ (let (new-pattern
+ item)
+ (while pattern
+ (setq item (pop pattern))
+ (push item new-pattern)
+ (when (equal item "<")
+ (setq item (pop pattern))
+ (if (eq item 'any-delim)
+ (push 'any new-pattern)
+ (push item new-pattern))))
+ (setq pattern (nreverse new-pattern))))
+ pattern))
+
+(defun uniq-file--pcm-merged-pat (string all point)
+ "Return a pcm pattern that is the merged completion of STRING in ALL.
+ALL must be a list of 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."
+ (let (result
+ uniq-all
+ done)
+
+ ;; Compute result or uniq-all, set done.
+ (cond
+ ((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))
+
+ (cond
+ ((null uniq-all) ;; No matches.
+ (setq result nil)
+ (setq done t))
+
+ ((= 1 (length uniq-all)) ;; One match; unique.
+ (setq done t)
+
+ ;; Check for valid completion
+ (if (string-equal user-string (car uniq-all))
+ (setq result t)
+
+ (setq result (car uniq-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
+ ;; uniquified file names.
+
+ ((null table) ;; No matches.
+ (setq result nil)
+ (setq done t))
+
+ (t ;; TABLE is a list of uniquified file names
+ (setq uniq-all table)
+ (setq done nil))
+ )
+
+ (if done
+ result
+
+ ;; Find merged completion of uniqified file names
+ (let* ((merged-pat (uniq-file--pcm-merged-pat user-string uniq-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 uniq-file--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 (uniq-file--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)
+ ;; 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
+ 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 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 ((all (all-completions string table pred)))
+ (when all
+ (uniq-file--hilit string all point))
+ ))
+
+(defun uniq-file-completion-table (files string pred action)
+ "Implement a completion table for uniquified file names in FILES.
+FILES is a list of (UNIQIFIED-NAME . ABS-NAME).
+PRED is called with the ABS-NAME.
+
+If ACTION is 'abs-file-name, return the absolute file name for STRING."
+ (cond
+ ((eq action 'alist)
+ (cdr (assoc string files #'string-equal)))
+
+ ((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
+ '(alist . t)
+ ;; category controls what completion styles are appropriate.
+ '(category . uniquify-file)
+ )))
+
+ ((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)))
+
+ (cond
+ ((null action)
+ (try-completion string result))
+
+ ((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 file names."))
+
+
+;;; Example use case.
+
+(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* ((alist (uniq-file-uniquify (path-files path predicate)))
+ (table (apply-partially #'uniq-file-completion-table alist))
+ (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
+ (found (completing-read (or prompt "file: ")
+ table nil t nil nil default)))
+ (funcall table found nil 'abs-file-name)
+ ))
+
+(provide 'uniquify-files)
+;;; uniquify-files.el ends here
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file1.text
new file mode 100644
index 0000000..fa6dc6c
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file1.text
@@ -0,0 +1 @@
+Alice/alice-1/bar-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file2.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file2.text
new file mode 100644
index 0000000..a1379dc
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/bar-file2.text
@@ -0,0 +1 @@
+Alice/alice-1/bar-file2.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file1.text
new file mode 100644
index 0000000..6ca3f4a
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file1.text
@@ -0,0 +1 @@
+Alice/alice-1/foo-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file2.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file2.text
new file mode 100644
index 0000000..0c46e78
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-1/foo-file2.text
@@ -0,0 +1 @@
+Alice/alice-1/foo-file2.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file1.text
new file mode 100644
index 0000000..24ca29e
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file1.text
@@ -0,0 +1 @@
+alice-2/bar-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file2.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file2.text
new file mode 100644
index 0000000..e3d8e7b
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/bar-file2.text
@@ -0,0 +1 @@
+alice-2/bar-file2.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file1.text
new file mode 100644
index 0000000..ac4ffaa
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file1.text
@@ -0,0 +1 @@
+alice-2/foo-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file3.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file3.text
new file mode 100644
index 0000000..dbf803b
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file3.text
@@ -0,0 +1 @@
+alice-2/foo-file3.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file3.texts
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-2/foo-file3.texts
new file mode 100644
index 0000000..124d83e
--- /dev/null
+++ b/test/lisp/progmodes/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/test/lisp/progmodes/uniquify-files-resources/Alice/alice-3/foo-file4.text
b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-3/foo-file4.text
new file mode 100644
index 0000000..7c26b34
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Alice/alice-3/foo-file4.text
@@ -0,0 +1 @@
+Alice/alice-3/foo-file4.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Bob/alice-3/foo-file4.text
b/test/lisp/progmodes/uniquify-files-resources/Bob/alice-3/foo-file4.text
new file mode 100644
index 0000000..5893d49
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Bob/alice-3/foo-file4.text
@@ -0,0 +1 @@
+Bob/alice-3/foo-file4.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file1.text
new file mode 100644
index 0000000..ba2e142
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file1.text
@@ -0,0 +1 @@
+bob-1/foo-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file2.text
b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file2.text
new file mode 100644
index 0000000..6bd9bdb
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-1/foo-file2.text
@@ -0,0 +1 @@
+bob-1/foo-file2.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file1.text
b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file1.text
new file mode 100644
index 0000000..754a1f1
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file1.text
@@ -0,0 +1 @@
+bob-2/foo-file1.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file5.text
b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file5.text
new file mode 100644
index 0000000..2a3b1e9
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/Bob/bob-2/foo-file5.text
@@ -0,0 +1 @@
+bob-2/foo-file5.text
diff --git a/test/lisp/progmodes/uniquify-files-resources/foo-file1.text
b/test/lisp/progmodes/uniquify-files-resources/foo-file1.text
new file mode 100644
index 0000000..00b4928
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/foo-file1.text
@@ -0,0 +1 @@
+foo-file1.text
diff --git a/test/lisp/progmodes/uniquify-files-resources/foo-file3.texts2
b/test/lisp/progmodes/uniquify-files-resources/foo-file3.texts2
new file mode 100644
index 0000000..ae97731
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/foo-file3.texts2
@@ -0,0 +1 @@
+foo-file3.texts2
diff --git
a/test/lisp/progmodes/uniquify-files-resources/wisitoken-generate-packrat-test.text
b/test/lisp/progmodes/uniquify-files-resources/wisitoken-generate-packrat-test.text
new file mode 100644
index 0000000..cd2f5cf
--- /dev/null
+++
b/test/lisp/progmodes/uniquify-files-resources/wisitoken-generate-packrat-test.text
@@ -0,0 +1 @@
+Wisitoken-generate-packrat-test.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/wisitoken-syntax_trees-test.text
b/test/lisp/progmodes/uniquify-files-resources/wisitoken-syntax_trees-test.text
new file mode 100644
index 0000000..5035ff7
--- /dev/null
+++
b/test/lisp/progmodes/uniquify-files-resources/wisitoken-syntax_trees-test.text
@@ -0,0 +1 @@
+Wisitoken-syntax_trees-test.text
diff --git
a/test/lisp/progmodes/uniquify-files-resources/wisitoken-text_io_trace.text
b/test/lisp/progmodes/uniquify-files-resources/wisitoken-text_io_trace.text
new file mode 100644
index 0000000..a2d8f82
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-resources/wisitoken-text_io_trace.text
@@ -0,0 +1 @@
+Wisitoken-text_io_trace.text
diff --git a/test/lisp/progmodes/uniquify-files-test.el
b/test/lisp/progmodes/uniquify-files-test.el
new file mode 100644
index 0000000..ad19e6a
--- /dev/null
+++ b/test/lisp/progmodes/uniquify-files-test.el
@@ -0,0 +1,481 @@
+;;; 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 <address@hidden>
+;; Maintainer: Stephen Leake <address@hidden>
+;;
+;; 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).
+
+;; 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)))
+ ;; We deliberately leave out the trailing '/' here, because users
+ ;; often do; the code must cope.
+ "uniquify-files-resources"))
+
+(defconst uft-alice1 (concat uft-root "/Alice/alice-1"))
+(defconst uft-alice2 (concat uft-root "/Alice/alice-2"))
+(defconst uft-Alice-alice3 (concat uft-root "/Alice/alice-3"))
+(defconst uft-Bob-alice3 (concat uft-root "/Bob/alice-3"))
+(defconst uft-bob1 (concat uft-root "/Bob/bob-1"))
+(defconst uft-bob2 (concat uft-root "/Bob/bob-2"))
+
+(defconst uft-path
+ (list uft-root
+ (concat uft-root "/Alice")
+ uft-alice1
+ uft-alice2
+ uft-Alice-alice3
+ (concat uft-root "/Bob")
+ uft-Bob-alice3
+ uft-bob1
+ uft-bob2))
+
+(defun uft-table ()
+ (apply-partially 'uniq-file-completion-table (uniq-file-uniquify (path-files
uft-path))))
+
+(ert-deftest test-uniq-file-test-completion ()
+ (let ((table (uft-table))
+ (completion-current-style 'uniquify-file))
+ (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)
+ nil))
+
+ (should (equal (test-completion "foo-file1.text<Alice/alice-1/>" 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 "bar-file2.text<Alice/alice-" table)
+ nil))
+ ))
+
+(ert-deftest test-uniq-file-all-completions-noface ()
+ (let ((table (uft-table))
+ (completion-current-style 'uniquify-file)
+ (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
+ (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/>"
+ )))
+
+ (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 (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/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 (uniq-file-all-completions "f-file5" table nil nil)
+ (list "foo-file5.text")))
+
+ (should (equal (uniq-file-all-completions "foo-file1.text<Alice/alice-1/>"
table nil nil)
+ (list "foo-file1.text<Alice/alice-1/>")))
+
+ (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 "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-uniq-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.
+ ;;
+ ;; 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 (uft-table))
+ (completion-ignore-case nil))
+
+ (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/>")
+ (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 (uniq-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-file4.text<Alice/alice-3/>")
+ (test-uniq-file-hilit '(8) "foo-file4.text<Bob/alice-3/>")
+ (test-uniq-file-hilit '(8) "foo-file5.text")
+ )))
+
+ (should (equal-including-properties
+ (sort (uniq-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 (uniq-file-all-completions "foo-file3.text" table nil nil)
#'string-lessp)
+ (list
+ (test-uniq-file-hilit '() "foo-file3.text")
+ (test-uniq-file-hilit '(14) "foo-file3.texts")
+ (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")
+ )))
+ ))
+
+(ert-deftest test-uniq-file-try-completion ()
+ (let ((table (uft-table))
+ (completion-current-style 'uniquify-file)
+ (completion-ignore-case nil)
+ string)
+
+ (setq string "fo")
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ '("foo-file" . 8)))
+
+ (setq string "b")
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ '("bar-file" . 8)))
+
+ (setq string "fo<al")
+ (should (equal (uniq-file-try-completion string table nil 2)
+ '("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.text<alice" . 8)))
+ (should (equal (uniq-file-try-completion string table nil 5)
+ '("foo-file<alice" . 14)))
+ )
+
+ (setq string "foo-file3") ;; not unique, not valid
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ '("foo-file3.text" . 14)))
+
+ (setq string "f-file1.text<a-1")
+ ;; Not unique, because "a" accidentally matches "packages" in
+ ;; uft-root-dir, and "-" covers "/". Also not valid.
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ '("foo-file1.text<Alice/alice-1/>" . 30)))
+
+ (setq string "foo-file1.text") ;; valid but not unique
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ (cons "foo-file1.text<" 15)))
+
+ (setq string "foo-file1<") ;; not valid
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ (cons "foo-file1.text<" 15)))
+
+ (setq string "foo-file1.text<>") ;; valid but not unique
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ (cons "foo-file1.text<>" 15)))
+
+ (setq string "foo-file1.text<Alice/alice-1/>") ;; valid and unique
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ t))
+
+ (setq string "foo-file3.texts") ;; not unique, valid
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ '("foo-file3.texts" . 15)))
+
+ (setq string "foo-file3.texts2") ;; unique and valid
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ t))
+
+ (setq string "fil2") ;; misspelled
+ (should (equal (uniq-file-try-completion string table nil (length string))
+ nil))
+
+ (setq string "b-file2")
+ (should (equal (uniq-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 (uniq-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 (uniq-file-try-completion string table nil (length string))
+ '("bar-file2.text<alice-" . 21)))
+
+ ;; completion-try-completion called from icomplete-completions with
+ ;; result of all-completions instead of table function.
+ (setq string "f-file<")
+ (let ((comps (uniq-file-all-completions string table nil nil)))
+ (should (equal (uniq-file-try-completion string comps nil (length
string))
+ (cons "foo-file" 8))))
+ ))
+
+(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"))
+ (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")
+ ))
+ (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")
+ (concat uft-bob1 "/foo-file2.c")
+ (concat uft-bob2 "/foo-file1.c")
+ (concat uft-bob2 "/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)
+;;; uniquify-files-test.el ends here