Package: emacs;
Reported by: Ship Mints <shipmints <at> gmail.com>
Date: Sat, 15 Feb 2025 17:51:02 UTC
Severity: wishlist
Tags: patch
View this message in rfc822 format
From: Ship Mints <shipmints <at> gmail.com> To: Eshel Yaron <me <at> eshelyaron.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 14:32:21 -0500
[Message part 1 (text/plain, inline)]
On Sat, Feb 15, 2025 at 2:18 PM Eshel Yaron <me <at> eshelyaron.com> wrote: > 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)) > Thank you for your thoughtful feedback. A couple of things stand out. First, calling completing-read directly means we can reuse the project-file completion category (and if you use something like marginalia, you get nice metadata in your completion list), and which also now can inhibit sorting the completion candidate list, which I find can be annoying for this kind of use case. Second, since this is forget "under" directories, prompting with the common prefixes that allow one to forget under the whole shebang makes more sense to me. Perhaps your ancestor list generator can be more efficient than the common-prefix code that I quickly wrote, and it would be helpful for it to show all common prefixes, don't you agree? -Stephane
[Message part 2 (text/html, inline)]
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.