unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
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

  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).