From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail
From: Spencer Baugh <sbaugh@janestreet.com>
Newsgroups: gmane.emacs.bugs
Subject: bug#67310: [PATCH] Include the project--list as history when
 prompting for a project
Date: Fri, 24 Nov 2023 10:50:43 -0500
Message-ID: <ier8r6nkv58.fsf@janestreet.com>
References: <ier8r6s42on.fsf@janestreet.com>
 <dc5ad8f4-b857-ea87-d178-bae903cee517@gutov.dev>
 <421e3ea8-d150-566e-f645-cbf1ccbcba61@gutov.dev>
 <ier34wz3zkx.fsf@janestreet.com>
 <81b6ed58-3fdc-3b5a-41a9-84d66475d5f1@gutov.dev>
 <ierr0khlq19.fsf@janestreet.com>
 <5c3eb6a1-38da-8af4-419a-e0567b163e3a@gutov.dev>
 <iercyw1l6rz.fsf@janestreet.com>
 <dc3b5328-8719-8948-e617-e3e8cf13f274@gutov.dev>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214";
	logging-data="15303"; mail-complaints-to="usenet@ciao.gmane.io"
User-Agent: Gnus/5.13 (Gnus v5.13)
Cc: 67310@debbugs.gnu.org, eliz@gnu.org, juri@linkov.net
To: Dmitry Gutov <dmitry@gutov.dev>
Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Nov 24 16:51:14 2023
Return-path: <bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org>
Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org
Original-Received: from lists.gnu.org ([209.51.188.17])
	by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
	(Exim 4.92)
	(envelope-from <bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org>)
	id 1r6YSX-0003iB-Gv
	for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 24 Nov 2023 16:51:13 +0100
Original-Received: from localhost ([::1] helo=lists1p.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.90_1)
	(envelope-from <bug-gnu-emacs-bounces@gnu.org>)
	id 1r6YSJ-0000yC-5o; Fri, 24 Nov 2023 10:50:59 -0500
Original-Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <Debian-debbugs@debbugs.gnu.org>)
 id 1r6YSH-0000xQ-NU
 for bug-gnu-emacs@gnu.org; Fri, 24 Nov 2023 10:50:57 -0500
Original-Received: from debbugs.gnu.org ([2001:470:142:5::43])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.90_1) (envelope-from <Debian-debbugs@debbugs.gnu.org>)
 id 1r6YSH-0003Aj-Eo
 for bug-gnu-emacs@gnu.org; Fri, 24 Nov 2023 10:50:57 -0500
Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1r6YSL-0008O5-If
 for bug-gnu-emacs@gnu.org; Fri, 24 Nov 2023 10:51:01 -0500
X-Loop: help-debbugs@gnu.org
Resent-From: Spencer Baugh <sbaugh@janestreet.com>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@gnu.org
Resent-Date: Fri, 24 Nov 2023 15:51:01 +0000
Resent-Message-ID: <handler.67310.B67310.170084105732228@debbugs.gnu.org>
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 67310
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
Original-Received: via spool by 67310-submit@debbugs.gnu.org id=B67310.170084105732228
 (code B ref 67310); Fri, 24 Nov 2023 15:51:01 +0000
Original-Received: (at 67310) by debbugs.gnu.org; 24 Nov 2023 15:50:57 +0000
Original-Received: from localhost ([127.0.0.1]:37007 helo=debbugs.gnu.org)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
 id 1r6YSH-0008Ni-1W
 for submit@debbugs.gnu.org; Fri, 24 Nov 2023 10:50:57 -0500
Original-Received: from mxout5.mail.janestreet.com ([64.215.233.18]:57223)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <sbaugh@janestreet.com>) id 1r6YSD-0008NU-2z
 for 67310@debbugs.gnu.org; Fri, 24 Nov 2023 10:50:55 -0500
In-Reply-To: <dc3b5328-8719-8948-e617-e3e8cf13f274@gutov.dev> (Dmitry Gutov's
 message of "Thu, 23 Nov 2023 04:55:56 +0200")
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
X-BeenThere: bug-gnu-emacs@gnu.org
List-Id: "Bug reports for GNU Emacs,
 the Swiss army knife of text editors" <bug-gnu-emacs.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/bug-gnu-emacs>,
 <mailto:bug-gnu-emacs-request@gnu.org?subject=unsubscribe>
List-Archive: <https://lists.gnu.org/archive/html/bug-gnu-emacs>
List-Post: <mailto:bug-gnu-emacs@gnu.org>
List-Help: <mailto:bug-gnu-emacs-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs>,
 <mailto:bug-gnu-emacs-request@gnu.org?subject=subscribe>
Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org
Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org
Xref: news.gmane.io gmane.emacs.bugs:274869
Archived-At: <http://permalink.gmane.org/gmane.emacs.bugs/274869>

--=-=-=
Content-Type: text/plain

Dmitry Gutov <dmitry@gutov.dev> writes:
> On 23/11/2023 01:14, Spencer Baugh wrote:
>> @@ -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)
>               ^
>                typo
>
>> +            (history-length t))
>> +        (add-to-history 'project--list pr-dir))
>>         pr-dir)))
>
> Sorry, I thought we agreed that project-prompt-project-dir and
> project-prompt-project-name shouldn't add-to-history?
>
> Because project-current calls project-remember-project already
> (including the cases when the prompter isn't used: when the project is
> auto-detected). And to cover the remaining cases, we can have
> project-switch-project call project-remember-project as well.
>
> This way also we keep the project-prompter implementations with less
> logic inside, meaning it's a bit easier to write the next one.
>
> More DRY, too. At least while there's no other code using
> project-prompter directly (but then we could add a helper).

Oops, sorry, that was just the old version of the patch.  Correct
version attached.

(Perhaps I should find a better workflow for submitting patches than
manually running format-patch and copy-pasting the resulting patch to
attach it to a subsequent email)


--=-=-=
Content-Type: text/x-patch
Content-Disposition: inline;
 filename=0001-Use-the-project-list-as-history-when-prompting-for-a.patch

>From 6b7b82be8a9a2d218a124e8205f3627d77dbb0a1 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Tue, 21 Nov 2023 10:11:52 -0500
Subject: [PATCH] Use 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 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.

If we later find a way to rely on savehist for persistence instead of
having our own mechanism, we can change the in-memory format of
project--list to be just a list of directories, and our explicit calls
to project--add-dir can be replaced by let-binding
history-delete-duplicates=t, history-length=t.

* lisp/progmodes/project.el (project--add-dir): Add.
(project-remember-project): Use project--add-dir.
(project--name-history, project-prompt-project-name)
(project--dir-history, project-prompt-project-dir): Pass a
preprocessed project--list as HIST to completing-read.  (bug#67310)
(project-switch-project): Call project--add-dir.
---
 lisp/progmodes/project.el | 39 ++++++++++++++++++++++++++++++---------
 1 file changed, 30 insertions(+), 9 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 95db9d0ef4c..fb4f42a844c 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1721,13 +1721,12 @@ project--write-project-list
             (current-buffer)))
       (write-region nil nil filename nil 'silent))))
 
-;;;###autoload
-(defun project-remember-project (pr &optional no-write)
-  "Add project PR to the front of the project list.
+(defun project--add-dir (root &optional no-write)
+  "Add project root ROOT 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)
-  (let ((dir (abbreviate-file-name (project-root pr))))
+  (let ((dir (abbreviate-file-name root)))
     (unless (equal (caar project--list) dir)
       (dolist (ent project--list)
         (when (equal dir (car ent))
@@ -1736,6 +1735,13 @@ project-remember-project
       (unless no-write
         (project--write-project-list)))))
 
+;;;###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--add-dir (project-root pr) no-write))
+
 (defun project--remove-from-project-list (project-root report-message)
   "Remove directory PROJECT-ROOT of a missing project from the project list.
 If the directory was in the list before the removal, save the
@@ -1757,6 +1763,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 +1777,37 @@ project-prompt-project-dir
           ;; completion style).
           (project--file-completion-table
            (append project--list `(,dir-choice))))
+         (project--dir-history (project-known-project-roots))
          (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)
       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-known-project-roots)))
               ;; 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,7 +1816,9 @@ 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)))
@@ -2064,6 +2084,7 @@ project-switch-project
 When called in a program, it will use the project corresponding
 to directory DIR."
   (interactive (list (funcall project-prompter)))
+  (project--add-dir dir)
   (let ((command (if (symbolp project-switch-commands)
                      project-switch-commands
                    (project--switch-project-command)))
-- 
2.39.3


--=-=-=--