[elpa] master 433cca5 2/3: Improve uniquify-files

[Stephen Leake]

branch: master
commit 433cca5adf8e6828e47f0efd9637aee4b4609f37
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>

    Improve uniquify-files
    
    * packages/uniquify-files/file-complete-root-relative.el
    (fc-root-rel-to-table-input): Match completion table arg list.
    (fc-root-rel-completion-table-iter): add 'styles to metadata
    (fc-root-rel-completion-table-list): add 'styles to metadata
    (completion-styles-alist): Add file-root-rel.
    
    * packages/uniquify-files/file-complete-root-relative-test.el
    (test-fc-root-rel-completion-table-iter): Match code change.
    (test-fc-root-rel-completion-table-list): Match code change.
    
    * packages/uniquify-files/uniquify-files-resources/foo-file-3.texts2:
    Match content to file name.
    
    * packages/uniquify-files/uniquify-files.el:
    (completion-get-data-string, completion-to-table-input): Use 'styles
    metadata.
    (top level): Don't modify completion-category-defaults; use
    completion-category-overrides in project-find-files.
    (uniq-file-completion-table): Add styles metadata.
    
    * packages/uniquify-files/uniquify-files-test.el:
    (test-uniq-file-completion-table): Match code change.
---
 .../file-complete-root-relative-test.el            |  2 +
 .../uniquify-files/file-complete-root-relative.el  | 22 +++----
 .../uniquify-files-resources/foo-file3.texts2      |  2 +-
 packages/uniquify-files/uniquify-files-test.el     |  3 +-
 packages/uniquify-files/uniquify-files.el          | 71 +++++++++++-----------
 5 files changed, 52 insertions(+), 48 deletions(-)

diff --git a/packages/uniquify-files/file-complete-root-relative-test.el 
b/packages/uniquify-files/file-complete-root-relative-test.el
index 66bdf43..f696288 100644
--- a/packages/uniquify-files/file-complete-root-relative-test.el
+++ b/packages/uniquify-files/file-complete-root-relative-test.el
@@ -57,6 +57,7 @@
                 (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
@@ -119,6 +120,7 @@
                 (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
diff --git a/packages/uniquify-files/file-complete-root-relative.el 
b/packages/uniquify-files/file-complete-root-relative.el
index 86b1459..3f66809 100644
--- a/packages/uniquify-files/file-complete-root-relative.el
+++ b/packages/uniquify-files/file-complete-root-relative.el
@@ -50,7 +50,7 @@
   "Return root from TABLE."
   (cdr (assoc 'root (completion-metadata "" table nil))))
 
-(defun fc-root-rel-to-table-input (user-string)
+(defun fc-root-rel-to-table-input (user-string &optional _table _pred _point)
   "Implement `completion-to-table-input' for file-root-rel."
   user-string)
 
@@ -289,12 +289,8 @@ STRING, PRED, ACTION are completion table arguments."
    ((eq action 'metadata)
     (cons 'metadata
          (list
-          ;; We specify the category 'project-file here, to match the
-          ;; `completion-category-defaults' setting above.  We use
-          ;; the default sort order, which is shortest first, so
-          ;; "project.el" is easier to complete when it also matches
-          ;; "project-am.el".
           '(category . project-file)
+          '(styles . (file-root-rel))
           (cons 'root (car (path-iter-path-recursive-init path-iter))))))
 
    ((null action)
@@ -370,12 +366,8 @@ STRING, PRED, ACTION are completion table arguments."
    ((eq action 'metadata)
     (cons 'metadata
          (list
-          ;; We specify the category 'project-file here, to match the
-          ;; `completion-category-defaults' setting above.  We use
-          ;; the default sort order, which is shortest first, so
-          ;; "project.el" is easier to complete when it also matches
-          ;; "project-am.el".
           '(category . project-file)
+          '(styles . (file-root-rel))
           (cons 'root root))))
 
    ((null action)
@@ -410,5 +402,13 @@ STRING, PRED, ACTION are completion table arguments."
        )))
    ))
 
+(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
+
 (provide 'file-complete-root-relative)
 ;;; file-complete-root-relative.el ends here
diff --git a/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2 
b/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2
index 625ab98..ae97731 100644
--- a/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2
+++ b/packages/uniquify-files/uniquify-files-resources/foo-file3.texts2
@@ -1 +1 @@
-This file name is a strict extension of alice-1/foo-file3.texts, but in a 
directory that is shorter
+foo-file3.texts2
diff --git a/packages/uniquify-files/uniquify-files-test.el 
b/packages/uniquify-files/uniquify-files-test.el
index 301dd7c..8950cbd 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -84,7 +84,8 @@
   (should (equal (uniq-file-completion-table uft-iter "fi" nil 'metadata)
                 (cons 'metadata
                       (list
-                       '(category . project-file)))))
+                       '(category . project-file)
+                       '(styles   . (uniquify-file))))))
 
   ;; all-completions. We sort the results here to make the test stable
   (should (equal (sort (uniq-file-completion-table uft-iter "-fi" nil t) 
#'string-lessp)
diff --git a/packages/uniquify-files/uniquify-files.el 
b/packages/uniquify-files/uniquify-files.el
index 741e603..b36ec11 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -589,36 +589,44 @@ nil otherwise."
 
 (defun completion-get-data-string (user-string table pred)
   "Return the data string corresponding to USER-STRING."
-  ;;  FIXME: This is ultimately called from
-  ;;  `completion-try-completion' or `completion-all-completions';
-  ;;  there is only one style currently being used. Need to pass that
-  ;;  style from there to here.
-  (let ((results
-        (mapcar (lambda (style)
-                  (let ((to-data-func (nth 5 (assq style 
completion-styles-alist))))
-                    (if to-data-func
-                        (funcall to-data-func user-string table pred)
-                      user-string)))
-                (completion--styles (completion-metadata user-string table 
pred)))))
+  (let* ((styles
+         (or (cdr (assq 'styles (completion-metadata user-string table pred)))
+             (completion--styles (completion-metadata user-string table 
pred))))
+
+        (results
+         ;;  FIXME: This is ultimately called from
+         ;;  `completion-try-completion' or `completion-all-completions';
+         ;;  there is only one style currently being used. Need to pass that
+         ;;  style from there to here.
+         (mapcar (lambda (style)
+                   (let ((to-data-func (nth 5 (assq style 
completion-styles-alist))))
+                     (if to-data-func
+                         (funcall to-data-func user-string table pred)
+                       user-string)))
+                 styles))
+        )
     (car (delete-dups results))
     ))
 
-(defun completion-to-table-input (orig-fun string table &optional pred)
+(defun completion-to-table-input (orig-fun user-string table &optional pred)
   "Advice for `test-completion'; convert user string to table input."
   ;; See FIXME: in completion-get-data-string
-  (let ((table-strings
-        (mapcar
-         (lambda (style)
-           (let ((to-table-func (if (functionp table)
-                                    (nth 4 (assq style 
completion-styles-alist)) ;; user to table
-
-                                  ;; TABLE is a list of absolute file names
-                                  (nth 5 (assq style completion-styles-alist)) 
;; user to data
-                                  )))
-             (if to-table-func
-                 (funcall to-table-func string table pred)
-               string)))
-         (completion--styles (completion-metadata string table pred)))))
+  (let* ((styles
+         (or (cdr (assq 'styles (completion-metadata user-string table pred)))
+             (completion--styles (completion-metadata user-string table 
pred))))
+        (table-strings
+         (mapcar
+          (lambda (style)
+            (let ((to-table-func (if (functionp table)
+                                     (nth 4 (assq style 
completion-styles-alist)) ;; user to table
+
+                                   ;; TABLE is a list of absolute file names
+                                   (nth 5 (assq style 
completion-styles-alist)) ;; user to data
+                                   )))
+              (if to-table-func
+                  (funcall to-table-func user-string table pred)
+                user-string)))
+          styles)))
     (setq table-strings (delete-dups table-strings))
     (funcall orig-fun (car table-strings) table pred)
     ))
@@ -637,10 +645,6 @@ nil otherwise."
 
 (advice-add #'completing-read-default :around 
#'uniq-file-completing-read-default-advice)
 
-;; FIXME: could not get setcdr to do this
-(delete '(project-file (styles . uniquify-file)) completion-category-defaults)
-(add-to-list 'completion-category-defaults '(project-file (styles . 
(uniquify-file))))
-
 (add-to-list 'completion-styles-alist
             '(uniquify-file
               uniq-file-try-completion
@@ -706,12 +710,9 @@ Return a list of absolute file names matching STRING."
    ((eq action 'metadata)
     (cons 'metadata
          (list
-          ;; We specify the category 'project-file here, to match the
-          ;; `completion-category-defaults' setting above.  We use
-          ;; the default sort order, which is shortest first, so
-          ;; "project.el" is easier to complete when it also matches
-          ;; "project-am.el".
-          '(category . project-file))))
+          '(category . project-file)
+          '(styles . (uniquify-file))
+          )))
 
    ((null action)
     ;; Called from `try-completion'; should never get here (see