From: Spencer Baugh <sbaugh@janestreet.com>
To: Dmitry Gutov <dmitry@gutov.dev>
Cc: sbaugh@catern.com, 63829@debbugs.gnu.org, Juri Linkov <juri@linkov.net>
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 [thread overview]
Message-ID: <ierbkf5pibo.fsf@janestreet.com> (raw)
In-Reply-To: <f447ea97-c299-1a53-465d-063690e717d9@gutov.dev> (Dmitry Gutov's message of "Thu, 17 Aug 2023 05:14:03 +0300")
[-- Attachment #1: Type: text/plain, Size: 3001 bytes --]
Dmitry Gutov <dmitry@gutov.dev> 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)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-adjusting-file-name-history-to-the-current-p.patch --]
[-- Type: text/x-patch, Size: 5780 bytes --]
From 9cb47b7476dfbaf0e9e45001d174da848ebf904d Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
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
next prev parent reply other threads:[~2023-08-17 19:41 UTC|newest]
Thread overview: 39+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-06-01 22:32 bug#63829: 29.0.90; project-find-file's future history breaks with common-parent-directory Spencer Baugh
2023-06-02 6:47 ` Eli Zaretskii
2023-06-03 12:19 ` Dmitry Gutov
2023-06-03 12:48 ` Eli Zaretskii
2023-06-03 13:48 ` Dmitry Gutov
2023-06-03 2:30 ` Dmitry Gutov
2023-06-03 11:00 ` Spencer Baugh
2023-06-04 16:36 ` Juri Linkov
2023-06-06 1:40 ` Dmitry Gutov
2023-06-06 15:55 ` Spencer Baugh
2023-08-10 12:02 ` sbaugh
2023-08-12 1:23 ` Dmitry Gutov
2023-08-14 20:12 ` Spencer Baugh
2023-08-14 22:47 ` sbaugh
2023-08-16 1:49 ` Dmitry Gutov
2023-08-16 2:57 ` sbaugh
2023-08-17 2:14 ` Dmitry Gutov
2023-08-17 19:41 ` Spencer Baugh [this message]
2023-08-17 20:12 ` Spencer Baugh
2023-08-18 20:57 ` Spencer Baugh
2023-08-19 2:14 ` Dmitry Gutov
2023-08-20 17:23 ` Juri Linkov
2023-08-20 17:16 ` Juri Linkov
2023-08-21 1:15 ` Dmitry Gutov
2023-08-23 2:13 ` Dmitry Gutov
2023-08-19 2:08 ` Dmitry Gutov
2023-08-19 12:00 ` sbaugh
2023-08-21 1:51 ` Dmitry Gutov
2023-08-20 17:20 ` Juri Linkov
2023-08-21 1:43 ` Dmitry Gutov
2023-08-21 7:06 ` Juri Linkov
2023-08-23 0:37 ` Dmitry Gutov
2023-08-23 2:26 ` Dmitry Gutov
2023-08-23 17:52 ` Juri Linkov
2023-08-23 18:25 ` Dmitry Gutov
2023-08-20 17:13 ` Juri Linkov
2023-08-21 1:17 ` Dmitry Gutov
2023-08-21 6:58 ` Juri Linkov
2023-08-23 0:27 ` Dmitry Gutov
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=ierbkf5pibo.fsf@janestreet.com \
--to=sbaugh@janestreet.com \
--cc=63829@debbugs.gnu.org \
--cc=dmitry@gutov.dev \
--cc=juri@linkov.net \
--cc=sbaugh@catern.com \
/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).