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: Mon, 20 Nov 2023 14:58:32 -0500
Message-ID: <ier8r6s42on.fsf@janestreet.com>
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="26600"; mail-complaints-to="usenet@ciao.gmane.io"
Cc: dmitry@gutov.dev, eliz@gnu.org, juri@linkov.net
To: 67310@debbugs.gnu.org
Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Nov 20 20:59:27 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 1r5AQY-0006g3-TM
	for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 20 Nov 2023 20:59:27 +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 1r5AQ9-0007J0-HD; Mon, 20 Nov 2023 14:59:01 -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 1r5AQ8-0007Io-KD
 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 14:59:00 -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 1r5AQ8-0007TK-9q
 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 14:59:00 -0500
Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1r5AQA-0005TO-C2
 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 14:59:02 -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: Mon, 20 Nov 2023 19:59:02 +0000
Resent-Message-ID: <handler.67310.B.170051032721013@debbugs.gnu.org>
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: report 67310
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
X-Debbugs-Original-To: bug-gnu-emacs@gnu.org
Original-Received: via spool by submit@debbugs.gnu.org id=B.170051032721013
 (code B ref -1); Mon, 20 Nov 2023 19:59:02 +0000
Original-Received: (at submit) by debbugs.gnu.org; 20 Nov 2023 19:58:47 +0000
Original-Received: from localhost ([127.0.0.1]:54696 helo=debbugs.gnu.org)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
 id 1r5APu-0005Sq-3a
 for submit@debbugs.gnu.org; Mon, 20 Nov 2023 14:58:46 -0500
Original-Received: from lists.gnu.org ([2001:470:142::17]:42646)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <sbaugh@janestreet.com>) id 1r5APs-0005Sb-Dn
 for submit@debbugs.gnu.org; Mon, 20 Nov 2023 14:58:45 -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 <sbaugh@janestreet.com>)
 id 1r5APk-0007GO-Kw
 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 14:58:36 -0500
Original-Received: from mxout5.mail.janestreet.com ([64.215.233.18])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <sbaugh@janestreet.com>)
 id 1r5APi-0007PL-6b
 for bug-gnu-emacs@gnu.org; Mon, 20 Nov 2023 14:58:36 -0500
Received-SPF: pass client-ip=64.215.233.18; envelope-from=sbaugh@janestreet.com;
 helo=mxout5.mail.janestreet.com
X-Spam_score_int: -18
X-Spam_score: -1.9
X-Spam_bar: -
X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_MSPIKE_H5=0.001,
 RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001,
 T_SCC_BODY_TEXT_LINE=-0.01 autolearn=unavailable autolearn_force=no
X-Spam_action: no action
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:274687
Archived-At: <http://permalink.gmane.org/gmane.emacs.bugs/274687>

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

Tags: patch


The following patch uses project--list as a minibuffer history variable.
Now one can more easily switch between several related projects.

Independent from ongoing discussion about how to persist project--list
in bug#66993, this should be a useful improvement on its own.

This patch takes special care to avoid relying on savehist's persistent
mechanism, since savehist now knows about project--list as a minibuffer
history variable.

This patch does change the in-memory format of project--list, but not
the on-disk format, and project-known-project-roots still works, so this
patch should be backwards compatible.

In GNU Emacs 29.1.90 (build 2, x86_64-pc-linux-gnu, X toolkit, cairo
 version 1.15.12, Xaw scroll bars) of 2023-11-20 built on
 igm-qws-u22796a
Repository revision: dd8669b14b8a2b9a6d214a9d142dd8ac604f83d2
Repository branch: emacs-29
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
System Description: Rocky Linux 8.8 (Green Obsidian)

Configured using:
 'configure --config-cache --with-x-toolkit=lucid
 --with-gif=ifavailable'


--=-=-=
Content-Type: text/patch
Content-Disposition: attachment;
 filename=0001-Include-the-project-list-as-history-when-prompting-f.patch

>From 89a4df13ca4c678bd9915e134c078607486348fe 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 pass it as the history variable
when prompting for a project, so it can be used as minibuffer history.

To support this, we minorly change its in-memory format: Instead of a
list of lists, each containing a project-root, it's just a list of
project-roots directly.  This lets us pass it directly to functions
completing-read and add-to-history.  The persistent format (what's
saved in project-list-file) remains the same.

Since project--list is now a minibuffer history variable, if the user
has savehist enabled, project--list will be saved and restored by
savehist.  To avoid that overriding our own persistence mechanism, we
need a separate project--list-initialized variable.

* lisp/progmodes/project.el (project--list): Update docstring for new
format.
(project--list-initialized): Add.
(project--ensure-read-project-list): Check project--list-initialized.
(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-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, 63 insertions(+), 36 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 95db9d0ef4c..bba1248fd73 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1678,11 +1678,18 @@ 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'.")
+
+(defvar project--list-initialized nil)
 
 (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 +1698,12 @@ 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))))))
+    (setq project--list-initialized t)
     (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)
@@ -1703,20 +1711,22 @@ project--read-project-list
 
 (defun project--ensure-read-project-list ()
   "Initialize `project--list' if it isn't already initialized."
-  (when (eq project--list 'unset)
+  (unless project--list-initialized
     (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 +1738,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 +1752,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)
@@ -1772,24 +1782,34 @@ 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
+            (let ((history-delete-duplicates t)
+                  (history-length t))
+              (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).
@@ -1798,17 +1818,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 +1892,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


--=-=-=--