From: Spencer Baugh <sbaugh@janestreet.com>
To: Dmitry Gutov <dmitry@gutov.dev>
Cc: 67310@debbugs.gnu.org, eliz@gnu.org, juri@linkov.net
Subject: bug#67310: [PATCH] Include the project--list as history when prompting for a project
Date: Wed, 22 Nov 2023 18:14:56 -0500 [thread overview]
Message-ID: <iercyw1l6rz.fsf@janestreet.com> (raw)
In-Reply-To: <5c3eb6a1-38da-8af4-419a-e0567b163e3a@gutov.dev> (Dmitry Gutov's message of "Wed, 22 Nov 2023 20:44:53 +0200")
[-- Attachment #1: Type: text/plain, Size: 2065 bytes --]
Dmitry Gutov <dmitry@gutov.dev> writes:
> On 22/11/2023 18:18, Spencer Baugh wrote:
>> Dmitry Gutov <dmitry@gutov.dev> writes:
>>> On 21/11/2023 17:17, Spencer Baugh wrote:
>>>> (if (equal pr-dir dir-choice)
>>>> (read-directory-name "Select directory: " default-directory nil t)
>>>> + (project--add-dir pr-dir)
>>>> pr-dir)))
>>>> ...
>>>> (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))
>>>> + (root (project-root (cdr proj))))
>>>> + (project--add-dir root)
>>>> + root))))
>>>
>>> I think in the (equal pr-dir dir-choice) case we want to add the
>>> directory name entered by the user into the "history" anyway, don't
>>> we?
>> Mmmmaybe? That would change behavior - currently transient projects
>> don't go into the project--list, and with that change they would. Do
>> you think they should?
>
> Hmm, maybe not. Anyway, that sentence was supposed to lead into the
> next paragraph anyway.
>
>> I personally never use transient projects so I don't really know how
>> they should behave.
>>
>>> Though perhaps there's no need to do it here: 'project-current' calls
>>> 'project-remember-project' anyway when maybe-prompt is non-nil.
>>>
>>> So what happens if you drop both of the above 'project--add-dir' calls?
>> project-prompter is also called from project-switch-project, which
>> doesn't call project-remember-project but should also update the history
>> IMO.
>
> I suppose project-switch-project could add a project-remember-project
> call as well?
>
> It's just that until recently it only supported project-related
> commands, and those would invoke (project-current t) right away --
> adding the just-selected root into the list.
Yes, that makes sense, done. (We only have the project root directory
there, so we still need project--add-dir)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Include-the-project-list-as-history-when-prompting-f.patch --]
[-- Type: text/x-patch, Size: 10296 bytes --]
From 063fe822531d51040be53f47f3dbe35ea77f21be Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Mon, 20 Nov 2023 14:38:22 -0500
Subject: [PATCH] Include the project--list as history when prompting for a
project
The project--list is already ordered such that the most recently used
projects are at the front. Now we use it as the minibuffer history
when prompting for a project.
To support this, we minorly change the in-memory format of
project--list: Instead of a list of lists, each containing a
project-root, project--list is just a list whose elements are
project-roots. This lets us pass it directly to add-to-history. The
persistent format (what's saved in project-list-file) remains the
same.
To avoid savehist from picking up project--list as a minibuffer
history variable and overriding our own persistence mechanism, we
don't pass project--list directly as a history variable, but instead
pass project--dir-history or project--name-history, dynamically-bound
to an appropriate value. project--dir-history and
project--name-history won't be persisted since they're always unbound
at the top level; but if they are persisted anyway somehow, it won't
affect us.
* lisp/progmodes/project.el (project--list): Update docstring for new
format.
(project-known-project-roots, project-remember-projects-under)
(project--read-project-list, project--write-project-list)
(project-remember-project, project--remove-from-project-list): Support
new format for project--list.
(project--dir-history, project-prompt-project-dir): Pass project--list
as HIST to completing-read.
(project--name-history, project-prompt-project-name): Pass a
preprocessed project--list as HIST to completing-read.
---
lisp/progmodes/project.el | 99 +++++++++++++++++++++++++--------------
1 file changed, 64 insertions(+), 35 deletions(-)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 95db9d0ef4c..4baa76b932a 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1678,11 +1678,16 @@ project-list-file
:group 'project)
(defvar project--list 'unset
- "List structure containing root directories of known projects.
-With some possible metadata (to be decided).")
+ "List of root directories of known projects.
+
+This is also the minibuffer history variable for
+`project-prompt-project-dir' and `project-prompt-project-name'.")
(defun project--read-project-list ()
- "Initialize `project--list' using contents of `project-list-file'."
+ "Initialize `project--list' using contents of `project-list-file'.
+
+We expect `project-list-file' to contain a list of one-element
+lists, each containing a project root."
(let ((filename project-list-file))
(setq project--list
(when (file-exists-p filename)
@@ -1691,11 +1696,11 @@ project--read-project-list
(mapcar
(lambda (elem)
(let ((name (car elem)))
- (list (if (file-remote-p name) name
- (abbreviate-file-name name)))))
+ (if (file-remote-p name) name
+ (abbreviate-file-name name))))
(read (current-buffer))))))
(unless (seq-every-p
- (lambda (elt) (stringp (car-safe elt)))
+ (lambda (elt) (stringp elt))
project--list)
(warn "Contents of %s are in wrong format, resetting"
project-list-file)
@@ -1707,16 +1712,18 @@ project--ensure-read-project-list
(project--read-project-list)))
(defun project--write-project-list ()
- "Save `project--list' in `project-list-file'."
+ "Save `project--list' in `project-list-file'.
+
+We store `project--list' as a list of one-element lists, each
+containing a project root."
(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)))))
+ (pp (mapcar (lambda (name)
+ (list (if (file-remote-p name) name
+ (expand-file-name name))))
project--list)
(current-buffer)))
(write-region nil nil filename nil 'silent))))
@@ -1728,11 +1735,10 @@ project-remember-project
has changed, and NO-WRITE is nil."
(project--ensure-read-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 (equal (car project--list) dir)
+ (let ((history-delete-duplicates t)
+ (history-length t))
+ (add-to-history 'project--list dir))
(unless no-write
(project--write-project-list)))))
@@ -1743,10 +1749,11 @@ project--remove-from-project-list
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)))
+ (when (member dir project--list)
+ (setq project--list (delete dir project--list))
+ (message report-message project-root)
+ (project--write-project-list))))
;;;###autoload
(defun project-forget-project (project-root)
@@ -1757,6 +1764,8 @@ project-forget-project
(project--remove-from-project-list
project-root "Project `%s' removed from known projects"))
+(defvar project--dir-history)
+
(defun project-prompt-project-dir ()
"Prompt the user for a directory that is one of the known project roots.
The project is chosen among projects known from the project list,
@@ -1769,27 +1778,40 @@ project-prompt-project-dir
;; completion style).
(project--file-completion-table
(append project--list `(,dir-choice))))
+ (project--dir-history project--list)
(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
+ (let ((history-add-new-input nil))
+ (completing-read "Select project: " choices nil t nil 'project--dir-history))))
(if (equal pr-dir dir-choice)
(read-directory-name "Select directory: " default-directory nil t)
+ (let q((history-delete-duplicates t)
+ (history-length t))
+ (add-to-history 'project--list pr-dir))
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).
@@ -1798,17 +1820,23 @@ project-prompt-project-name
(pr-name ""))
(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
+ (let ((history-add-new-input nil))
+ (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))
+ (root (project-root (cdr proj))))
+ (let ((history-delete-duplicates t)
+ (history-length t))
+ (add-to-history 'project--list root))
+ root))))
;;;###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 ()
@@ -1866,13 +1894,14 @@ project-remember-projects-under
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))
+ (let* ((dirs (if recursive
+ (directory-files-recursively dir "" t)
+ (directory-files dir t)))
+ (roots (project-known-project-roots))
+ (known (make-hash-table :size (* 2 (length roots))
+ :test #'equal))
+ (count 0))
+ (dolist (project roots)
(puthash project t known))
(dolist (subdir dirs)
(when-let (((file-directory-p subdir))
--
2.39.3
next prev parent reply other threads:[~2023-11-22 23:14 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-11-20 19:58 bug#67310: [PATCH] Include the project--list as history when prompting for a project Spencer Baugh
2023-11-21 11:06 ` Dmitry Gutov
2023-11-21 11:14 ` Dmitry Gutov
2023-11-21 15:17 ` Spencer Baugh
2023-11-22 1:40 ` Dmitry Gutov
2023-11-22 16:18 ` Spencer Baugh
2023-11-22 18:44 ` Dmitry Gutov
2023-11-22 23:14 ` Spencer Baugh [this message]
2023-11-23 2:55 ` Dmitry Gutov
2023-11-24 15:50 ` Spencer Baugh
2023-11-25 2:07 ` Dmitry Gutov
2023-11-25 17:50 ` Juri Linkov
2023-11-27 17:10 ` Juri Linkov
2023-12-10 3:04 ` Dmitry Gutov
2023-12-10 17:43 ` Juri Linkov
2023-12-10 20:32 ` Dmitry Gutov
2023-12-11 17:12 ` Juri Linkov
2023-12-12 0:21 ` Dmitry Gutov
2023-12-14 1:02 ` sbaugh
2023-12-19 17:35 ` Juri Linkov
2023-11-23 6:38 ` Eli Zaretskii
2023-11-25 1:54 ` Dmitry Gutov
2023-11-25 8:42 ` Eli Zaretskii
2023-11-25 14:05 ` Dmitry Gutov
2023-11-25 14:10 ` Eli Zaretskii
2023-11-25 15:06 ` Dmitry Gutov
2023-11-25 15:57 ` Eli Zaretskii
2023-11-25 16:35 ` Dmitry Gutov
2023-11-22 1:42 ` Dmitry Gutov
2023-11-22 16:21 ` Spencer Baugh
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=iercyw1l6rz.fsf@janestreet.com \
--to=sbaugh@janestreet.com \
--cc=67310@debbugs.gnu.org \
--cc=dmitry@gutov.dev \
--cc=eliz@gnu.org \
--cc=juri@linkov.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).