[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master d0c6b0c 1/3: Improve uniquify-files
From: |
Stephen Leake |
Subject: |
[elpa] master d0c6b0c 1/3: Improve uniquify-files |
Date: |
Fri, 22 Mar 2019 22:02:14 -0400 (EDT) |
branch: master
commit d0c6b0cff6588fa1e13c7bbb7c42d756c13f386c
Author: Stephen Leake <address@hidden>
Commit: Stephen Leake <address@hidden>
Improve uniquify-files
* packages/uniquify-files/file-complete-root-relative.el:
(fc-root-rel-all-completions): Fix paren bug.
* packages/uniquify-files/uniquify-files.el:
(completion-current-style):New.
(uniq-file-try-completion, uniq-file-all-completions): Set it.
(uniq-file-all-completions): Fix bug.
(completion-get-data-string, completion-to-table-input): Use
completion-current-style.
(uniq-file-completing-read-default-advice): Let-bind
completion-current-style.
(locate-uniquified-file): Use completion table style metadata.
---
.../uniquify-files/file-complete-root-relative.el | 4 +-
packages/uniquify-files/uniquify-files.el | 71 ++++++++++++++--------
2 files changed, 46 insertions(+), 29 deletions(-)
diff --git a/packages/uniquify-files/file-complete-root-relative.el
b/packages/uniquify-files/file-complete-root-relative.el
index e09baa8..1724ecc 100644
--- a/packages/uniquify-files/file-complete-root-relative.el
+++ b/packages/uniquify-files/file-complete-root-relative.el
@@ -190,9 +190,9 @@ 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))
+ (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)
"Return non-nil if STRING is a valid completion in ALL,
diff --git a/packages/uniquify-files/uniquify-files.el
b/packages/uniquify-files/uniquify-files.el
index dc6c491..9c8ffc7 100644
--- a/packages/uniquify-files/uniquify-files.el
+++ b/packages/uniquify-files/uniquify-files.el
@@ -176,6 +176,9 @@
(require 'cl-lib)
(require 'path-iterator)
+(defvar completion-current-style nil
+ "Current active completion style.")
+
(defconst uniq-file--regexp "^\\(.*\\)<\\([^>]*\\)>?$"
;; The trailing '>' is optional so the user can type "<dir" in the
;; input buffer to complete directories.
@@ -413,6 +416,8 @@ Pattern is in reverse order."
uniq-all
done)
+ (setq completion-current-style 'uniquify-file)
+
;; Compute result or uniq-all, set done.
(cond
((or
@@ -520,7 +525,8 @@ nil otherwise."
result))
(defun uniq-file--set-style (all style)
- "Set completion-style text property on each string in ALL to STYLE."
+ "Set completion-style text property on each string in ALL to STYLE.
+Return a new list."
(mapcar
(lambda (str)
(put-text-property 0 1 'completion-style style str)
@@ -534,6 +540,8 @@ nil otherwise."
(let ((table-string (uniq-file-to-table-input user-string))
all)
+ (setq completion-current-style 'uniquify-file)
+
(cond
((functionp table)
(setq all (funcall table table-string pred t)))
@@ -558,8 +566,10 @@ nil otherwise."
(when all
(setq all (uniq-file--uniquify all (file-name-directory table-string)))
- (uniq-file--hilit user-string all point)
- (uniq-file--set-style all 'uniquify-file))
+ (setq all (uniq-file--hilit user-string all point))
+ (setq all (uniq-file--set-style all 'uniquify-file))
+ all
+ )
))
(defun uniq-file-get-data-string (user-string table pred)
@@ -601,32 +611,27 @@ nil otherwise."
(defun completion-get-data-string (user-string table pred)
"Return the data string corresponding to USER-STRING."
- ;; 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)))))
+ (let* ((to-data-func (when completion-current-style (nth 5 (assq
completion-current-style completion-styles-alist)))))
(if to-data-func
- (funcall to-data-func user-string table pred)
- user-string)))
+ (funcall to-data-func user-string table pred)
+ user-string))
+ )
(defun completion-to-table-input (orig-fun user-string table &optional 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))))
+ (let* ((table-string
+ (let ((to-table-func (if (functionp table)
+ (nth 4 (assq completion-current-style
completion-styles-alist)) ;; user to table
+
+ ;; TABLE is a list of absolute file names
+ (nth 5 (assq completion-current-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)
@@ -634,9 +639,17 @@ nil otherwise."
require-match
initial-input hist def
inherit-input-method)
"Advice for `completing-read-default'; convert user string to data string."
- (let ((user-string (funcall orig-fun prompt collection
+ (let* ((completion-current-style nil)
+ (user-string (funcall orig-fun prompt collection
predicate require-match initial-input hist def
inherit-input-method)))
+
+ (unless completion-current-style
+ ;; If completion-current-style is not set here, it's because the
+ ;; user invoked `exit-minibuffer' to use the default string, or
+ ;; because the completion functions did not set it (they are
+ ;; legacy).
+ (setq completion-current-style (car (cdr (assq 'styles
(completion-metadata "" collection nil))))))
(completion-get-data-string user-string collection predicate)
))
@@ -775,9 +788,13 @@ PRED returns non-nil. DEFAULT is the default for
completion.
In the user input string, `*' is treated as a wildcard."
(interactive)
- (let ((iter (make-path-iterator :user-path-non-recursive (or path
load-path))))
+ (let* ((iter (make-path-iterator :user-path-non-recursive (or path
load-path)))
+ (table (apply-partially #'uniq-file-completion-table iter))
+ (table-styles (cdr (assq 'styles (completion-metadata "" table nil))))
+ (completion-category-overrides
+ (list (list 'project-file (cons 'styles table-styles)))))
(completing-read (or prompt "file: ")
- (apply-partially #'uniq-file-completion-table iter)
+ table
predicate t nil nil default)
))