emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 02764f9 4/5: Improve uniquify-files-test.el, improve uniqu


From: Stephen Leake
Subject: [elpa] master 02764f9 4/5: Improve uniquify-files-test.el, improve uniquify-files to handle new tests
Date: Fri, 1 Feb 2019 18:12:08 -0500 (EST)

branch: master
commit 02764f93d4fdf8493aa093e4cb32cb822ebe5a48
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>

    Improve uniquify-files-test.el, improve uniquify-files to handle new tests
    
    * packages/uniquify-files/uniquify-files-resources/*.text: Adjust content
    to match location.
    
    * packages/uniquify-files/uniquify-files-resources/Alice/alice-3/: New
    directory.
    
    * packages/uniquify-files/uniquify-files-resources/Bob/alice-3/: New
    directory.
    
    * packages/uniquify-files/uniquify-files-test.el (uft-Alice-alice3)
    (uft-Bob-alice3): New.
    (uft-iter): Add Alice/alice-3, Bob/alice-3.
    (test-uniq-file-completion-table): Renamed from
    test-uniq-file-path-completion-table. Add new test files to results.
    (test-uniq-file-all-completions-noface-1): Renamed from
    test-uniquify-file-all-completions-noface-1.
    (test-uniq-file-all-completions-noface-1): Add new test files to results.
    Add completion-ignore-case t to cases where it matters. Add test using
    Alice/alice-3, Bob/alice-3.
    (test-uniq-file-all-completions-noface-func): Renamed from
    test-uniquify-file-all-completions-noface-func. Add
    completion-ignore-case nil.
    (test-uniq-file-all-completions-noface-list): Renamed from
    test-uniquify-file-all-completions-noface-list. Add
    completion-ignore-case nil.
    (test-uniq-file-all-completions-face): Add completion-ignore-case nil.
    Add new test files to results.
    (test-uniq-file-try-completion-1): Add completion-ignore-case t to cases
    where it matters. Replace case-fold-search with completion-ignore-case.
    
    * packages/uniquify-files/uniquify-files.el (uniq-files--conflicts):
    Improve to handle new test.
    (uniq-file--uniquify): Set case-fold-search.
    (uniq-file--pcm-merged-pat): Delete extra-delim arg; no longer shared
    with other style. Set case-fold-search.
    (uniq-file--pcm-merged-pat): Allow uniquifying directories.
---
 .../Alice/alice-1/bar-file1.text                   |   2 +-
 .../Alice/alice-1/bar-file2.text                   |   2 +-
 .../Alice/alice-1/foo-file1.text                   |   2 +-
 .../Alice/alice-1/foo-file2.text                   |   2 +-
 .../Alice/alice-3/foo-file4.text                   |   1 +
 .../Bob/alice-3/foo-file4.text                     |   1 +
 packages/uniquify-files/uniquify-files-test.el     | 132 +++++++++++++----
 packages/uniquify-files/uniquify-files.el          | 156 ++++++++++++---------
 8 files changed, 200 insertions(+), 98 deletions(-)

diff --git 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text
index 86a25bf..fa6dc6c 100644
--- 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text
+++ 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file1.text
@@ -1 +1 @@
-alice-1/bar-file1.text
+Alice/alice-1/bar-file1.text
diff --git 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text
index ede9208..a1379dc 100644
--- 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text
+++ 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/bar-file2.text
@@ -1 +1 @@
-alice-1/bar-file2.text
+Alice/alice-1/bar-file2.text
diff --git 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text
index d83a9f4..6ca3f4a 100644
--- 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text
+++ 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file1.text
@@ -1 +1 @@
-alice-1/foo-file1.text
+Alice/alice-1/foo-file1.text
diff --git 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text
index 70af0ae..0c46e78 100644
--- 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text
+++ 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-1/foo-file2.text
@@ -1 +1 @@
-alice-1/foo-file2.text
+Alice/alice-1/foo-file2.text
diff --git 
a/packages/uniquify-files/uniquify-files-resources/Alice/alice-3/foo-file4.text 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-3/foo-file4.text
new file mode 100644
index 0000000..5af2740
--- /dev/null
+++ 
b/packages/uniquify-files/uniquify-files-resources/Alice/alice-3/foo-file4.text
@@ -0,0 +1 @@
+Alice/alice-3/foo-file4.text
diff --git 
a/packages/uniquify-files/uniquify-files-resources/Bob/alice-3/foo-file4.text 
b/packages/uniquify-files/uniquify-files-resources/Bob/alice-3/foo-file4.text
new file mode 100644
index 0000000..5893d49
--- /dev/null
+++ 
b/packages/uniquify-files/uniquify-files-resources/Bob/alice-3/foo-file4.text
@@ -0,0 +1 @@
+Bob/alice-3/foo-file4.text
diff --git a/packages/uniquify-files/uniquify-files-test.el 
b/packages/uniquify-files/uniquify-files-test.el
index 0375749..301dd7c 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -59,6 +59,8 @@
 
 (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"))
 
@@ -68,10 +70,12 @@
    (list uft-root
         uft-alice1
         uft-alice2
+        uft-Alice-alice3
+        uft-Bob-alice3
         uft-bob1
         uft-bob2)))
 
-(ert-deftest test-uniq-file-path-completion-table ()
+(ert-deftest test-uniq-file-completion-table ()
   "Test basic functions of table."
   ;; grouped by action
   (should (equal (uniq-file-completion-table uft-iter "fi" nil '(boundaries . 
".text"))
@@ -94,6 +98,8 @@
                  (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")
@@ -186,7 +192,7 @@
        (completion-styles '(uniquify-file))) ;; FIXME: need a way to specify 
category
     (test-uniq-file-test-completion-1 table)))
 
-(defun test-uniquify-file-all-completions-noface-1 (table)
+(defun test-uniq-file-all-completions-noface-1 (table)
   (should (equal
           (sort (uniq-file-all-completions "" table nil nil) #'string-lessp)
           (list
@@ -204,6 +210,8 @@
            "foo-file3.text"
            "foo-file3.texts"
            "foo-file3.texts2"
+           "foo-file4.text<Alice/alice-3/>"
+           "foo-file4.text<Bob/alice-3/>"
            "foo-file5.text"
            )))
 
@@ -224,6 +232,8 @@
            "foo-file3.text"
            "foo-file3.texts"
            "foo-file3.texts2"
+           "foo-file4.text<Alice/alice-3/>"
+           "foo-file4.text<Bob/alice-3/>"
            "foo-file5.text"
            )))
 
@@ -249,6 +259,8 @@
            "foo-file3.text"
            "foo-file3.texts"
            "foo-file3.texts2"
+           "foo-file4.text<Alice/alice-3/>"
+           "foo-file4.text<Bob/alice-3/>"
            "foo-file5.text"
            )))
 
@@ -281,29 +293,67 @@
            "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)
-          ;; FIXME: This result reflects a bug in
-          ;; `completion-pcm--pattern->regex'; "a-" becomes
-          ;; "a.*?-", but it should be (concat "a[^"
-          ;; wildcards "]*-".
           (list
-           "bar-file1.text<Alice/alice-1/>"
-           "bar-file1.text<Alice/alice-2/>"
-           "bar-file2.text<Alice/alice-1/>"
-           "bar-file2.text<Alice/alice-2/>"
+           "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)
+            (list
+             "bar-file1.text<Alice/alice-1/>"
+             "bar-file1.text<Alice/alice-2/>"
+             "bar-file2.text<Alice/alice-1/>"
+             "bar-file2.text<Alice/alice-2/>"
+             )))
+    )
+
   (should (equal
           (sort (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/>")))
+          (list "bar-file1.text<alice-1/>"
+                "bar-file2.text<alice-1/>")))
+
+  (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/>")))
+    )
 
   (should (equal (uniq-file-all-completions "f-file1.text<a-1" table nil nil)
-                (list "foo-file1.text<Alice/alice-1/>")))
+                (list "foo-file1.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 (uniq-file-all-completions "f-file5" table nil nil)
                 (list "foo-file5.text")))
@@ -314,12 +364,23 @@
   (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/>"
            )))
 
+  (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/>"
+             )))
+    )
+
   (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.
@@ -332,14 +393,16 @@
            )))
   )
 
-(ert-deftest test-uniquify-file-all-completions-noface-func ()
-  (let ((table (apply-partially 'uniq-file-completion-table uft-iter)))
-    (test-uniquify-file-all-completions-noface-1 table)))
+(ert-deftest test-uniq-file-all-completions-noface-func ()
+  (let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+       (completion-ignore-case nil))
+    (test-uniq-file-all-completions-noface-1 table)))
 
-(ert-deftest test-uniquify-file-all-completions-noface-list ()
+(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-uniquify-file-all-completions-noface-1 table)))
+    (test-uniq-file-all-completions-noface-1 table)))
 
 (defun test-uniq-file-hilit (pos-list string)
   "Set 'face text property to 'completions-first-difference at
@@ -354,10 +417,11 @@ all positions in POS-LIST in STRING; return new string."
   ;; properties; here we test just those properties. Test cases are
   ;; the same as above.
   ;;
-  ;; FIXME: byte-compiling this test makes it fail; it appears to be
+  ;; 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)))
+  (let ((table (apply-partially 'uniq-file-completion-table uft-iter))
+       (completion-ignore-case nil))
 
     (should (equal-including-properties
             (sort (uniq-file-all-completions "" table nil nil) #'string-lessp)
@@ -376,6 +440,8 @@ all positions in POS-LIST in STRING; return new string."
              (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")
              )))
 
@@ -396,6 +462,8 @@ all positions in POS-LIST in STRING; return new string."
              (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")
              )))
 
@@ -421,6 +489,8 @@ all positions in POS-LIST in STRING; return new string."
              (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")
              )))
 
@@ -458,12 +528,12 @@ all positions in POS-LIST in STRING; return new string."
     (should (equal (uniq-file-try-completion string table nil 5)
                   '("foo-file<alice-" . 15)))
 
-    (let ((case-fold-search t))
+    (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<alice" . 8)))
       (should (equal (uniq-file-try-completion string table nil 5)
-                    '("foo-file<Alice/" . 15)))
+                    '("foo-file<alice" . 14)))
       )
 
     (setq string "foo-file3") ;; not unique, not valid
@@ -474,7 +544,7 @@ all positions in POS-LIST in STRING; return new string."
     (should (equal (uniq-file-try-completion string table nil (length string))
                   '("foo-file1.text<alice-1/>" . 24)))
 
-    (let ((case-fold-search t))
+    (let ((completion-ignore-case t))
       (setq string "f-file1.text<a-1") ;; unique but not valid
       (should (equal (uniq-file-try-completion string table nil (length 
string))
                     '("foo-file1.text<Alice/alice-1/>" . 30)))
@@ -496,7 +566,7 @@ all positions in POS-LIST in STRING; return new string."
     (should (equal (uniq-file-try-completion string table nil (length string))
                   t))
 
-    (let ((case-fold-search 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)))
@@ -538,12 +608,12 @@ all positions in POS-LIST in STRING; return new string."
 
 (ert-deftest test-uniq-file-try-completion-func ()
   (let ((table (apply-partially 'uniq-file-completion-table uft-iter))
-       (case-fold-search nil))
+       (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))
-       (case-fold-search nil)
+       (completion-ignore-case nil)
        (completion-styles '(uniquify-file))) ;; FIXME: need a way to specify 
category
     (test-uniq-file-try-completion-1 table)))
 
diff --git a/packages/uniquify-files/uniquify-files.el 
b/packages/uniquify-files/uniquify-files.el
index b3cd044..741e603 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -229,32 +229,43 @@ Match 1 is the filename, match 2 is the relative 
directory.")
 
     (cl-mapcar
      (lambda (name)
-       ;; `dir' can match more than one absolute directory, so we
-       ;; compute `completed-dir' for each element of conflicts.
+       ;; The set of `non-common' is unique, but we also need to
+       ;; include all of `completed-dir' in the result.
        ;;
-       ;; `completed-dir' may overlap only `common-root', or both
-       ;; `common-root' and `non-common'; eliminate the overlap with
-       ;; `non-common'.
+       ;; 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/
        ;;
-       ;; We can assume `completed-dir' matches at the end of
-       ;; `common-root', not in the middle.
+       ;;   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/
        ;;
-       ;; example (see uniquify-files-test.el test-uniq-file-uniquify, dir 
"Al/a-")
-       ;;   common        : c:/tmp/Alice/
-       ;;   non-common    : alice-2/
-       ;;   completed-dir : Alice/alice-2/
-       ;;
-       (let* ((completed-dir (and dir (uniq-file--dir-match dir 
(file-name-directory name))))
-             (completed-dirs (and completed-dir (nreverse (split-string 
completed-dir "/" t))))
-             (non-common (substring (file-name-directory name) (length 
common-root)))
-             (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)))))
-
-        (concat (file-name-nondirectory name) "<" non-common ">")))
+       (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 ">")
+        ))
      conflicts)
     ))
 
@@ -268,37 +279,39 @@ 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.
-  (when names
-    (let (result
-         conflicts ;; list of names where all non-directory names are the same.
+  (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-files--conflicts conflicts dir) result)))
          )
-
-      ;; 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-files--conflicts conflicts dir) result)))
-       )
-      (nreverse result)
-      )))
+       (nreverse result)
+       ))
+    ))
 
 (defun uniq-file-to-table-input (user-string &optional _table _pred)
-  "Convert USER-STRING to table input string."
+  "Implement `completion-to-table-input' for uniquify-file."
   (let* ((match (string-match uniq-files--regexp user-string))
         (dir (and match (match-string 2 user-string))))
 
@@ -354,12 +367,13 @@ STRING should be in completion table input format."
         (file-regex (completion-pcm--pattern->regex file-pattern)))
     (list dir-regex file-regex)))
 
-(defun uniq-file--pcm-merged-pat (string all point &optional extra-delim)
+(defun uniq-file--pcm-merged-pat (string all point)
   "Return a pcm pattern that is the merged completion of STRING in ALL.
 ALL must be a list of table input format strings?
 Pattern is in reverse order."
-  (let* ((completion-pcm--delim-wild-regex
-         (concat "[" completion-pcm-word-delimiters extra-delim "*]"))
+  (let* ((case-fold-search completion-ignore-case)
+        (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
@@ -367,9 +381,26 @@ Pattern is in reverse order."
                   (= (aref string (1- (length string))) ?<))
              (substring string 0 -1)
            string))
+        dir-start
         (pattern (completion-pcm--string->pattern trimmed-string point)))
-    (completion-pcm--merge-completions all pattern)
-    ))
+
+    ;; 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))))
+
+    (completion-pcm--merge-completions all pattern)))
 
 (defun uniq-file-try-completion (user-string table pred point)
   "Implement `completion-try-completion' for uniquify-file."
@@ -425,7 +456,7 @@ Pattern is in reverse order."
        result
 
       ;; Find merged completion of uniqified file names
-      (let* ((merged-pat (uniq-file--pcm-merged-pat user-string uniq-all point 
"<>"))
+      (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
@@ -445,7 +476,7 @@ Pattern is in reverse order."
        (cons merged new-point)))
     ))
 
-(defun uniq-files--hilit (string all point &optional extra-delim)
+(defun uniq-files--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.
@@ -454,7 +485,7 @@ 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 
extra-delim)))
+  (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)))
         )
@@ -516,7 +547,7 @@ nil otherwise."
 
     (when all
       (setq all (uniq-file--uniquify all (file-name-directory table-string)))
-      (uniq-files--hilit user-string all point "<>"))
+      (uniq-files--hilit user-string all point))
     ))
 
 (defun uniq-file-get-data-string (user-string table pred)
@@ -619,7 +650,7 @@ nil otherwise."
               uniq-file-get-data-string)) ;; 5 user to data format
 
 (defun uniq-file-completion-table (path-iter string pred action)
-  "Do completion for file names in PATH-ITER.
+  "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 `uniq-file-completion-table'.
@@ -655,8 +686,7 @@ ACTION is the current completion action; one of:
 - 'metadata; return (metadata . ALIST) as defined by
   `completion-metadata'.
 
-Return a list of absolute file names matching STRING, using
-`partial-completion' style matching."
+Return a list of absolute file names matching STRING."
 
   ;; This completion table function combines iterating on files in
   ;; PATH-ITER with filtering on USER-STRING and PRED. This is an



reply via email to

[Prev in Thread] Current Thread [Next in Thread]