bug#63896: [PATCH] Support annotating and sorting the project list during completion

[Spencer Baugh <sbaugh@janestreet.com>]

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

Tags: patch


This patch adds an annotation-function and display-sort-function to the
completion-table used for project-prompt-project-dir and
project-prompt-project-name, as well as a user customization variable to
customize the behavior of the annotation and sorting functions.

The idea is that projects are annotated with useful information for
deciding which one you want to switch to, and sorted based on how likely
you are to want to switch to or work on them.  For example, a user might
want to know how many buffers they have open in each project, to help
tell them apart at a glance.  Furthermore, a user might be more likely
to switch to projects they've already been working on in this Emacs
instance, so they might want projects with more buffers open to be
sorted before projects with no buffers.

All this is customized by the variable project-annotations which is a
list of functions used to generate the annotations and sorting metadata.
The user can add their own functions to add new annotations and sorting
behavior.  See its docstring for more details.

I added three annotation functions as a starting point, which when added
to project-annotations will annotate with the number of buffers, the
modification time of the root directory, and compilation results.

In this patch I have turned all three of these annotations on by
default, by putting all three in project-annotations, but probably when
this is actually pushed we want project-annotations to be empty by
default.  (Maybe?)

In my own packages, building on this, I hope to add annotation functions
like "number of bugs assigned to you in this project" and "number of
lines of incoming code to review in this project", so that
project-switch-project is a nice way to pick what to work on next.

This patch is still a bit rough around the edges, but I'm posting it now
to get feedback.

In GNU Emacs 29.0.90 (build 6, x86_64-pc-linux-gnu, GTK+ Version
 3.22.30, cairo version 1.15.12) of 2023-06-02 built on igm-qws-u22796a
Repository revision: ff6163fac51759945aa619ca6bf28413be4a53e0
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: CentOS Linux 7 (Core)

Configured using:
 'configure --with-x-toolkit=gtk --with-gif=ifavailable'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-annotating-and-sorting-the-project-list-duri.patch --]
[-- Type: text/patch, Size: 7658 bytes --]

From 11d76029db5f0d9e016f247aac24dd430b729c2a Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Sat, 3 Jun 2023 13:21:30 -0400
Subject: [PATCH] Support annotating and sorting the project list during
 completion

---
 lisp/progmodes/project.el | 124 +++++++++++++++++++++++++++++++++++---
 1 file changed, 117 insertions(+), 7 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 04c67710d71..01ce414221f 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -317,6 +317,117 @@ project--file-completion-table
      (t
       (complete-with-action action all-files string pred)))))
 
+(defun project-annotation-numbufs (pr)
+  "Annotate PROJECT with the length of `project-buffers'."
+  (let ((numbufs (length (project-buffers pr))))
+    (cons numbufs
+          (if (zerop numbufs)
+              ""
+            (format "%s buf" numbufs)))))
+
+(defun project-annotation-mtime (pr)
+  "Annotate PROJECT with the modification time of its root directory.
+
+Note that the modification time will only change when files
+directly under the root directory are added or deleted.  If you
+only add or delete files in subdirectories, or if you only modify
+existing files, the modification time won't change."
+  (let* ((mtime (file-attribute-modification-time (file-attributes (project-root pr))))
+         (since-change (float-time (time-subtract (current-time) mtime))))
+    (cons (- since-change)
+          (cl-dolist (format '("%x%Y" "%x%D" "%x%H" "%x%M" "%x%S") "")
+            (let ((result (format-seconds format since-change)))
+              (when (not (string-empty-p result))
+                (return (concat result " old"))))))))
+
+(defun project-annotation-compilation (project)
+  "Annotate PROJECT with information from its compilation buffer if any."
+  (let* ((default-directory (project-root project))
+         (name (funcall
+                (or project-compilation-buffer-name-function
+                    compilation-buffer-name-function) "compilation"))
+         (buf (get-buffer name)))
+    (if buf
+        ;; TODO we should include in the sorting number whether the
+        ;; compilation exited non-zero; I don't see where, if
+        ;; anywhere, that's stored, though...
+        (with-current-buffer buf
+          (cons (+ (* 100 compilation-num-errors-found)
+                   (* 10 compilation-num-warnings-found)
+                   compilation-num-infos-found)
+                (format-mode-line mode-line-process nil nil buf)))
+      ;; projects with no errors are less interesting;
+      ;; sort them below projects that haven't been compiled at all
+      '(1 . ""))))
+
+(defcustom project-annotations (list
+                                #'project-annotation-compilation
+                                #'project-annotation-numbufs
+                                #'project-annotation-mtime
+                                )
+  "Functions to call to add annotations when prompting for a project.
+
+While prompting for a project in `project-current' or
+`project-switch-project', these functions are called to annotate
+each completion alternative with information about the project,
+and provide metadata to sort the projects by relevance.  By
+customizing this variable, you can make arbitrary information
+available during project completion, as long as it's fast enough
+to compute that it doesn't slow down completion.
+
+The order of functions in this list determines the order in which
+annotations are used, which determines both their precedence for
+sorting and the order in which they appear as an annotation after
+the completion alternative.
+
+Each function is called with a single argument, a project
+instance.  It should return a cons cell, whose car should be
+numeric and is used to sort the projects, greater values first,
+and whose cdr should be a string to be included as an annotation
+on the project during completion."
+  :type '(repeat (const :tag "Number of buffers"
+                        project-annotation-compilation)
+                 (const :tag "Modification time of root dir"
+                        project-annotation-mtime)
+                 (const :tag "Compilation results"
+                        project-annotation-compilation)
+                 (function :tag "Custom function" nil)))
+
+(defun project--project-completion-table (collection projects)
+  "Completion table for project identifiers in COLLECTION
+
+PROJECTS should be an alist mapping completions from COLLECTION
+to project instances.  Completions which are not in PROJECTS are
+not annotated with `project-annotations'."
+  (let* (annots
+         (get-annot (lambda (completion pr)
+                (or (cdr (assoc completion annots))
+                    (let ((annot (mapcar (lambda (func) (funcall func pr)) project-annotations)))
+                      (push (cons completion annot) annots)
+                      annot))))
+         (annotation-function
+          (lambda (completion)
+            (if-let (pr (cdr (assoc completion projects)))
+                (let ((annotations (mapcar #'cdr (funcall get-annot completion pr))))
+                  (concat " " (string-join (seq-remove #'string-empty-p annotations) ", ")))
+              "")))
+         (display-sort-function
+          (lambda (completions)
+            (let ((with-nums (mapcar (lambda (completion)
+                                       (cons (when-let (pr (cdr (assoc completion projects)))
+                                               (mapcar #'car (funcall get-annot completion pr)))
+                                             completion))
+                                     completions)))
+              (mapcar #'cdr (sort with-nums (lambda (a b) (version-list-< (car b) (car a)))))))))
+    (lambda (string pred action)
+      (cond
+       ((eq action 'metadata)
+        `(metadata . ((category . project-file)
+                      (annotation-function . ,annotation-function)
+                      (display-sort-function . ,display-sort-function))))
+       (t
+        (complete-with-action action collection string pred))))))
+
 (cl-defmethod project-root ((project (head transient)))
   (cdr project))
 
@@ -1640,11 +1751,12 @@ project-prompt-project-dir
 It's also possible to enter an arbitrary directory not in the list."
   (project--ensure-read-project-list)
   (let* ((dir-choice "... (choose a dir)")
+         (projects
+          (mapcar (lambda (dir)
+                    (cons (car dir) (project--find-in-directory (car dir))))
+                  project--list))
          (choices
-          ;; XXX: Just using this for the category (for the substring
-          ;; completion style).
-          (project--file-completion-table
-           (append project--list `(,dir-choice))))
+          (project--project-completion-table (cons dir-choice projects) projects))
          (pr-dir ""))
     (while (equal pr-dir "")
       ;; If the user simply pressed RET, do this again until they don't.
@@ -1667,9 +1779,7 @@ project-prompt-project-name
               (if-let (proj (project--find-in-directory dir))
                   (push (cons (project-name proj) proj) ret)))
             ret))
-         ;; XXX: Just using this for the category (for the substring
-         ;; completion style).
-         (table (project--file-completion-table (cons dir-choice choices)))
+         (table (project--project-completion-table (cons dir-choice choices) choices))
          (pr-name ""))
     (while (equal pr-name "")
       ;; If the user simply pressed RET, do this again until they don't.
-- 
2.39.3