From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Spencer Baugh Newsgroups: gmane.emacs.bugs Subject: bug#63896: [PATCH] Support annotating and sorting the project list during completion Date: Sun, 04 Jun 2023 17:20:19 -0400 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="19722"; mail-complaints-to="usenet@ciao.gmane.io" To: 63896@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Jun 04 23:21:26 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1q5vAD-0004wH-Mr for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 04 Jun 2023 23:21:25 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q5v9u-0003b2-JW; Sun, 04 Jun 2023 17:21:06 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q5v9r-0003aX-VY for bug-gnu-emacs@gnu.org; Sun, 04 Jun 2023 17:21:04 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1q5v9r-0001KW-Kv for bug-gnu-emacs@gnu.org; Sun, 04 Jun 2023 17:21:03 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1q5v9q-0006xa-HR for bug-gnu-emacs@gnu.org; Sun, 04 Jun 2023 17:21:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Spencer Baugh Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 04 Jun 2023 21:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 63896 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.168591363026688 (code B ref -1); Sun, 04 Jun 2023 21:21:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 4 Jun 2023 21:20:30 +0000 Original-Received: from localhost ([127.0.0.1]:47504 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q5v9J-0006wN-T7 for submit@debbugs.gnu.org; Sun, 04 Jun 2023 17:20:30 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:47884) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q5v9H-0006wD-7x for submit@debbugs.gnu.org; Sun, 04 Jun 2023 17:20:28 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q5v9G-0003Ri-N0 for bug-gnu-emacs@gnu.org; Sun, 04 Jun 2023 17:20:27 -0400 Original-Received: from mxout5.mail.janestreet.com ([64.215.233.18]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q5v9D-0001BM-Po for bug-gnu-emacs@gnu.org; Sun, 04 Jun 2023 17:20:26 -0400 Received-SPF: pass client-ip=64.215.233.18; envelope-from=sbaugh@janestreet.com; helo=mxout5.mail.janestreet.com X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:262987 Archived-At: --=-=-= Content-Type: text/plain 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' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Support-annotating-and-sorting-the-project-list-duri.patch >From 11d76029db5f0d9e016f247aac24dd430b729c2a Mon Sep 17 00:00:00 2001 From: Spencer Baugh 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 --=-=-=--