;;; 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.
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)
(default-directory (project-root pr)))
(call-interactively 'compile)))
+\f
+;;; 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))))
+
+\f
+;;; 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
projects / emacs.git / commitdiff