From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 31 Aug 2021 12:12:13 +0000 (+0200)
Subject: Add aggregate project discovery and maintenance functions
X-Git-Tag: emacs-28.0.90~721
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=aef84c5f17c33714bda402e9408a3cb2ae928b61;p=emacs.git

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-projects-under): Add command
* etc/NEWS: Document new commands
---

diff --git a/etc/NEWS b/etc/NEWS
index fb7a7f628ae..a64c714e2c6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2410,10 +2410,21 @@ project's root directory, respectively.
 This specifies the file in which to save the list of known projects.
 
 +++
-*** New command 'project-forget-project'.
-This command lets you interactively remove an entry from the list of projects
+*** New command 'project-remember-projects-under'.
+This command can automatically locate and index projects in a
+directory and optionally also it's subdirectories, storing them in
+'project-list-file'.
+
++++
+*** New commands 'project-forget-project' and 'project-forget-projects-under'
+These command lets you interactively remove entries from the list of projects
 in 'project-list-file'.
 
++++
+*** New command 'project-forget-zombie-projects'
+This command detects indexed projects that have since been deleted,
+and removes them from the list of known projects in 'project-list-file'
+
 ---
 *** 'project-find-file' now accepts non-existent file names.
 This is to allow easy creation of files inside some nested
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 9b63f4b1bc8..57a961c2607 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1296,9 +1296,10 @@ With some possible metadata (to be decided).")
       (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)
@@ -1306,7 +1307,8 @@ Save the result in `project-list-file' if the list of projects has changed."
         (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.
@@ -1363,6 +1365,70 @@ It's also possible to enter an arbitrary directory not in the list."
   (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-forget-project proj))))
+
+(defun project-forget-projects-under (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-forget-project proj)
+            (setq count (1+ count))))
+      (dolist (proj (project-known-project-roots))
+        (when (file-equal-p (file-name-directory proj) dir)
+          (project-forget-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))
+
 
 ;;; Project switching