bug#50297: 28.0.50; Aggregate project functions for project.el

[Philip Kaludercic]

The following patch introduces a few functions for aggregate project
maintenance:

- project-find-projects-under
  Select a directory with projects to index all at once.
- project-remove-zombie-projects
  Check if all known projects still exist and remove those
  that don't anymore
- project-remove-projects-under
  Remove all projects in a directory (inverse of
  project-find-projects-under).

Especially the last two are useful to maintain a clean project list
without having to manually remove every project one by one.

>From 3431a9123753d769f10621d2f5f6ef72ab0e2f3a 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-find-projects-under): Add command
(project-remove-zombie-projects): Add command
(project-remove-known-projects): Add command
---
 lisp/progmodes/project.el | 37 ++++++++++++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 3 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ae9bf03571..2f251393e2 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1261,9 +1261,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)
@@ -1271,7 +1272,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.
@@ -1325,6 +1327,35 @@ project-execute-extended-command
   (let ((default-directory (project-root (project-current t))))
     (call-interactively #'execute-extended-command)))
 
+(defun project-find-projects-under (dir)
+  "Index all projects below a directory DIR."
+  (interactive "DDirectory: ")
+  (let ((count 0))
+    (dolist (subdir (directory-files dir t nil t))
+      (when-let (pr (project--find-in-directory subdir))
+        (project-remember-project pr t)
+        (message "Found %s..." (project-root pr))
+        (setq count (1+ count))))
+    (if (zerop count)
+        (message "No projects found")
+      (project--write-project-list)
+      (message "%d project%s found"
+               count (if (= count 1) "" "s")))))
+
+(defun project-remove-zombie-projects ()
+  "Remove 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-remove-known-projects (dir)
+  "Remove all known projects below a directory DIR."
+  (interactive "DDirectory: ")
+  (dolist (proj (project-known-project-roots))
+    (when (file-in-directory-p proj dir)
+      (project-remove-known-project proj))))
+
 
 ;;; Project switching
 
-- 
2.30.2



In GNU Emacs 28.0.50 (build 7, x86_64-pc-linux-gnu, X toolkit, cairo version 
1.16.0, Xaw scroll bars)
 of 2021-08-26 built on icterid
Repository revision: b74afe63d02f126127d9211c0d1c1dc2cf5dd5bb
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Debian GNU/Linux 11 (bullseye)

Configured using:
 'configure LDFLAGS=-flto 'CFLAGS=-O2 -march=native -mtune=native -pipe'
 --with-native-compiler'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS X11
XDBE XIM XPM LUCID ZLIB

Important settings:
  value of $EMACSLOADPATH: 
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Git-Log-View

Minor modes in effect:
  TeX-PDF-mode: t
  global-git-commit-mode: t
  magit-auto-revert-mode: t
  shell-dirtrack-mode: t
  icomplete-mode: t
  rcirc-track-minor-mode: t
  display-time-mode: t
  winner-mode: t
  windmove-mode: t
  electric-pair-mode: t
  recentf-mode: t
  save-place-mode: t
  savehist-mode: t
  show-paren-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tab-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  temp-buffer-resize-mode: t
  buffer-read-only: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t

Load-path shadows:
/home/philip/.config/emacs/elpa/transient-0.3.6/transient hides 
/home/philip/Code/src/emacs/lisp/transient
~/.config/emacs/site-lisp/autoload hides 
/home/philip/Code/src/emacs/lisp/emacs-lisp/autoload

Features:
(shadow emacsbug tramp-archive tramp-gvfs tramp-cache zeroconf tramp
tramp-loaddefs trampver tramp-integration files-x tramp-compat ls-lisp
flymake-cc macrostep-c cmacexp macrostep preview tex-buf tex-fold
reftex-dcr reftex-auc reftex reftex-loaddefs reftex-vars font-latex
latex latex-flymake tex-ispell tex-style tex texmathp tex-mode latexenc
apropos eieio-opt speedbar ezimage dframe shortdoc vc-annotate
help-at-pt gnus-fun cl-print debug backtrace pulse find-func rect
markdown-mode shell-command+ rng-xsd xsd-regexp rng-cmpct rng-nxml
rng-valid rng-loc rng-uri rng-parse nxml-parse rng-match rng-dt rng-util
rng-pttrn nxml-ns nxml-mode nxml-outln nxml-rap nxml-util nxml-enc
xmltok xref find-dired grep mhtml-mode css-mode smie eww xdg url-queue
mm-url color js cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles
cc-align cc-engine cc-vars cc-defs sgml-mode facemenu whitespace
make-mode dired-aux ffap avy magit-extras bug-reference face-remap
magit-submodule magit-obsolete magit-blame magit-stash magit-reflog
magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote
magit-commit magit-sequence magit-notes magit-worktree magit-tag
magit-merge magit-branch magit-reset magit-files magit-refs magit-status
magit magit-repos magit-apply magit-wip magit-log which-func imenu
magit-diff git-commit log-edit add-log magit-core magit-autorevert
autorevert filenotify magit-margin magit-transient magit-process
with-editor term ehelp eshell esh-cmd esh-ext esh-opt esh-proc esh-io
esh-arg esh-module esh-groups esh-util shell pcomplete server magit-mode
transient format-spec magit-git magit-section magit-utils dash vc-fossil
vc-mtn vc-hg vc-git vc-bzr vc-src vc-sccs vc-svn vc-cvs vc-rcs icomplete
project memory-report char-fold misearch multi-isearch mailalias
bbdb-pgp url-http url-gw url-cache url-auth cus-edit pp cus-start
finder-inf bbdb-message autocrypt-message smerge-mode diff-mode
jka-compr mule-util smiley gnus-cite flow-fill mm-archive mail-extr
gnus-async gnus-bcklg qp sort gnus-ml disp-table autocrypt-gnus
autocrypt nndraft nnmh epa-file gnutls network-stream nsm nnmaildir
nnfolder vc-backup log-view pcvs-util vc vc-dispatcher diff time-stamp
bbdb-gnus bbdb-mua bbdb-com crm nnnil gnus-agent gnus-srvr gnus-score
score-mode nnvirtual gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime
smime dig nntp gnus-cache gnus-sum shr kinsoku svg dom gnus-group
gnus-undo gnus-start gnus-dbus dbus xml gnus-cloud nnimap nnmail
mail-source utf7 netrc nnoo gnus-spec gnus-int gnus-range message rmc
puny rfc822 mml mml-sec epa mm-decode mm-bodies mm-encode mailabbrev
gmm-utils mailheader gnus-win modus-vivendi-theme paredit checkdoc
flymake-proc flymake warnings thingatpt flyspell ispell noutline outline
easy-mmode gnus-dired dired-x dired dired-loaddefs rcirc parse-time
iso8601 rx time bbdb bbdb-site timezone sendmail gnus nnheader gnus-util
rmail rmail-loaddefs time-date mail-utils hippie-exp winner windmove
elec-pair recentf tree-widget wid-edit saveplace savehist paren
modus-operandi-theme modus-themes holidays hol-loaddefs cal-menu
calendar cal-loaddefs cus-load setup load compile text-property-search
comint ansi-color autoload lisp-mnt mail-parse rfc2231 rfc2047 rfc2045
mm-util ietf-drums mail-prsvr tex-site geiser-impl help-fns radix-tree
geiser-custom geiser-base ring slime-autoloads info package let-alist
derived edmacro kmacro pcase cl-extra help-mode browse-url url url-proxy
url-privacy url-expand url-methods url-history url-cookie url-domsuf
url-util mailcap url-handlers url-parse auth-source cl-seq eieio
eieio-core cl-macs eieio-loaddefs password-cache json map url-vars seq
byte-opt gv bytecomp byte-compile cconv epg epg-config subr-x
cl-loaddefs cl-lib iso-transl tooltip eldoc electric uniquify ediff-hook
vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode elisp-mode lisp-mode prog-mode register page
tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar
mouse jit-lock font-lock syntax font-core term/tty-colors frame
minibuffer cl-generic cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite charscript charprop case-table epa-hook jka-cmpr-hook help
simple abbrev obarray cl-preloaded nadvice button loaddefs faces
cus-face macroexp files window text-properties overlay sha1 md5 base64
format env code-pages mule custom widget hashtable-print-readable
backquote threads dbusbind inotify dynamic-setting system-font-setting
font-render-setting cairo x-toolkit x multi-tty make-network-process
emacs)

Memory information:
((conses 16 1167755 519125)
 (symbols 48 100287 1576)
 (strings 32 294014 1164412)
 (string-bytes 1 10068553)
 (vectors 16 85242)
 (vector-slots 8 1729184 892975)
 (floats 8 776 1974)
 (intervals 56 55886 9874)
 (buffers 992 65))

-- 
        Philip K.