From afb7602a24cdb38c02998cc1f3c538b31981b255 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Simen=20Heggest=C3=B8yl?= Date: Sat, 9 May 2020 17:27:06 +0200 Subject: [PATCH] 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 88f73e4fb31..e77416397bc 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,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) @@ -697,5 +698,160 @@ 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 (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 -- 2.39.5