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#63829: 29.0.90; project-find-file's future history breaks with common-parent-directory Date: Thu, 17 Aug 2023 15:41:47 -0400 Message-ID: References: <16b64d95-35e9-ef94-2c54-17b670111f0f@gutov.dev> <86h6rnw7gm.fsf@mail.linkov.net> <3e404df1-b3a9-f9e3-4270-f42df8b704c7@gutov.dev> <87a5uti6mo.fsf@catern.com> <73a695f3-7c6a-0e50-41dd-61f8269f6ecf@gutov.dev> <875y5fitiq.fsf@catern.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="40258"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: sbaugh@catern.com, 63829@debbugs.gnu.org, Juri Linkov To: Dmitry Gutov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Aug 17 21:42:11 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 1qWisl-000AK2-9r for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 17 Aug 2023 21:42:11 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qWisd-0006Nr-9D; Thu, 17 Aug 2023 15:42:03 -0400 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 1qWisc-0006Nc-9Q for bug-gnu-emacs@gnu.org; Thu, 17 Aug 2023 15:42:02 -0400 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 1qWisb-0007Ky-V6 for bug-gnu-emacs@gnu.org; Thu, 17 Aug 2023 15:42:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qWisb-0005Ne-RR for bug-gnu-emacs@gnu.org; Thu, 17 Aug 2023 15:42:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Spencer Baugh Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 17 Aug 2023 19:42:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63829 X-GNU-PR-Package: emacs Original-Received: via spool by 63829-submit@debbugs.gnu.org id=B63829.169230131620672 (code B ref 63829); Thu, 17 Aug 2023 19:42:01 +0000 Original-Received: (at 63829) by debbugs.gnu.org; 17 Aug 2023 19:41:56 +0000 Original-Received: from localhost ([127.0.0.1]:45661 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qWisW-0005NL-0C for submit@debbugs.gnu.org; Thu, 17 Aug 2023 15:41:56 -0400 Original-Received: from mxout6.mail.janestreet.com ([64.215.233.21]:39931) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qWisU-0005N3-8M for 63829@debbugs.gnu.org; Thu, 17 Aug 2023 15:41:55 -0400 In-Reply-To: (Dmitry Gutov's message of "Thu, 17 Aug 2023 05:14:03 +0300") 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:267695 Archived-At: --=-=-= Content-Type: text/plain Dmitry Gutov writes: > I'm pushed the first of your patches, but the second needed some > adjustments. Chiefly because we need to make sure it works with any > value of project-read-file-name-function, so the impl can't be > concentrated in just one of them. > > Check out the amended patch below. Any suggestions on how to do it > more elegantly (without duplicating the add-to-history call) are > welcome too. > > diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el > index e1d14474323..d810d8d9605 100644 > --- a/lisp/progmodes/project.el > +++ b/lisp/progmodes/project.el > @@ -1046,6 +1046,13 @@ project-read-file-name-function > :group 'project > :version "27.1") > > +(defun project--expand-file-name (filename project) > + (when-let ((old-root (get-text-property 0 'project filename))) > + (abbreviate-file-name > + (expand-file-name > + (file-relative-name filename old-root) > + (project-root project))))) > + > (defun project--read-file-cpd-relative (prompt > all-files &optional predicate > hist mb-default) > @@ -1124,9 +1131,18 @@ project-find-file-in > dirs) > (project-files project dirs))) > (completion-ignore-case read-file-name-completion-ignore-case) > - (file (funcall project-read-file-name-function > - "Find file" all-files nil 'file-name-history > - suggested-filename))) > + (file > + (let ((file-name-history (mapcar > + (lambda (f) > + (or (project--expand-file-name > f project) f)) > + file-name-history))) > + (funcall project-read-file-name-function > + "Find file" all-files nil 'file-name-history > + suggested-filename)))) > + (when history-add-new-input > + ;; Have to re-add it here because of the let-binding above. > + (add-to-history 'file-name-history > + (propertize file 'project (project-root project)))) > (if (string= file "") > (user-error "You didn't specify the file") > (find-file file)))) This seems good, sure. But doesn't this make the history entries appear twice? Maybe we should just pull the history-adding functionality out of project-read-file-name-function entirely. I've tried doing that below. Also, I realized just now that this should probably affect project-find-dir as well, as should my previous patch adding project-relative future history. (I actually coincidentally just now got a user request for "switch between projects and stay in the same dir") So here's a revised version of this history change which also affects project-find-dir. In a subsequent mail I'll send a patch for the "future history" behavior of project-find-dir too. (yet to be written) --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Support-adjusting-file-name-history-to-the-current-p.patch >From 9cb47b7476dfbaf0e9e45001d174da848ebf904d Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 17 Aug 2023 15:41:04 -0400 Subject: [PATCH] Support adjusting file-name-history to the current project This add project-file-name-history-relativize which has the effect described in its docstring. This implements a sort of sharing of file-name-history between projects. * lisp/progmodes/project.el (project-file-name-history-relativize): Add. (bug#63829) (project--expand-file-name): Add. (project--read-file-cpd-relative): Move history manipulations to project--read-file-name. (project--read-file-name): Add and use project-file-name-history-relativize. (project-find-file-in): Use project--read-file-name. (project-find-dir): Use project--read-file-name. --- lisp/progmodes/project.el | 62 +++++++++++++++++++++++++++++++-------- 1 file changed, 50 insertions(+), 12 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index c1ce5ce7b1f..e0f1f995ff2 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1046,6 +1046,26 @@ project-read-file-name-function :group 'project :version "27.1") +(defcustom project-file-name-history-relativize nil + "If non-nil, paths in `file-name-history' are adjusted for the current project. + +When non-nil and in `project-find-file' or `project-find-dir', +paths in `file-name-history' are adjusted to be relative to +whatever the current project is, instead of the project which +added those paths. This only affects history entries added by +earlier calls to `project-find-file' or `project-find-dir'. + +When `project-read-file-name-function' is +`project--read-file-cpd-relative' (the default), this has the +effect of sharing more history between projects.") + +(defun project--expand-file-name (filename project) + (when-let ((old-root (get-text-property 0 'project filename))) + (abbreviate-file-name + (expand-file-name + (file-relative-name filename old-root) + (project-root project))))) + (defun project--read-file-cpd-relative (prompt all-files &optional predicate hist mb-default) @@ -1079,8 +1099,7 @@ project--read-file-cpd-relative (new-collection (project--file-completion-table substrings)) (abbr-cpd (abbreviate-file-name common-parent-directory)) (abbr-cpd-length (length abbr-cpd)) - (relname (cl-letf ((history-add-new-input nil) - ((symbol-value hist) + (relname (cl-letf (((symbol-value hist) (mapcan (lambda (s) (and (string-prefix-p abbr-cpd s) @@ -1092,8 +1111,6 @@ project--read-file-cpd-relative predicate hist mb-default))) (absname (expand-file-name relname common-parent-directory))) - (when (and hist history-add-new-input) - (add-to-history hist (abbreviate-file-name absname))) absname)) (defun project--read-file-absolute (prompt @@ -1104,6 +1121,26 @@ project--read-file-absolute predicate hist mb-default)) +(defun project--read-file-name (project prompt + all-files &optional predicate + hist mb-default) + "Call `project-read-file-name-function' with project-relative history." + (let ((file + (cl-letf ((history-add-new-input nil) + ((symbol-value hist) + (if project-file-name-history-relativize + (mapcar + (lambda (f) + (or (project--expand-file-name f project) f)) + (symbol-value hist)) + (symbol-value hist)))) + (funcall project-read-file-name-function + prompt all-files predicate hist mb-default)))) + (when (and hist history-add-new-input) + (add-to-history hist + (propertize file 'project (project-root project)))) + file)) + (defun project-find-file-in (suggested-filename dirs project &optional include-all) "Complete a file name in DIRS in PROJECT and visit the result. @@ -1124,9 +1161,10 @@ project-find-file-in dirs) (project-files project dirs))) (completion-ignore-case read-file-name-completion-ignore-case) - (file (funcall project-read-file-name-function - "Find file" all-files nil 'file-name-history - suggested-filename))) + (file (project--read-file-name + project "Find file" + all-files nil 'file-name-history + suggested-filename))) (if (string= file "") (user-error "You didn't specify the file") (find-file file)))) @@ -1158,11 +1196,11 @@ project-find-dir ;; https://stackoverflow.com/a/50685235/615245 for possible ;; implementation. (all-dirs (mapcar #'file-name-directory all-files)) - (dir (funcall project-read-file-name-function - "Dired" - ;; Some completion UIs show duplicates. - (delete-dups all-dirs) - nil 'file-name-history))) + (dir (project--read-file-name + project "Dired" + ;; Some completion UIs show duplicates. + (delete-dups all-dirs) + nil 'file-name-history))) (dired dir))) ;;;###autoload -- 2.39.3 --=-=-=--