bug#63829: 29.0.90; project-find-file's future history breaks with common-parent-directory

[Spencer Baugh]

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)

>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