From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Spencer Baugh Newsgroups: gmane.emacs.bugs Subject: bug#67310: [PATCH] Include the project--list as history when prompting for a project Date: Wed, 22 Nov 2023 18:14:56 -0500 Message-ID: References: <421e3ea8-d150-566e-f645-cbf1ccbcba61@gutov.dev> <81b6ed58-3fdc-3b5a-41a9-84d66475d5f1@gutov.dev> <5c3eb6a1-38da-8af4-419a-e0567b163e3a@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="4134"; 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 Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Nov 23 00:16:24 2023 Return-path: 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 ) id 1r5wSG-0000sp-4V for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 23 Nov 2023 00:16:24 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1r5wRz-0000Yp-K6; Wed, 22 Nov 2023 18:16:08 -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 ) id 1r5wRq-0000UP-Ib for bug-gnu-emacs@gnu.org; Wed, 22 Nov 2023 18:15:58 -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 ) id 1r5wRq-0005OL-Al for bug-gnu-emacs@gnu.org; Wed, 22 Nov 2023 18:15:58 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1r5wRt-0004jf-IP for bug-gnu-emacs@gnu.org; Wed, 22 Nov 2023 18:16:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Spencer Baugh Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 22 Nov 2023 23:16:01 +0000 Resent-Message-ID: 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.17006949089888 (code B ref 67310); Wed, 22 Nov 2023 23:16:01 +0000 Original-Received: (at 67310) by debbugs.gnu.org; 22 Nov 2023 23:15:08 +0000 Original-Received: from localhost ([127.0.0.1]:60052 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r5wR0-0002Wr-QT for submit@debbugs.gnu.org; Wed, 22 Nov 2023 18:15:08 -0500 Original-Received: from mxout6.mail.janestreet.com ([64.215.233.21]:52061) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r5wQz-0002Ax-8u for 67310@debbugs.gnu.org; Wed, 22 Nov 2023 18:15:06 -0500 In-Reply-To: <5c3eb6a1-38da-8af4-419a-e0567b163e3a@gutov.dev> (Dmitry Gutov's message of "Wed, 22 Nov 2023 20:44:53 +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" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-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:274784 Archived-At: --=-=-= Content-Type: text/plain Dmitry Gutov writes: > On 22/11/2023 18:18, Spencer Baugh wrote: >> Dmitry Gutov 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) --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Include-the-project-list-as-history-when-prompting-f.patch >From 063fe822531d51040be53f47f3dbe35ea77f21be Mon Sep 17 00:00:00 2001 From: Spencer Baugh 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 --=-=-=--