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