branch: master
commit 433cca5adf8e6828e47f0efd9637aee4b4609f37
Author: Stephen Leake <stephen_le...@stephe-leake.org>
Commit: Stephen Leake <stephen_le...@stephe-leake.org>
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
