GNU bug report logs - #76307
[PATCH] Add 'project-forget-projects-under-dirs', limit dir selection to relevant dirs

Previous Next

Full log

View this message in rfc822 format

From: Eshel Yaron <me <at> eshelyaron.com>
To: Ship Mints <shipmints <at> gmail.com>
Cc: 76307 <at> debbugs.gnu.org
Subject: bug#76307: [PATCH] Add 'project-forget-projects-under-dirs', limit dir selection to relevant dirs
Date: Sat, 15 Feb 2025 20:17:57 +0100

Hi there,

Ship Mints <shipmints <at> gmail.com> writes:

> *** Improved directory selection in 'project-forget-projects-under'.
>
> This command now prompts using a directory list limited to those in the
> remembered project list.  Previously, it would prompt using general
> directories from the file system.
>
> I hope this isn't controversial...it made limited sense to me that the prompt candidates had no relationship to
> remembered projects.

I fully agree, the project-forget-projects-under prompt could be more helpful.


> +(defun project--list-common-dir-prefixes ()
> +  "Return a list of common directory prefixes from `project--list'.
> +The returned list is lexically sorted."
> +  (project--ensure-read-project-list)
> +  (let ((non-essential t) ; inhibit remote-file actions
> +        (file-name-handler-alist nil) ; ditto
> +        (dirs (seq-uniq
> +               (mapcar (lambda (x)
> +                         (expand-file-name (file-name-as-directory (car x))))
> +                       project--list)))
> +        (prefixes))
> +    ;; Surely, there's a better algorithm than n^2.
> +    (dolist (dir dirs)
> +      (dolist (dir2 dirs)
> +        ;; dir equal dir2 might be a singlet we want, so don't prune.
> +        (when-let* ((common-prefix
> +                     (fill-common-string-prefix dir dir2))
> +                    ((string-suffix-p "/" common-prefix)) ; ignore naked remote ":" prefixes
> +                    (common-prefix (abbreviate-file-name common-prefix))
> +                    ((not (member common-prefix prefixes))))
> +          (push common-prefix prefixes))))
> +    (sort prefixes #'string<)))
> +
>  (defun project-forget-zombie-projects ()
>    "Forget all known projects that don't exist any more."
>    (interactive)
> @@ -2099,13 +2125,25 @@ project-forget-zombie-projects
>  
>  (defun project-forget-projects-under (dir &optional recursive)
>    "Forget all known projects below a directory DIR.
> -Interactively, prompt for DIR.
> +Interactively, prompt for DIR, and default to the current directory.
>  Optional argument RECURSIVE, if non-nil (interactively, the prefix
>  argument), means recurse into subdirectories under DIR
>  to remove those projects from the index.
>  Display a message at the end summarizing what was forgotten.
>  Return the number of forgotten projects."
> -  (interactive "DDirectory: \nP")
> +  (interactive
> +   (list
> +    (let* ((candidates
> +            (append (list (abbreviate-file-name
> +                           (file-name-as-directory
> +                            default-directory)))
> +                    (project--list-common-dir-prefixes)))
> +           (comps
> +            (completing-read "Directory: "
> +                             (project--file-completion-table candidates 'no-sort)
> +                             nil t))
> +           comps))
> +    (not (null current-prefix-arg))))
>    (let ((count 0))
>      (if recursive
>          (dolist (proj (project-known-project-roots))

ISTM that we can stick to read-directory-name, but add a completion
predicate that only keeps directories that lead to project roots.

Here's how that could look:

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 35bf66c9ffb..b20e3d5981d 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -2097,6 +2097,18 @@ project-forget-zombie-projects
     (unless (file-exists-p proj)
       (project-forget-project proj))))
 
+(defun project-read-ancestor-directory (prompt)
+  "Prompt with PROMPT for an ancestor directory of one or more project roots."
+  (project--ensure-read-project-list)
+  (read-directory-name
+   prompt nil nil nil nil
+   (let ((ps (mapcar (lambda (p) (expand-file-name (car p))) project--list)))
+     (lambda (dir)
+       (catch 'ball
+         (dolist (p ps)
+           (when (string-prefix-p (expand-file-name dir) p)
+             (throw 'ball t))))))))
+
 (defun project-forget-projects-under (dir &optional recursive)
   "Forget all known projects below a directory DIR.
 Interactively, prompt for DIR.
@@ -2105,7 +2117,9 @@ project-forget-projects-under
 to remove those projects from the index.
 Display a message at the end summarizing what was forgotten.
 Return the number of forgotten projects."
-  (interactive "DDirectory: \nP")
+  (interactive
+   (list (project-read-ancestor-directory "Forget projects under directory: ")
+         current-prefix-arg))
   (let ((count 0))
     (if recursive
         (dolist (proj (project-known-project-roots))



Best,

Eshel

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.