all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: Spencer Baugh <sbaugh@janestreet.com>
To: 63896@debbugs.gnu.org
Subject: bug#63896: [PATCH] Support annotating and sorting the project list during completion
Date: Sun, 04 Jun 2023 17:20:19 -0400	[thread overview]
Message-ID: <ierpm6audpo.fsf@janestreet.com> (raw)

[-- 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


             reply	other threads:[~2023-06-04 21:20 UTC|newest]

Thread overview: 15+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-06-04 21:20 Spencer Baugh [this message]
2023-06-05 11:23 ` bug#63896: [PATCH] Support annotating and sorting the project list during completion Eli Zaretskii
2023-06-13 21:19   ` Spencer Baugh
2023-06-14 12:12     ` Eli Zaretskii
2023-06-15 19:04       ` Spencer Baugh
2023-06-16  5:43         ` Eli Zaretskii
2023-06-16 14:26           ` Spencer Baugh
2023-06-16 15:23             ` Eli Zaretskii
2023-06-27 20:30               ` Spencer Baugh
2023-06-28 11:45                 ` Eli Zaretskii
2023-08-24  1:54   ` Dmitry Gutov
2023-08-24  5:29     ` Eli Zaretskii
2023-08-24 13:08       ` Dmitry Gutov
2023-08-24 14:39         ` Eli Zaretskii
2023-08-24  1:47 ` Dmitry Gutov

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=ierpm6audpo.fsf@janestreet.com \
    --to=sbaugh@janestreet.com \
    --cc=63896@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.