[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 9f5c4e0 1/2: In uniquify-files, use text property to pass
From: |
Stephen Leake |
Subject: |
[elpa] master 9f5c4e0 1/2: In uniquify-files, use text property to pass completion style |
Date: |
Fri, 15 Feb 2019 10:48:34 -0500 (EST) |
branch: master
commit 9f5c4e0fc0e34540f28a84fcf3fcb53592d8ad05
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
In uniquify-files, use text property to pass completion style
* packages/uniquify-files/uniquify-files.el:
(uniq-file--regexp, uniq-file--conflicts, uniq-file--hilit): Rename from
uniq-files-*.
(uniq-file--set-style): New.
(uniq-file-all-completions): Use it.
(completion-get-data-string, completion-to-table-input): Use
'completion-style text property.
* packages/uniquify-files/uniquify-files-test.el: Match code changes.
* packages/uniquify-files/file-complete-root-relative.el:
(fc-root-rel-all-completions): Set 'completion-style text property.
* packages/uniquify-files/file-complete-root-relative-test.el:
(test-fc-root-rel-test-completion-1): Match code changes.
---
.../file-complete-root-relative-test.el | 43 ++++++-----
.../uniquify-files/file-complete-root-relative.el | 1 +
packages/uniquify-files/uniquify-files-test.el | 45 +++++++-----
packages/uniquify-files/uniquify-files.el | 84 ++++++++++------------
4 files changed, 90 insertions(+), 83 deletions(-)
diff --git a/packages/uniquify-files/file-complete-root-relative-test.el
b/packages/uniquify-files/file-complete-root-relative-test.el
index f696288..ddf863e 100644
--- a/packages/uniquify-files/file-complete-root-relative-test.el
+++ b/packages/uniquify-files/file-complete-root-relative-test.el
@@ -174,33 +174,38 @@
)
(defun test-fc-root-rel-test-completion-1 (table)
- (should (equal (test-completion "foo-fi" table)
- nil))
+ ;; In normal operation, 'all-completions' is called before
+ ;; test-completion, and it sets the 'completion-style text property.
+ (cl-flet ((ss (str)
+ (put-text-property 0 1 'completion-style 'file-root-rel str)
+ str))
+ (should (equal (test-completion (ss "foo-fi") table)
+ nil))
- (should (equal (test-completion "dir/f-fi" table)
- nil))
+ (should (equal (test-completion (ss "dir/f-fi") table)
+ nil))
- (should (equal (test-completion "foo-file1.text" table)
- t)) ;; starts at root
+ (should (equal (test-completion (ss "foo-file1.text") table)
+ t)) ;; starts at root
- (should (equal (test-completion "alice-1/foo-file1.text" table)
- nil)) ;; does not start at root
+ (should (equal (test-completion (ss "alice-1/foo-file1.text") table)
+ nil)) ;; does not start at root
- (should (equal (test-completion "Alice/alice-1/foo-file1.text" table)
- t)) ;; starts at root
+ (should (equal (test-completion (ss "Alice/alice-1/foo-file1.text") table)
+ t)) ;; starts at root
- (should (equal (test-completion "foo-file3.text" table)
- nil))
+ (should (equal (test-completion (ss "foo-file3.text") table)
+ nil))
- (should (equal (test-completion "foo-file3.texts2" table)
- t))
+ (should (equal (test-completion (ss "foo-file3.texts2") table)
+ t))
- (should (equal (test-completion "Alice/alice-/bar-file2.text" table)
- nil))
+ (should (equal (test-completion (ss "Alice/alice-/bar-file2.text") table)
+ nil))
- (should (equal (test-completion "Alice/alice-1/bar-file2.text" table)
- t))
- )
+ (should (equal (test-completion (ss "Alice/alice-1/bar-file2.text") table)
+ t))
+ ))
(ert-deftest test-fc-root-rel-test-completion-iter ()
(let ((table (apply-partially 'fc-root-rel-completion-table-iter
fc-root-rel-iter))
diff --git a/packages/uniquify-files/file-complete-root-relative.el
b/packages/uniquify-files/file-complete-root-relative.el
index 929afdc..e3ece9a 100644
--- a/packages/uniquify-files/file-complete-root-relative.el
+++ b/packages/uniquify-files/file-complete-root-relative.el
@@ -191,6 +191,7 @@ character after each completion field."
(when all
(setq all (fc-root-rel-to-user all (fc-root-rel--root table)))
(fc-root-rel--hilit user-string all point))
+ (uniq-file--set-style all 'file-root-rel))
))
(defun fc-root-rel--valid-completion (string all root)
diff --git a/packages/uniquify-files/uniquify-files-test.el
b/packages/uniquify-files/uniquify-files-test.el
index 4dc1923..13214a4 100644
--- a/packages/uniquify-files/uniquify-files-test.el
+++ b/packages/uniquify-files/uniquify-files-test.el
@@ -159,30 +159,35 @@
)
(defun test-uniq-file-test-completion-1 (table)
- (should (equal (test-completion "foo-fi" table)
- nil))
+ ;; In normal operation, 'all-completions' is called before
+ ;; test-completion, and it sets the 'completion-style text property.
+ (cl-flet ((ss (str)
+ (put-text-property 0 1 'completion-style 'uniquify-file str)
+ str))
+ (should (equal (test-completion (ss "foo-fi") table)
+ nil))
- (should (equal (test-completion "f-fi<dir" table)
- nil))
+ (should (equal (test-completion (ss "f-fi<dir") table)
+ nil))
- (should (equal (test-completion "foo-file1.text<>" table)
- t))
+ (should (equal (test-completion (ss "foo-file1.text<>") table)
+ t))
- (should (equal (test-completion "foo-file1.text" table)
- t))
+ (should (equal (test-completion (ss "foo-file1.text") table)
+ t))
- (should (equal (test-completion "foo-file1.text<alice-1/>" table)
- t))
+ (should (equal (test-completion (ss "foo-file1.text<alice-1/>") table)
+ t))
- (should (equal (test-completion "foo-file3.tex" table) ;; partial file name
- nil))
+ (should (equal (test-completion (ss "foo-file3.tex") table) ;; partial
file name
+ nil))
- (should (equal (test-completion "foo-file3.texts2" table)
- t))
+ (should (equal (test-completion (ss "foo-file3.texts2") table)
+ t))
- (should (equal (test-completion "bar-file2.text<Alice/alice-" table)
- nil))
- )
+ (should (equal (test-completion (ss "bar-file2.text<Alice/alice-") table)
+ nil))
+ ))
(ert-deftest test-uniq-file-test-completion-func ()
(let ((table (apply-partially 'uniq-file-completion-table uft-iter)))
@@ -411,7 +416,9 @@
(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."
+all positions in POS-LIST in STRING; return new string.
+Also set 'completion-style."
+ (put-text-property 0 1 'completion-style 'uniquify-file string)
(while pos-list
(let ((pos (pop pos-list)))
(put-text-property pos (1+ pos) 'face 'completions-first-difference
string)))
@@ -509,7 +516,7 @@ all positions in POS-LIST in STRING; return new string."
(should (equal-including-properties
(sort (uniq-file-all-completions "foo-file3.text" table nil nil)
#'string-lessp)
(list
- "foo-file3.text"
+ (test-uniq-file-hilit '() "foo-file3.text")
(test-uniq-file-hilit '(14) "foo-file3.texts")
(test-uniq-file-hilit '(14) "foo-file3.texts2")
)))
diff --git a/packages/uniquify-files/uniquify-files.el
b/packages/uniquify-files/uniquify-files.el
index a281ebb..dc6c491 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -176,7 +176,7 @@
(require 'cl-lib)
(require 'path-iterator)
-(defconst uniq-files--regexp "^\\(.*\\)<\\([^>]*\\)>?$"
+(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.
@@ -212,8 +212,8 @@ Match 1 is the filename, match 2 is the relative
directory.")
"")
))
-(defun uniq-files--conflicts (conflicts dir)
- "Subroutine of `uniq-files-uniquify'."
+(defun uniq-file--conflicts (conflicts dir)
+ "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)))))
@@ -307,7 +307,7 @@ If DIR is non-nil, all elements of NAMES must match DIR."
(concat (file-name-nondirectory (car conflicts))))
result))
- (setq result (append (uniq-files--conflicts conflicts dir) result)))
+ (setq result (append (uniq-file--conflicts conflicts dir) result)))
)
(nreverse result)
))
@@ -315,7 +315,7 @@ If DIR is non-nil, all elements of NAMES must match DIR."
(defun uniq-file-to-table-input (user-string &optional _table _pred)
"Implement `completion-to-table-input' for uniquify-file."
- (let* ((match (string-match uniq-files--regexp user-string))
+ (let* ((match (string-match uniq-file--regexp user-string))
(dir (and match (match-string 2 user-string))))
(if match
@@ -479,7 +479,7 @@ Pattern is in reverse order."
(cons merged new-point)))
))
-(defun uniq-files--hilit (string all 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.
@@ -519,6 +519,14 @@ nil otherwise."
(setq result nil)))
result))
+(defun uniq-file--set-style (all style)
+ "Set completion-style text property on each string in ALL to STYLE."
+ (mapcar
+ (lambda (str)
+ (put-text-property 0 1 'completion-style style str)
+ str)
+ all))
+
(defun uniq-file-all-completions (user-string table pred point)
"Implement `completion-all-completions' for uniquify-file."
;; Returns list of data format strings (abs file names).
@@ -550,7 +558,8 @@ nil otherwise."
(when all
(setq all (uniq-file--uniquify all (file-name-directory table-string)))
- (uniq-files--hilit user-string all point))
+ (uniq-file--hilit user-string all point)
+ (uniq-file--set-style all 'uniquify-file))
))
(defun uniq-file-get-data-string (user-string table pred)
@@ -592,46 +601,31 @@ nil otherwise."
(defun completion-get-data-string (user-string table pred)
"Return the data string corresponding to USER-STRING."
- (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))
- ))
+ ;; If the style requires a conversion here, the completion-style
+ ;; text property was set on USER-STRING by the style implementation
+ ;; of all-completions.
+ (let* ((style (get-text-property 0 'completion-style user-string))
+ (to-data-func (when style (nth 5 (assq style
completion-styles-alist)))))
+ (if to-data-func
+ (funcall to-data-func user-string table pred)
+ user-string)))
(defun completion-to-table-input (orig-fun user-string table &optional pred)
- "Advice for `test-completion'; convert user string to table input."
- ;; See FIXME: in completion-get-data-string
- (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)
+ "Convert user string to table input."
+ ;; See comment in completion-get-data-string about completion-style
+ ;; text-property.
+ (let* ((style (get-text-property 0 'completion-style user-string))
+ (table-string
+ (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))))
+ (funcall orig-fun table-string table pred)
))
(advice-add #'test-completion :around #'completion-to-table-input)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 9f5c4e0 1/2: In uniquify-files, use text property to pass completion style,
Stephen Leake <=