; (project-forget-projects-under): Improve interactive behavior

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ca19febce8fb229604ae753be361105ba77d5cc7..b015387cfd792aef14b4251aa5eb5934626e3d5b 100644 (file)
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -2079,6 +2079,18 @@ Return the number of detected 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.
@@ -2087,7 +2099,9 @@ 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 (project-read-ancestor-directory "Forget projects under directory: ")
+         current-prefix-arg))
   (let ((count 0))
     (if recursive
         (dolist (proj (project-known-project-roots))
@@ -2103,9 +2117,15 @@ Return the number of forgotten projects."
       (project--write-project-list)
       (message (ngettext "%d project was forgotten"
                          "%d projects were forgotten"
-                         count) count))
+                         count)
+               count))
     count))
 
+(put 'project-forget-projects-under 'minibuffer-action
+     ;; TODO: Respect prefix arg.
+     ;; TODO: Update completion predicate for live feedback.
+     "forget")
+
 \f
 ;;; Project switching