From: Philip Kaludercic <philipk@posteo.net>
To: Dmitry Gutov <dgutov@yandex.ru>
Cc: 50297@debbugs.gnu.org
Subject: bug#50297: 28.0.50; Aggregate project functions for project.el
Date: Wed, 22 Sep 2021 18:55:37 +0000 [thread overview]
Message-ID: <87lf3ophhy.fsf@posteo.net> (raw)
In-Reply-To: <c3e54a2b-3ffc-026b-68a3-884a4bb39174@yandex.ru> (Dmitry Gutov's message of "Wed, 22 Sep 2021 03:31:42 +0300")
[-- Attachment #1: Type: text/plain, Size: 72 bytes --]
Here is the updated patch, with the new names and optional recursion:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-aggregate-project-discovery-and-maintenance-func.patch --]
[-- Type: text/x-diff, Size: 4642 bytes --]
From 4779aae9d1c18cd2dc2b8f54322b48b0e11ac5fb Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 31 Aug 2021 14:12:13 +0200
Subject: [PATCH] Add aggregate project discovery and maintenance functions
* project.el (project-remember-project): Add optional no-write argument
(project-remember-projects-under): Add command
(project-forget-zombie-projects): Add command
(project-forget-known-projects): Add command
---
lisp/progmodes/project.el | 72 +++++++++++++++++++++++++++++++++++++--
1 file changed, 69 insertions(+), 3 deletions(-)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ebd21d4b60..977b1ae185 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1290,9 +1290,10 @@ project--write-project-list
(write-region nil nil filename nil 'silent))))
;;;###autoload
-(defun project-remember-project (pr)
+(defun project-remember-project (pr &optional no-write)
"Add project PR to the front of the project list.
-Save the result in `project-list-file' if the list of projects has changed."
+Save the result in `project-list-file' if the list of projects
+has changed, and NO-WRITE is nil."
(project--ensure-read-project-list)
(let ((dir (project-root pr)))
(unless (equal (caar project--list) dir)
@@ -1300,7 +1301,8 @@ project-remember-project
(when (equal dir (car ent))
(setq project--list (delq ent project--list))))
(push (list dir) project--list)
- (project--write-project-list))))
+ (unless no-write
+ (project--write-project-list)))))
(defun project--remove-from-project-list (project-root report-message)
"Remove directory PROJECT-ROOT of a missing project from the project list.
@@ -1357,6 +1359,70 @@ project-execute-extended-command
(let ((default-directory (project-root (project-current t))))
(call-interactively #'execute-extended-command)))
+(defun project-remember-projects-under (dir &optional recursive)
+ "Index all projects below a directory DIR.
+If RECURSIVE is non-nil, recurse into all subdirectories to find
+more projects. After finishing, a message is printed summarizing
+the progress. The function returns the number of detected
+projects."
+ (interactive "DDirectory: \nP")
+ (project--ensure-read-project-list)
+ (let ((queue (directory-files dir t nil t)) (count 0)
+ (known (make-hash-table
+ :size (* 2 (length project--list))
+ :test #'equal )))
+ (dolist (project (mapcar #'car project--list))
+ (puthash project t known))
+ (while queue
+ (when-let ((subdir (pop queue))
+ ((file-directory-p subdir))
+ ((not (gethash subdir known))))
+ (when-let (pr (project--find-in-directory subdir))
+ (project-remember-project pr t)
+ (message "Found %s..." (project-root pr))
+ (setq count (1+ count)))
+ (when (and recursive (file-symlink-p subdir))
+ (setq queue (nconc (directory-files subdir t nil t) queue))
+ (puthash subdir t known))))
+ (unless (eq recursive 'in-progress)
+ (if (zerop count)
+ (message "No projects were found")
+ (project--write-project-list)
+ (message "%d project%s were found"
+ count (if (= count 1) "" "s"))))
+ count))
+
+(defun project-forget-zombie-projects ()
+ "Forget all known projects that don't exist any more."
+ (interactive)
+ (dolist (proj (project-known-project-roots))
+ (unless (file-exists-p proj)
+ (project-remove-known-project proj))))
+
+(defun project-forget-known-projects (dir &optional recursive)
+ "Forget all known projects below a directory DIR.
+If RECURSIVE is non-nil, recurse into all subdirectories to
+remove all known projects. After finishing, a message is printed
+summarizing the progress. The function returns the number of
+forgotten projects."
+ (interactive "DDirectory: \nP")
+ (let ((count 0))
+ (if recursive
+ (dolist (proj (project-known-project-roots))
+ (when (file-in-directory-p proj dir)
+ (project-remove-known-project proj)
+ (setq count (1+ count))))
+ (dolist (proj (project-known-project-roots))
+ (when (file-equal-p (file-name-directory proj) dir)
+ (project-remove-known-project proj)
+ (setq count (1+ count)))))
+ (if (zerop count)
+ (message "No projects were forgotten")
+ (project--write-project-list)
+ (message "%d project%s were forgotten"
+ count (if (= count 1) "" "s")))
+ count))
+
\f
;;; Project switching
--
2.30.2
[-- Attachment #3: Type: text/plain, Size: 24 bytes --]
--
Philip Kaludercic
next prev parent reply other threads:[~2021-09-22 18:55 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-08-31 12:47 bug#50297: 28.0.50; Aggregate project functions for project.el Philip Kaludercic
2021-09-01 1:07 ` Dmitry Gutov
2021-09-02 13:30 ` Philip Kaludercic
2021-09-02 14:45 ` Philip Kaludercic
2021-09-02 15:56 ` Juri Linkov
2021-09-03 1:02 ` Dmitry Gutov
2021-09-03 0:55 ` Dmitry Gutov
2021-09-22 0:31 ` Dmitry Gutov
2021-09-22 7:15 ` Philip Kaludercic
2021-09-22 12:13 ` Dmitry Gutov
2021-09-22 16:00 ` Juri Linkov
2021-09-22 16:44 ` Philip Kaludercic
2021-09-22 17:34 ` Dmitry Gutov
2021-09-22 18:06 ` Philip Kaludercic
2021-09-22 18:25 ` Dmitry Gutov
2021-09-22 18:53 ` Philip Kaludercic
2021-09-22 18:55 ` Philip Kaludercic [this message]
2021-09-23 2:44 ` Dmitry Gutov
2021-09-23 10:46 ` Philip Kaludercic
2021-09-23 11:56 ` Dmitry Gutov
2021-09-23 12:08 ` Philip Kaludercic
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
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87lf3ophhy.fsf@posteo.net \
--to=philipk@posteo.net \
--cc=50297@debbugs.gnu.org \
--cc=dgutov@yandex.ru \
/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 public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).