scratch/project-switching e1184e3: Add project switching functionality

[Simen Heggestøyl]

branch: scratch/project-switching
commit e1184e357d9d81df0d01fd8416a399b20bf53081
Author: Simen Heggestøyl <address@hidden>
Commit: Simen Heggestøyl <address@hidden>

    Add project switching functionality
    
    * lisp/progmodes/project.el: Require subr-x.
    (project--transient-p, project--ensure-file-exists)
    (project--read-project-list, project--ensure-read-project-list)
    (project--write-project-list)
    (project--add-to-project-list-front)
    (project--remove-from-project-list, project-find-project)
    (project-switch-project-find-file, project-switch-project-dired)
    (project-switch-project-eshell, project-add-switch-command)
    (project--keymap-prompt, project-switch-project): New functions.
    (project--list, project-switch-keymap): New variables.
    (project-current): Call 'project-find-project' when no project is
    current.
---
 lisp/progmodes/project.el | 172 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 164 insertions(+), 8 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index f5f4092..7d260a3 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -88,6 +88,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.
@@ -95,23 +96,23 @@ 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.")
 
+(defun project--transient-p (pr)
+  "Return non-nil if PR is a transient project."
+  (eq (car pr) 'transient))
+
 ;;;###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)))))
+      (setq pr (project-find-project))))
+    (when (and pr (not (project--transient-p pr)))
+      (project--add-to-project-list-front pr))
     pr))
 
 (defun project--find-in-directory (dir)
@@ -632,5 +633,160 @@ loop using the command \\[fileloop-continue]."
    from to (project-files (project-current t)) 'default)
   (fileloop-continue))
 
+
+;;; 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 (string-trim (buffer-string)) "\n"))
+            (project-list '()))
+        (dolist (dir dirs)
+          (cl-pushnew (list (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 (mapcar #'car 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 ((dirs (project-roots pr)))
+    (setq project--list (delete dirs project--list))
+    (push dirs project--list))
+  (project--write-project-list)
+  pr)
+
+(defun project--remove-from-project-list (pr-dir)
+  "Remove directory PR-DIR from the project list and save it."
+  (project--ensure-read-project-list)
+  (setq project--list (delete (list pr-dir) project--list))
+  (project--write-project-list))
+
+(defun project-find-project ()
+  "Prompt the user for a project and return it.
+The project is chosen among projects known from the project list.
+It's also possible to enter an arbitrary directory, in which case
+a project for that directory is returned (possibly a transient
+one).  Return nil if no project or directory was chosen."
+  (project--ensure-read-project-list)
+  (let* ((dir-choice "... (choose a dir)")
+         (choices (append project--list `(,dir-choice)))
+         (pr-dir (completing-read "Project: " choices)))
+    (if (equal pr-dir dir-choice)
+        (let ((dir (read-directory-name
+                    "Choose directory: " default-directory nil t)))
+          (if-let (pr (project--find-in-directory dir))
+              (project--add-to-project-list-front pr)
+            (message "Using `%s' as a transient project root" dir)
+            (cons 'transient dir)))
+      (if-let (pr (project--find-in-directory pr-dir))
+          (project--add-to-project-list-front pr)
+        (project--remove-from-project-list pr-dir)
+        (message "Project `%s' not found; removed from list" pr-dir)
+        nil))))
+
+
+;;; Project switching
+
+(defvar project-switch-keymap (make-sparse-keymap)
+  "Keymap of commands for \"switching\" to a project.
+Used by `project-switch-project' to construct a dispatch menu of
+commands available for \"switching\" to another project.")
+
+;;;###autoload
+(defun project-switch-project-find-file (&optional pr)
+  "\"Switch\" to project PR by finding a file in it.
+If PR is nil, prompt for a project."
+  (interactive)
+  (setq pr (or pr (project-find-project)))
+  (let ((dirs (project-roots pr)))
+    (project-find-file-in nil dirs pr)))
+
+;;;###autoload
+(defun project-switch-project-dired (&optional pr)
+  "\"Switch\" to project PR by visiting its root with Dired.
+If PR is nil, prompt for a project."
+  (interactive)
+  (let ((dirs (project-roots (or pr (project-find-project)))))
+    (dired (car dirs))))
+
+;;;###autoload
+(defun project-switch-project-eshell (&optional pr)
+  "\"Switch\" to project PR by launching Eshell in its root.
+If PR is nil, prompt for a project."
+  (interactive)
+  (let* ((dirs (project-roots (or pr (project-find-project))))
+         (default-directory (car dirs)))
+    (eshell t)))
+
+;;;###autoload
+(defun project-add-switch-command (symbol key label)
+  "Add a function to the project switching dispatch menu.
+SYMBOL should stand for a function to be invoked by the key KEY.
+LABEL is used to distinguish the function in the dispatch menu."
+  (function-put symbol 'dispatch-label label)
+  (define-key project-switch-keymap key symbol))
+
+(project-add-switch-command
+ 'project-switch-project-find-file "f" "Find file")
+
+(project-add-switch-command
+ 'project-switch-project-dired "d" "Dired")
+
+(project-add-switch-command
+ 'project-switch-project-eshell "e" "Eshell")
+
+(defun project--keymap-prompt ()
+  "Return a prompt for the project swithing dispatch menu."
+  (let ((prompt ""))
+    (map-keymap
+     (lambda (event value)
+       (let ((key (propertize (key-description `(,event)) 'face 'bold))
+             (desc (function-get value 'dispatch-label)))
+         (setq prompt (concat (format "[%s] %s  " key desc) prompt))))
+     project-switch-keymap)
+    prompt))
+
+;;;###autoload
+(defun project-switch-project ()
+  "\"Switch\" to another project by running a chosen command.
+The available commands are picked from `project-switch-keymap'
+and presented in a dispatch menu."
+  (interactive)
+  (let ((pr (project-find-project))
+        (choice nil))
+    (while (not (and choice
+                     (or (equal choice (kbd "C-g"))
+                         (lookup-key project-switch-keymap choice))))
+      (setq choice (read-key-sequence (project--keymap-prompt))))
+    (if (equal choice (kbd "C-g"))
+        (message "Quit")
+      (funcall (lookup-key project-switch-keymap choice) pr))))
+
 (provide 'project)
 ;;; project.el ends here