From 86714ac9c82967e9d93e32d9bd172311fc4aed00 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Wed, 15 Nov 2023 15:44:03 -0500 Subject: [PATCH] Incompatibly change project--list to be a project history variable With savehist-mode enabled, this Just Works. --- lisp/progmodes/project.el | 114 +++++++++++--------------------------- 1 file changed, 33 insertions(+), 81 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 95db9d0ef4c..59404e5729d 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1671,70 +1671,16 @@ project-kill-buffers ;;; Project list -(defcustom project-list-file (locate-user-emacs-file "projects") - "File in which to save the list of known projects." - :type 'file - :version "28.1" - :group 'project) - -(defvar project--list 'unset - "List structure containing root directories of known projects. -With some possible metadata (to be decided).") - -(defun project--read-project-list () - "Initialize `project--list' using contents of `project-list-file'." - (let ((filename project-list-file)) - (setq project--list - (when (file-exists-p filename) - (with-temp-buffer - (insert-file-contents filename) - (mapcar - (lambda (elem) - (let ((name (car elem))) - (list (if (file-remote-p name) name - (abbreviate-file-name name))))) - (read (current-buffer)))))) - (unless (seq-every-p - (lambda (elt) (stringp (car-safe elt))) - project--list) - (warn "Contents of %s are in wrong format, resetting" - project-list-file) - (setq project--list nil)))) - -(defun project--ensure-read-project-list () - "Initialize `project--list' if it isn't already initialized." - (when (eq project--list 'unset) - (project--read-project-list))) - -(defun project--write-project-list () - "Save `project--list' in `project-list-file'." - (let ((filename project-list-file)) - (with-temp-buffer - (insert ";;; -*- lisp-data -*-\n") - (let ((print-length nil) - (print-level nil)) - (pp (mapcar (lambda (elem) - (let ((name (car elem))) - (list (if (file-remote-p name) name - (expand-file-name name))))) - project--list) - (current-buffer))) - (write-region nil nil filename nil 'silent)))) +(defvar project--list nil + "List of root directories of recently-accessed projects.") ;;;###autoload -(defun project-remember-project (pr &optional no-write) - "Add project PR to the front of the project list. -Save the result in `project-list-file' if the list of projects -has changed, and NO-WRITE is nil." - (project--ensure-read-project-list) +(defun project-remember-project (pr &optional _no-write) + "Add project PR to the front of the project list." (let ((dir (abbreviate-file-name (project-root pr)))) - (unless (equal (caar project--list) dir) - (dolist (ent project--list) - (when (equal dir (car ent)) - (setq project--list (delq ent project--list)))) - (push (list dir) project--list) - (unless no-write - (project--write-project-list))))) + (unless (equal (car project--list) dir) + (setq project--list (delq dir project--list)) + (push dir project--list)))) (defun project--remove-from-project-list (project-root report-message) "Remove directory PROJECT-ROOT of a missing project from the project list. @@ -1742,11 +1688,9 @@ project--remove-from-project-list result in `project-list-file'. Announce the project's removal from the list using REPORT-MESSAGE, which is a format string passed to `message' as its first argument." - (project--ensure-read-project-list) - (when-let ((ent (assoc (abbreviate-file-name project-root) project--list))) - (setq project--list (delq ent project--list)) - (message report-message project-root) - (project--write-project-list))) + (let ((dir (abbreviate-file-name project-root))) + (setq project--list (delq dir project--list)) + (message report-message project-root))) ;;;###autoload (defun project-forget-project (project-root) @@ -1762,7 +1706,6 @@ project-prompt-project-dir The project is chosen among projects known from the project list, see `project-list-file'. It's also possible to enter an arbitrary directory not in the list." - (project--ensure-read-project-list) (let* ((dir-choice "... (choose a dir)") (choices ;; XXX: Just using this for the category (for the substring @@ -1772,43 +1715,55 @@ project-prompt-project-dir (pr-dir "")) (while (equal pr-dir "") ;; If the user simply pressed RET, do this again until they don't. - (setq pr-dir (completing-read "Select project: " choices nil t))) + (setq pr-dir (completing-read "Select project: " choices nil t nil 'project--list))) (if (equal pr-dir dir-choice) (read-directory-name "Select directory: " default-directory nil t) pr-dir))) +(defvar project--name-history) + (defun project-prompt-project-name () "Prompt the user for a project, by name, that is one of the known project roots. The project is chosen among projects known from the project list, see `project-list-file'. It's also possible to enter an arbitrary directory not in the list." (let* ((dir-choice "... (choose a dir)") + project--name-history (choices (let (ret) - (dolist (dir (project-known-project-roots)) + ;; Iterate in reverse order so project--name-history is in + ;; the correct order. + (dolist (dir (reverse project--list)) ;; we filter out directories that no longer map to a project, ;; since they don't have a clean project-name. - (if-let (proj (project--find-in-directory dir)) - (push (cons (project-name proj) proj) ret))) + (when-let (proj (project--find-in-directory dir)) + (let ((name (project-name proj))) + (push name project--name-history) + (push (cons name proj) ret)))) ret)) ;; XXX: Just using this for the category (for the substring ;; completion style). (table (project--file-completion-table - (reverse (cons dir-choice choices)))) + (cons dir-choice choices))) (pr-name "")) + (setq project--name-history (delete-consecutive-dups project--name-history)) (while (equal pr-name "") ;; If the user simply pressed RET, do this again until they don't. - (setq pr-name (completing-read "Select project: " table nil t))) + (setq pr-name + (completing-read "Select project: " table nil t nil 'project--name-history))) (if (equal pr-name dir-choice) (read-directory-name "Select directory: " default-directory nil t) - (let ((proj (assoc pr-name choices))) - (if (stringp proj) proj (project-root (cdr proj))))))) + (let* ((proj (assoc pr-name choices)) + (ret (project-root (cdr proj)))) + ;; Record this return value in history, since + ;; project--name-history is purely local. + (push ret project--list) + ret)))) ;;;###autoload (defun project-known-project-roots () "Return the list of root directories of all known projects." - (project--ensure-read-project-list) - (mapcar #'car project--list)) + project--list) ;;;###autoload (defun project-execute-extended-command () @@ -1865,14 +1820,13 @@ project-remember-projects-under the progress. The function returns the number of detected projects." (interactive "DDirectory: \nP") - (project--ensure-read-project-list) (let ((dirs (if recursive (directory-files-recursively dir "" t) (directory-files dir t))) (known (make-hash-table :size (* 2 (length project--list)) :test #'equal)) (count 0)) - (dolist (project (mapcar #'car project--list)) + (dolist (project project--list) (puthash project t known)) (dolist (subdir dirs) (when-let (((file-directory-p subdir)) @@ -1885,7 +1839,6 @@ project-remember-projects-under (setq count (1+ count)))) (if (zerop count) (message "No projects were found") - (project--write-project-list) (message "%d project%s were found" count (if (= count 1) "" "s"))) count)) @@ -1916,7 +1869,6 @@ project-forget-projects-under (setq count (1+ count))))) (if (zerop count) (message "No projects were forgotten") - (project--write-project-list) (message "%d project%s were forgotten" count (if (= count 1) "" "s"))) count)) -- 2.39.3