Re: project--completing-read-strict breaks ada-mode project completion table

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 2834 bytes --]

On 19.04.2019 20:49, Stephen Leake wrote:
> I've pushed a scratch branch scratch/project-uniquify-files with a
> different approach to this issue.
> 
> I did some benchmarking, and realized that almost all of the time taken
> by uniq-file-completion-table startup is spent scanning the disk for
> file names, and filling the operating system disk cache. Doing all of
> that first to get the file list, and then doing completion on the list,
> is measureably slower than repeating the scan (using the cache) during
> completion, but the difference is not enough to be noticeable (unless
> the completion string eliminates most of the directories, which is not a
> typical case for uniquify-files).

I've seen similar results in my own optimization initiatives. Simple 
often beats being too clever.

> Since standard completion works with alists, one way to make the result
> string different from the display string is to build an alist with the
> display string as key.

I think this is the key insight. And we don't really need complex 
completion styles or special completion tables (which wouldn't work 
across project implementations).

> Then we just need to fetch the result string from
> the alist; completing-read does not do that, unfortunately (I guess
> because the cdr of the alist might not be a string, in general).

Calling cdr is not hard, though. An extra wrapper can do that.

> Also, in browsing around the completion sources, I found the
> 'quote/unquote' mechanism, which passes yet more actions to the
> completion table function.
> 
> So I added 'alist to the completion table metadata, and a step in
> completing-read-default to query the completion table with the 'alist
> action if that metadata is present.

Like I said before, we don't want project implementations to provide 
extra features like this by overriding project-file-completion-table. 
It's not customizable and thus not user-friendly.

> file-complete-root-relative and uniquify-files both use this mechanism;
> they wrap an alist in a completion function that handles 'alist.

All right. Let's try a different mechanism, though.

> project--completing-read-strict delegates the UI to the completion
> table, with the default using file-complete-root-relative.

Let's not do UI inside completion tables. Or as little as possible, at 
least.

Here is my counter-proposal (attached). It both nicely factors out the 
common-parent-directory logic (which had no place in 
completing-read-strict anyway) and creates a customization point.

You can write a different project-find-file-read-fn that would render 
the file names differently. For instance, with the alist example, you 
could build it, call project--completing-read-strict on it, and cdr at 
the end. Or use a hash-table, etc. Let me know if you need any help with 
implementing that.

[-- Attachment #2: project-find-file-read-fn.diff --]
[-- Type: text/x-patch, Size: 4984 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 7c8ca15868..70c9f60a0d 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -157,19 +157,13 @@ project--find-in-directory
     vc-directory-exclusion-list)
    grep-find-ignored-files))
 
-(cl-defgeneric project-file-completion-table (project dirs)
-  "Return a completion table for files in directories DIRS in PROJECT.
-DIRS is a list of absolute directories; it should be some
-subset of the project roots and external roots.
-
-The default implementation delegates to `project-files'."
-  (let ((all-files (project-files project dirs)))
-    (lambda (string pred action)
-      (cond
-       ((eq action 'metadata)
-        '(metadata . ((category . project-file))))
-       (t
-        (complete-with-action action all-files string pred))))))
+(defun project-file--completion-table (all-files)
+  (lambda (string pred action)
+    (cond
+     ((eq action 'metadata)
+      '(metadata . ((category . project-file))))
+     (t
+      (complete-with-action action all-files string pred)))))
 
 (cl-defmethod project-roots ((project (head transient)))
   (list (cdr project)))
@@ -470,19 +464,14 @@ project-or-external-find-file
                 (project-external-roots pr))))
     (project-find-file-in (thing-at-point 'filename) dirs pr)))
 
-(defun project-find-file-in (filename dirs project)
-  "Complete FILENAME in DIRS in PROJECT and visit the result."
-  (let* ((table (project-file-completion-table project dirs))
-         (file (project--completing-read-strict
-                "Find file" table nil nil
-                filename)))
-    (if (string= file "")
-        (user-error "You didn't specify the file")
-      (find-file file))))
+(defcustom project-find-file-read-fn #'project-find-file--read-cpd-relative
+  "Function to call to read a file name from a list.
+For the arguments list, see project-find-file--read-cpd-relative."
+  :type 'function)
 
-(defun project--completing-read-strict (prompt
-                                        collection &optional predicate
-                                        hist default inherit-input-method)
+(defun project-find-file--read-cpd-relative (prompt
+                                             collection &optional predicate
+                                             hist default)
   ;; Tried both expanding the default before showing the prompt, and
   ;; removing it when it has no matches.  Neither seems natural
   ;; enough.  Removal is confusing; early expansion makes the prompt
@@ -504,21 +493,43 @@ project--completing-read-strict
              ((eq action 'metadata)
               (if (functionp collection) (funcall collection nil nil 'metadata)))
              (t
-	      (complete-with-action action substrings string pred)))))
-         (new-prompt (if default
+              (complete-with-action action substrings string pred)))))
+         (res (project--completing-read-strict prompt
+                                               new-collection predicate
+                                               hist default)))
+    (concat common-parent-directory res)))
+
+(defun project-find-file-in (filename dirs project)
+  "Complete FILENAME in DIRS in PROJECT and visit the result."
+  (let* ((all-files (project-files project dirs))
+         (table (project-file--completion-table all-files))
+         (file (funcall project-find-file-read-fn
+                       "Find file" table nil nil
+                       filename)))
+    (if (string= file "")
+        (user-error "You didn't specify the file")
+      (find-file file))))
+
+(defun project--completing-read-strict (prompt
+                                        collection &optional predicate
+                                        hist default)
+  ;; Tried both expanding the default before showing the prompt, and
+  ;; removing it when it has no matches.  Neither seems natural
+  ;; enough.  Removal is confusing; early expansion makes the prompt
+  ;; too long.
+  (let* ((new-prompt (if default
                          (format "%s (default %s): " prompt default)
                        (format "%s: " prompt)))
          (res (completing-read new-prompt
-                               new-collection predicate t
+                               collection predicate t
                                nil ;; initial-input
-                               hist default inherit-input-method)))
+                               hist default)))
     (when (and (equal res default)
                (not (test-completion res collection predicate)))
       (setq res
             (completing-read (format "%s: " prompt)
-                             new-collection predicate t res hist nil
-                             inherit-input-method)))
-    (concat common-parent-directory res)))
+                             collection predicate t res hist nil)))
+    res))
 
 (declare-function fileloop-continue "fileloop" ())