master d97f224: Merge branch 'feature/project-switching'

[Simen Heggestøyl]

branch: master
commit d97f224fd0db2ee13150ec7c4d6311eab48cda9e
Merge: 2bdb2cd 9823c66
Author: Simen Heggestøyl <simenheg@gmail.com>
Commit: Simen Heggestøyl <simenheg@gmail.com>

    Merge branch 'feature/project-switching'
---
 doc/emacs/maintaining.texi |  35 +++++++++-
 etc/NEWS                   |  13 ++++
 lisp/progmodes/project.el  | 157 ++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 195 insertions(+), 10 deletions(-)

diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index ebcdddf..22b7639 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1656,8 +1656,16 @@ support additional types of projects.
 the project back-end.  For example, the VC back-end doesn't consider
 ``ignored'' files (@pxref{VC Ignore}) to be part of the project.
 
+@menu
+* Project File Commands:: Commands for handling project files.
+* Switching Projects::    Switching between projects.
+@end menu
+
+@node Project File Commands
+@subsection Project File Commands
+
   Emacs provides commands for handling project files conveniently.
-This section describes these commands.
+This subsection describes these commands.
 
 @cindex current project
   All of the commands described here share the notion of the
@@ -1705,6 +1713,31 @@ Replace}), and continues to the next match after you 
respond.  If your
 response causes Emacs to exit the query-replace loop, you can later
 continue with @w{@kbd{M-x fileloop-continue @key{RET}}}.
 
+@findex project-dired
+  The command @code{project-dired} opens a Dired buffer
+(@pxref{Dired}) listing the files in the current project's root
+directory.
+
+@findex project-eshell
+  The command @code{project-eshell} starts an Eshell session in a new
+buffer with the current project's root as the working directory.
+@xref{Top,Eshell,Eshell, eshell, Eshell: The Emacs Shell}.
+
+@node Switching Projects
+@subsection Switching Projects
+
+  Commands that operate on project files (@pxref{Project File
+Commands}) will conveniently prompt you for a project directory when
+no project is current.  When you are inside a project but you want to
+operate on a different project, the command
+@code{project-switch-project} can be used.
+
+  This command prompts you to choose a directory among known project
+roots, and then displays the menu of available commands to operate on
+the chosen project.  The variable @code{project-switch-commands}
+controls which commands are available in the menu, and by which keys
+they are invoked.
+
 @node Change Log
 @section Change Logs
 
diff --git a/etc/NEWS b/etc/NEWS
index ac65b32..32b4435 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -395,6 +395,19 @@ information, see the related entry about 'shr-browse-url' 
above.
 
 *** New user option 'project-vc-merge-submodules'.
 
+*** Previously used project directories are now suggested by
+all commands that prompt for a project directory.
+
++++
+*** New commands 'project-dired' and 'project-eshell'.
+These commands run Dired and Eshell in a project's root directory,
+respectively.
+
++++
+*** New command 'project-switch-project'.
+This command lets you "switch" to another project and run a project
+command chosen from a dispatch menu.
+
 ** json.el
 
 ---
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 88f73e4..a3e81d4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -93,6 +93,7 @@
 ;;; Code:
 
 (require 'cl-generic)
+(eval-when-compile (require 'subr-x))
 
 (defvar project-find-functions (list #'project-try-vc)
   "Special hook to find the project containing a given directory.
@@ -100,23 +101,26 @@ Each functions on this hook is called in turn with one
 argument (the directory) and should return either nil to mean
 that it is not applicable, or a project instance.")
 
+(defvar project-current-inhibit-prompt nil
+  "Non-nil to skip prompting the user in `project-current'.")
+
 ;;;###autoload
 (defun project-current (&optional maybe-prompt dir)
   "Return the project instance in DIR or `default-directory'.
 When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
-the user for a different directory to look in.  If that directory
-is not a part of a detectable project either, return a
-`transient' project instance rooted in it."
+the user for a different project to look in."
   (unless dir (setq dir default-directory))
   (let ((pr (project--find-in-directory dir)))
     (cond
      (pr)
-     (maybe-prompt
-      (setq dir (read-directory-name "Choose the project directory: " dir nil 
t)
-            pr (project--find-in-directory dir))
-      (unless pr
-        (message "Using `%s' as a transient project root" dir)
-        (setq pr (cons 'transient dir)))))
+     ((unless project-current-inhibit-prompt
+        maybe-prompt)
+      (setq dir (project-prompt-project-dir)
+            pr (project--find-in-directory dir))))
+    (if pr
+        (project--add-to-project-list-front pr)
+      (project--remove-from-project-list dir)
+      (setq pr (cons 'transient dir)))
     pr))
 
 (defun project--find-in-directory (dir)
@@ -662,6 +666,19 @@ PREDICATE, HIST, and DEFAULT have the same meaning as in
                              collection predicate t res hist nil)))
     res))
 
+;;;###autoload
+(defun project-dired ()
+  "Open Dired in the current project."
+  (interactive)
+  (dired (project-root (project-current t))))
+
+;;;###autoload
+(defun project-eshell ()
+  "Open Eshell in the current project."
+  (interactive)
+  (let ((default-directory (project-root (project-current t))))
+    (eshell t)))
+
 (declare-function fileloop-continue "fileloop" ())
 
 ;;;###autoload
@@ -697,5 +714,127 @@ loop using the command \\[fileloop-continue]."
          (default-directory (project-root pr)))
     (call-interactively 'compile)))
 
+
+;;; Project list
+
+(defvar project--list 'unset
+  "List of known project directories.")
+
+(defun project--ensure-file-exists (filename)
+  "Create an empty file FILENAME if it doesn't exist."
+  (unless (file-exists-p filename)
+    (with-temp-buffer
+      (write-file filename))))
+
+(defun project--read-project-list ()
+  "Initialize `project--list' from the project list file."
+  (let ((filename (locate-user-emacs-file "project-list")))
+    (project--ensure-file-exists filename)
+    (with-temp-buffer
+      (insert-file-contents filename)
+      (let ((dirs (split-string (buffer-string) "\n" t))
+            (project-list '()))
+        (dolist (dir dirs)
+          (cl-pushnew (file-name-as-directory dir)
+                      project-list
+                      :test #'equal))
+        (setq project--list (reverse project-list))))))
+
+(defun project--ensure-read-project-list ()
+  "Initialize `project--list' if it hasn't already been."
+  (when (eq project--list 'unset)
+    (project--read-project-list)))
+
+(defun project--write-project-list ()
+  "Persist `project--list' to the project list file."
+  (let ((filename (locate-user-emacs-file "project-list")))
+    (with-temp-buffer
+      (insert (string-join project--list "\n"))
+      (write-region nil nil filename nil 'silent))))
+
+(defun project--add-to-project-list-front (pr)
+  "Add project PR to the front of the project list and save it.
+Return PR."
+  (project--ensure-read-project-list)
+  (let ((dir (project-root pr)))
+    (setq project--list (delete dir project--list))
+    (push dir project--list))
+  (project--write-project-list)
+  pr)
+
+(defun project--remove-from-project-list (pr-dir)
+  "Remove directory PR-DIR from the project list.
+If the directory was in the list before the removal, save the
+result to disk."
+  (project--ensure-read-project-list)
+  ;; XXX: This hardcodes that the number of roots = 1.
+  ;; It's fine, though.
+  (when (member pr-dir project--list)
+    (setq project--list (delete pr-dir project--list))
+    (message "Project `%s' not found; removed from list" pr-dir)
+    (project--write-project-list)))
+
+(defun project-prompt-project-dir ()
+  "Prompt the user for a directory from known project roots.
+The project is chosen among projects known from the project list.
+It's also possible to enter an arbitrary directory."
+  (project--ensure-read-project-list)
+  (let* ((dir-choice "... (choose a dir)")
+         (choices
+          ;; XXX: Just using this for the category (for the substring
+          ;; completion style).
+          (project--file-completion-table
+           (append project--list `(,dir-choice))))
+         (pr-dir (completing-read "Project: " choices nil t)))
+    (if (equal pr-dir dir-choice)
+        (read-directory-name "Choose directory: " default-directory nil t)
+      pr-dir)))
+
+
+;;; Project switching
+
+;;;###autoload
+(defvar project-switch-commands
+  '(("f" "Find file" project-find-file)
+    ("s" "Find regexp" project-find-regexp)
+    ("d" "Dired" project-dired)
+    ("e" "Eshell" project-eshell))
+  "Alist mapping keys to project switching menu entries.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available upon \"switching\" to another project.
+
+Each element looks like (KEY LABEL COMMAND), where COMMAND is the
+command to run when KEY is pressed.  LABEL is used to distinguish
+the choice in the dispatch menu.")
+
+(defun project--keymap-prompt ()
+  "Return a prompt for the project swithing dispatch menu."
+  (mapconcat
+   (pcase-lambda (`(,key ,label))
+     (format "[%s] %s"
+             (propertize (key-description `(,key)) 'face 'bold)
+             label))
+   project-switch-commands
+   "  "))
+
+;;;###autoload
+(defun project-switch-project ()
+  "\"Switch\" to another project by running a chosen command.
+The available commands are picked from `project-switch-commands'
+and presented in a dispatch menu."
+  (interactive)
+  (let ((dir (project-prompt-project-dir))
+        (choice nil))
+    (while (not (and choice
+                     (or (equal choice (kbd "C-g"))
+                         (assoc choice project-switch-commands))))
+      (setq choice (read-key-sequence (project--keymap-prompt))))
+    (if (equal choice (kbd "C-g"))
+        (message "Quit")
+      (let ((default-directory dir)
+            (project-current-inhibit-prompt t))
+        (call-interactively
+         (nth 2 (assoc choice project-switch-commands)))))))
+
 (provide 'project)
 ;;; project.el ends here