From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stephen Leake Newsgroups: gmane.emacs.devel Subject: Re: completing-read return meta-information? Date: Mon, 21 Sep 2015 11:46:50 -0500 Message-ID: <861tdrwwhx.fsf@stephe-leake.org> References: <86y4g6zcuo.fsf@stephe-leake.org> <7c37cd21-a9e0-48fa-b5a2-a32595c43dda@default> <86twquxnpa.fsf@stephe-leake.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1442854068 10770 80.91.229.3 (21 Sep 2015 16:47:48 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 21 Sep 2015 16:47:48 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Sep 21 18:47:38 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Ze4Fd-0002DY-4w for ged-emacs-devel@m.gmane.org; Mon, 21 Sep 2015 18:47:37 +0200 Original-Received: from localhost ([::1]:59780 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Ze4Fc-00067i-EW for ged-emacs-devel@m.gmane.org; Mon, 21 Sep 2015 12:47:36 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37582) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Ze4FL-00067V-Eb for emacs-devel@gnu.org; Mon, 21 Sep 2015 12:47:20 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Ze4FI-0003Mn-5E for emacs-devel@gnu.org; Mon, 21 Sep 2015 12:47:19 -0400 Original-Received: from gproxy8-pub.mail.unifiedlayer.com ([67.222.33.93]:39098) by eggs.gnu.org with smtp (Exim 4.71) (envelope-from ) id 1Ze4FH-0003Md-R8 for emacs-devel@gnu.org; Mon, 21 Sep 2015 12:47:16 -0400 Original-Received: (qmail 22286 invoked by uid 0); 21 Sep 2015 16:47:11 -0000 Original-Received: from unknown (HELO cmgw2) (10.0.90.83) by gproxy8.mail.unifiedlayer.com with SMTP; 21 Sep 2015 16:47:11 -0000 Original-Received: from host114.hostmonster.com ([74.220.207.114]) by cmgw2 with id Ksmz1r00f2UdiVW01sn2c9; Mon, 21 Sep 2015 10:47:09 -0600 X-Authority-Analysis: v=2.1 cv=C6F6l2/+ c=1 sm=1 tr=0 a=CQdxDb2CKd3SRg4I0/XZPQ==:117 a=CQdxDb2CKd3SRg4I0/XZPQ==:17 a=DsvgjBjRAAAA:8 a=f5113yIGAAAA:8 a=9i_RQKNPAAAA:8 a=hEr_IkYJT6EA:10 a=x_XPkuGwIRMA:10 a=ff-B7xzCdYMA:10 a=5D8EXkk81hhRKhHuF94A:9 a=8eJqvynGz8WWNJAUV2QA:9 a=PWM93dVqHoPLwNuy854A:9 Original-Received: from [76.218.37.33] (port=64263 helo=TAKVER2) by host114.hostmonster.com with esmtpa (Exim 4.84) (envelope-from ) id 1Ze4F3-0002tM-8f for emacs-devel@gnu.org; Mon, 21 Sep 2015 10:47:01 -0600 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (windows-nt) X-Identified-User: {2442:host114.hostmonster.com:stephele:stephe-leake.org} {sentby:smtp auth 76.218.37.33 authed with stephen_leake@stephe-leake.org} X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 67.222.33.93 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:190197 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >> There is a desire to refactor this so that the only difference is inside >> the completion table. > > I think the uniquification shouldn't be done in the completion table. > > All the fancy rewriting to make things shorter should be done in the > completion-style, instead. The style code can choose to return different > kinds of results for completion-all-completions (which gets displayed > in *Completions*, in Company, or in Icomplete-mode and where we should > try and reduce redundancy) and for completion-try-completion. > > So completion-all-completions can return names like "foo" while > completion-try-completion can return "~/src/file/foo/toto/bar.agda". Attached is code that implements this, together with ert test code for it (helpful in getting the details right). This achieves the goal of moving all of the uniquification code out of the completion table; that required advice on test-completion. It also achieves the goal of returning an absolute string from completing-read; that required advice on completing-read-default to call the new function completion-get-data-string. Note that this does not handle completion on multiple fields (for uniquifying directories); I was focusing on the changes to completion needed to return an absolute file name. That will be added later, and may require design changes See the header comment in minibuffer-patches.el for some design notes. This may be an acceptable implementation, but it would be better to extend completion-style-alist to include slots for completion-test-completion and completion-get-data-string. I think that can be done in a backward-compatible way; if (nth 2 completion-style-alist) (for completion-test-completion) returns a string, just call test-completion, and if (nth 3 completion-style-alist) (for completion-get-data-string) returns nil just return the input string. Then we can change all uses of `test-completion' to call `completion-test-completion'. I'm not entirely sure where the call to completion-get-data-string should be added; one place is in `completion--complete-and-exit', but there may be others. (I didn't advise completion--complete-and-exit directly because I didn't want to mix advice and signals). To try this out, load minibuffer-patches, and call find-absfile via M-: (find-absfile load-path). Note that will not allow you to complete to ede/locate.el; that will also be added later. When you enter a string that does not match any filename, this gives an error from one of the basic completion functions; I have not tried to track that down yet. -- -- Stephe --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=minibuffer-patches.el Content-Transfer-Encoding: quoted-printable ;; new completion style -*- lexical-binding:t -*- ;; There are four kinds of strings involved in completion. For most ;; categories, they are all the same; the following table describes ;; them for the absfile category. ;; ;; - user input ;; ;; The string typed by the user in the minibuffer. ;; ;; Also returned by try-completions when it extends the string. ;; ;; For the absfile category, this is a partial file name plus any ;; required uniquifying directories, formatted according to ;; `find-absfile-uniquify-style' ;; ;; - completion table input ;; ;; The string input to the completion table function. ;; ;; The completion-try-completion, completion-all-completion, and ;; test-completion functions must convert the user input string to a ;; completion table input string when calling the corresponding ;; `*-completion'. ;; ;; For the absfile category, if the user input string contains any ;; directory portion, or if action is 'lambda (called from ;; test-completion), this contains the complete absolute directory ;; name followed by the partial file name. Otherwise it is just the ;; partial file name. ;; ;; - display ;; ;; The strings returned by the completion-all-completions ;; function. The displayed completion list consists of these strings ;; with the common prefix deleted. ;; ;; For the absfile category, this is the complete file name plus ;; any required uniquifying directories, formatted according to ;; find-absfile-uniquify-style. ;; ;; - data ;; ;; The string returned by completion-get-data-string. In the future, ;; this may be the string returned by completing-read; for now, ;; completing-read returns a display string, and the caller must ;; call completion-get-data-string. ;; ;; The completion table returns a list of these strings when action ;; is t. ;; ;; For the absfile category, this is an absolute file name. ;; ;; ;; Currently, completion-try-completion, completion-all-completion ;; support style-specific implementations via completion-style-alist, ;; but test-completion and completion-get-data-string do ;; not. Style-specific code is added to test-completion in advice, and ;; in completion-get-data-string in a case statement. ;; ;; We advise completing-read-default to call ;; completion-get-data-string on the result string. That should be ;; called from completion--complete-and-exit, to replace the buffer ;; string either after the case fixup. That's not possible with ;; advice, because completion--complete-and-exit does not exit ;; normally; it throws a signal (FIXME: can use condition-case in ;; around advice?). (defvar find-absfile-uniquify-style 'abbrev "Style used to format uniquifying directories. One of: - 'abbrev : minimal directories required to identify a unique file (may be = empty) - 'full : absolute directory path or empty") (defconst find-absfile-uniquify-regexp "^\\(.*\\)<\\(.*\\)>" "Regexp matching uniqufied file name. Match 1 is the filename, match 2 is the relative directory.") (defun find-absfile-uniquify-conflicts (conflicts) "Subroutine of `find-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))))) (let ((temp (cddr conflicts))) (while (and common-root temp) (setq common-root (fill-common-string-prefix common-root (file-name-direct= ory (pop temp)))))) (when common-root ;; Trim `common-root' back to last '/' (let ((i (1- (length common-root)))) (while (and (> i 0) (not (=3D (aref common-root i) ?/))) (setq i (1- i))) (setq common-root (substring common-root 0 (1+ i))))) (cl-mapcar (lambda (name) (concat (file-name-nondirectory name) "<" (substring (file-name-directory name) (length common-root)) ">"= )) conflicts) )) (defun find-absfile-uniquify (names) "Return a uniquified list of names built from NAMES. NAMES contains absolute file names. The result contains non-directory filenames with partial directory paths appended." (cl-ecase find-absfile-uniquify-style (abbrev (let (result conflicts ;; list of names where all non-directory names are the same. ) ;; Sort names 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=3D (file-name-nondirectory (car conflicts)) (file-name-nondi= rectory (car names)))) (push (pop names) conflicts)) (if (=3D 1 (length conflicts)) (push (file-name-nondirectory (car conflicts)) result) (setq result (append (find-absfile-uniquify-conflicts conflicts) result= ))) ) (nreverse result) )) (full names) )) (defun find-absfile-deuniquify (path name &optional force) "Convert display string NAME to table input string. PATH is used to fill in missing directories. If FORCE is non-nil (default nil), NAME must exist somewhere in PATH; always return absolute filename." (let ((match (string-match find-absfile-uniquify-regexp name))) (if (or match force) (let ((dirname (or (when match (match-string 2 name)) "")) (filename (or (when match (match-string 1 name)) name)) (temp-path path) dir matching-dir) (cond ((and (not force) (=3D 0 (length dirname))) filename) ((or force (< 0 (length dirname))) ;; Extend dirname to absolute directory name (while (and temp-path (not matching-dir)) ;; `path' should only have directories (ie end in slash), but ;; since it is often built by hand, it may not. (setq dir (file-name-as-directory (pop temp-path))) ;; FIXME: not doing completion on partial directory names yet. (cond (match (when (string-match dirname dir) (setq matching-dir dir))) (force (when (file-exists-p (concat dir name));; FIXME: Requires a flat path or = a recursive path iterator (setq matching-dir dir))) ))) ) (concat matching-dir filename)) ;; else not uniquified name))) (defun completion-uniquify-absfile-try-completion (string table pred point) "Implement `completion-try-completion' for uniquify-absfile." ;; Trivial try-completion backend; don't handle boundaries yet (let* ((beforepoint (substring string 0 point)) (completion (try-completion (completion-absfile-deuniquify beforepoint ta= ble pred) table pred))) (if (stringp completion) ;; multiple matches (cons completion (length completion)) ;; either no match or one match completion) )) (defun completion-uniquify-absfile-all-completions (string table pred point) "Implement `completion-all-completions' for uniquify-absfile." ;; Trivial all-completion backend; don't handle boundaries yet (find-absfile-uniquify (all-completions (completion-absfile-deuniquify (substring string 0 point) table pred) table pred))) (defun completion-absfile-deuniquify (display-string table pred &optional f= orce) "Implement `completion-get-data-string' for uniquify-absfile." (find-absfile-deuniquify (completion-metadata-get (completion-metadata di= splay-string table pred) 'path) display-string force)) (defun completion-uniquify-absfile-get-data-string (display-string table pr= ed) "Implement `completion-get-data-string' for uniquify-absfile." (completion-absfile-deuniquify display-string table pred t)) (defun completion-get-data-string (display-string table pred) "Return the data string corresponding to DISPLAY-STRING." ;; FIXME: should dispatch via completion-styles-alist ;; FIXME: should be called from completing-read somewhere (case (completion-metadata-get (completion-metadata display-string table = pred) 'category) (absfile (completion-uniquify-absfile-get-data-string display-string ta= ble pred)) (t display-string) )) (defun find-absfile-test-completion-advice (orig-fun string table &optional= pred) "Advice for `test-completion'; convert display string to table input." (let ((metadata (completion-metadata string table pred))) (case (completion-metadata-get metadata 'category) (absfile (setq string (find-absfile-deuniquify (completion-metadata-get metad= ata 'path) string t))) (t nil) )) (funcall orig-fun string table pred)) ;; FIXME: using :filter-args (with a suitably modified advice function) giv= es an error about argument count (advice-add #'test-completion :around #'find-absfile-test-completion-advice) (defun find-absfile-completing-read-default-advice (orig-fun prompt collect= ion &optional predicate require-match initial-input hist def inherit-input-method) "Advice for `completing-read-default'; convert display string to data str= ing." (let ((display-string (funcall orig-fun prompt collection predicate require-match initial-input hist def inherit-input-method))) (completion-get-data-string display-string collection predicate) )) (advice-add #'completing-read-default :around #'find-absfile-completing-rea= d-default-advice) (add-to-list 'completion-category-defaults '(absfile (styles . (uniquify-ab= sfile)))) (add-to-list 'completion-styles-alist '(uniquify-absfile completion-uniquify-absfile-try-completion completion-uniquify-absfile-all-completions "display uniquified filenames.")) (defun find-absfile-completion-table (path string _pred action) "Do completion for file names in `find-absfile'. PATH is a list of strings containing absolute directory names to be searched. STRING is the current user input. PRED is ignored. Filenames matching `completion-ignored-extensions' and filenames not matching `completion-regexp-list' are excluded, with `case-fold-search' bound to the value of `completion-ignore-case'. ACTION is the current completion action; one of: - nil; return common prefix, nil or t; see `try-completion' - t; return all completions; see `all-completions' - lambda; return non-nil if string is a valid completion; see `test-completion'. - '(boundaries . SUFFIX); return the completion region '(boundaries START . END); see `completion-boundaries'. - 'metadata; return (metadata . ALIST) as defined by `completion-metadata'. In addition, returns `path' metadata, for use by `completion-get-data-string'." (cond ((eq (car-safe action) 'boundaries) ;; FIXME: not doing completion on partial directory names yet (cons 'boundaries (cons 0 (length string)))) ((eq action 'metadata) (cons 'metadata (list '(category . absfile) (cons 'path path)))) ((eq action 'lambda) ;; Called from test-completion (and (file-name-absolute-p string) (file-exists-p string))) (t ;; `action' is one of: ;; t - return all completions ;; nil - return common prefix, nil or t (let ((dirname (file-name-directory string)) (filename (file-name-nondirectory string)) (result nil)) ;; list of abs filenames (dolist (dir path) ;; `path' is often built by hand, so it may contain names ;; that do not exist on the disk; check for that. It may not ;; end in "/"; file-name-as-directory ensures that. On ;; Windows, it may not contain the leading device (ie ;; "c:"). `dirname' will contain the device; ;; expand-file-name ensures that. (when (file-directory-p dir) (setq dir (expand-file-name (file-name-as-directory dir))) (when (or (=3D 0 (length dirname)) (string-equal dir dirname)) (setq result (append result (cl-mapcar (lambda (file) (if action (concat dir file) file)) (file-name-all-completions filename dir)))) ))) (if action result (cond ((null result) nil) ((and (=3D 1 (length result)) (=3D (length string) (length (car result)))) ;; unique exact match t) ((=3D 1 (length result)) ;; unique but not exact (car result)) (t (let ((temp (try-completion string result))) (if (eq t temp) ;; If result is all duplicates; `try-completion' returns t; return just o= ne. (list (car result)) temp))) ))) ) )) (defun find-absfile (path) "Find a file with completion in PATH." (let ((table (apply-partially 'find-absfile-completion-table path))) (find-file (completing-read "file: " table nil t "")) )) (provide 'minibuffer-patches) --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=minibuffer-test.el Content-Transfer-Encoding: quoted-printable ;; minibuffer-test.el - Test functions in minibuffer-patches.el -*- lexical= -binding:t -*- (require 'minibuffer-patches) (defun find-absfile-create-test-files () "Create test dirs and files; return path." (interactive) (let* ((root (make-temp-file "find-file-path-test" t)) (dir1 (concat root "/dir1")) (dir2 (concat root "/dir2"))) (mkdir dir1) (mkdir dir2) (with-temp-file (concat dir1 "/file1.text") (insert "dir1/file1.text")) (with-temp-file (concat dir1 "/file2.text") (insert "dir1/file2.text")) (with-temp-file (concat dir2 "/file1.text") (insert "dir2/file1.text")) (with-temp-file (concat dir2 "/file3.text") (insert "dir2/file3.text")) (list (file-name-as-directory dir1) (file-name-as-directory dir2)))) (defvar test-path (find-absfile-create-test-files)) (defvar dir1 (nth 0 test-path)) (defvar dir2 (nth 1 test-path)) (ert-deftest test-find-absfile-path-completion-table () "Test basic functions of table." ;; grouped by action (should (equal (find-absfile-completion-table test-path "fi" nil '(bounda= ries ".text")) '(boundaries . (0 . 2)))) (should (equal (find-absfile-completion-table test-path "fi" nil 'metadat= a) (cons 'metadata (list '(category . absfile) (cons 'path test-path))))) ;; all-completions (should (equal (find-absfile-completion-table test-path "fi" nil t) (list (concat dir1 "file2.text") (concat dir1 "file1.text") (concat dir2 "file3.text") (concat dir2 "file1.text") ))) (should (equal (find-absfile-completion-table test-path "file1.text" nil t) ;; some caller did not deuniquify; treated as no match nil)) ;; try-completion (should (equal (find-absfile-completion-table test-path "fi" nil nil) "file")) (should (equal (find-absfile-completion-table test-path "fil1" nil nil) ;= ; misspelled nil)) (should (equal (find-absfile-completion-table test-path "file2" nil nil) = ;; unique but not exact "file2.text")) (should (equal (find-absfile-completion-table test-path "file2.text" nil = nil) ;; unique and exact t)) (should (equal (find-absfile-completion-table test-path "file1.text= " nil nil) ;; Some caller did not deuniquify; treated as no match. nil)) ;; test-completion (should (equal (find-absfile-completion-table test-path "fi" nil 'lambda)= ;; not unique nil)) (should (equal (find-absfile-completion-table test-path "file1.text" nil 'lambda);; unique and exact ;; Some caller did not deuniquify: treated as no match. nil)) (should (equal (find-absfile-completion-table test-path (concat dir1 "fil= e2.text") nil 'lambda);; unique and exact t)) ) (ert-deftest test-completion-test-completion () (let ((find-absfile-uniquify-style 'abbrev) (table (apply-partially 'find-absfile-completion-table test-path))) (should (equal (test-completion "fi" table) ;; not unique nil)) (should (equal (test-completion "file1.text" table);; unique and= exact t)) (should (equal (test-completion "file2.text" table test-path);; unique = and exact t)) )) (ert-deftest test-completion-get-data-string () (let ((find-absfile-uniquify-style 'abbrev) (table (apply-partially 'find-absfile-completion-table test-path))) (should (equal (completion-get-data-string "file1.text" table ni= l) (concat dir1 "file1.text"))) (should (equal (completion-get-data-string "file2.text" table nil) (concat dir1 "file2.text"))) (should (equal (completion-get-data-string "file3.text" table nil) (concat dir2 "file3.text"))) )) (ert-deftest test-completion-uniquify-absfile-all-completions () (let ((find-absfile-uniquify-style 'abbrev) (table (apply-partially 'find-absfile-completion-table test-path)) string) (setq string "fi") (should (equal (completion-uniquify-absfile-all-completions string tabl= e nil (length string)) (list "file1.text" "file1.text" "file2.text" "file3.text= "))) (setq string "file2") (should (equal (completion-uniquify-absfile-all-completions string tabl= e nil (length string)) (list "file2.text"))) )) (ert-deftest test-completion-uniquify-absfile-try-completion () (let ((find-absfile-uniquify-style 'abbrev) (table (apply-partially 'find-absfile-completion-table test-path)) string) (setq string "fi") (should (equal (completion-uniquify-absfile-try-completion string table= nil (length string)) '("file" . 4))) (setq string "file2") ;; unique but not exact (should (equal (completion-uniquify-absfile-try-completion string table= nil (length string)) '("file2.text" . 10))) (setq string "file2.text") ;; unique and exact (should (equal (completion-uniquify-absfile-try-completion string table= nil (length string)) t)) (setq string "fil2") ;; misspelled (should (equal (completion-uniquify-absfile-try-completion string table= nil (length string)) nil)) )) (ert-deftest test-find-absfile-deuniquify () (should (equal (find-absfile-deuniquify test-path "file1.text") "file1.text")) (should (equal (find-absfile-deuniquify test-path "file2.text") "file2.text")) (should (equal (find-absfile-deuniquify test-path "file2.text" t) ;; uniq= ue (concat dir1 "file2.text"))) (should (equal (find-absfile-deuniquify test-path "file3.text") "file3.text")) (should (equal (find-absfile-deuniquify test-path "file3.text" t) ;; uniq= ue (concat dir2 "file3.text"))) (should (equal (find-absfile-deuniquify test-path "file1") ;; not = exact (concat dir2 "file1"))) (should (equal (find-absfile-deuniquify test-path "file1.text") ;;= exact (concat dir2 "file1.text"))) ) (ert-deftest test-find-absfile-uniquify () (let ((find-absfile-uniquify-style 'abbrev)) (should (equal (find-absfile-uniquify '("/dir1/file1.text" "/dir1/file2.text" "/dir2/file1.text" "/dir2/fil= e3.text")) (list "file1.text" "file1.text" "file2.text" "file3.text= "))) (should (equal (find-absfile-uniquify '("/dir1/file1.text" "/dir2/file1= .text")) (list "file1.text" "file1.text"))) (should (equal (find-absfile-uniquify '("/dir1/file2.text")) (list "file2.text"))) (should (equal (find-absfile-uniquify '("/dir1/file1.text" "/dir1/file2.text" "/dir2/file1.text" "/dir2/fil= e3.text")) (list "file1.text" "file1.text" "file2.text" "file3.text= "))) )) (provide 'test/minibuffer-test) --=-=-=--