Support adjusting file-name-history to the current project

This adds project-file-history-behavior which has the effect described in
its docstring.  Implementing a sort of sharing of file-name-history
between projects.

* lisp/progmodes/project.el (project-file-history-behavior):
New option.  (bug#63829)
(project--transplant-file-name): Add.
(project--read-file-cpd-relative): Move history manipulations to
project--read-file-name.
(project--read-file-name): New function.  Refer to
project-file-history-behavior.
(project-find-file-in, project-find-dir): Use it.
(project-or-external-find-file): Bind the new option to t, to avoid
touching the external file names.

* etc/NEWS: Announce the new option.

Co-authored-by: Dmitry Gutov <dmitry@gutov.dev>

diff --git a/etc/NEWS b/etc/NEWS
index 66a5fcf6a62380d9df5ea26e9ba41a99594c2c90..2c9f3d4e4c8fa5af9936ef5ba936579d0a770e3e 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -729,6 +729,13 @@ the needs of users with red-green or blue-yellow color deficiency.
 The Info manual "(modus-themes) Top" describes the details and
 showcases all their customization options.
 
+** Project
+
+*** New user option 'project-file-history-behavior'.
+Customizing it to 'relative' makes commands like 'project-find-file'
+and 'project-find-dir' display previous history entries relative to
+the current project.
+
 \f
 * Incompatible Lisp Changes in Emacs 30.1
 

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 32eb3bbb89f905f5a71464b491ac02b44e4b6dd5..3776d3d60d3847d3169765d4b85bea5c54c59ce6 100644 (file)
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1029,10 +1029,12 @@ If INCLUDE-ALL is non-nil, or with prefix argument when called
 interactively, include all files under the project root, except
 for VCS directories listed in `vc-directory-exclusion-list'."
   (interactive "P")
+  (defvar project-file-history-behavior)
   (let* ((pr (project-current t))
          (dirs (cons
                 (project-root pr)
-                (project-external-roots pr))))
+                (project-external-roots pr)))
+         (project-file-history-behavior t))
     (project-find-file-in (thing-at-point 'filename) dirs pr include-all)))
 
 (defcustom project-read-file-name-function #'project--read-file-cpd-relative
@@ -1046,6 +1048,26 @@ For the arguments list, see `project--read-file-cpd-relative'."
   :group 'project
   :version "27.1")
 
+(defcustom project-file-history-behavior t
+  "If `relativize', entries in `file-name-history' are adjusted.
+
+History entries shown in `project-find-file', `project-find-dir',
+(from `file-name-history') are adjusted to be relative to the
+current project root, 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'.
+
+This has the effect of sharing more history between projects."
+  :type '(choice (const t :tag "Default behavior")
+                 (const relativize :tag "Adjust to be relative to current")))
+
+(defun project--transplant-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 +1101,7 @@ by the user at will."
          (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 +1113,6 @@ by the user at will."
                                                      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 +1123,29 @@ by the user at will."
                                    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 appropriate history.
+
+Depending on `project-file-history-behavior', entries are made
+project-relative where possible."
+  (let ((file
+         (cl-letf ((history-add-new-input nil)
+                   ((symbol-value hist)
+                    (if (eq project-file-history-behavior 'relativize)
+                        (mapcar
+                         (lambda (f)
+                           (or (project--transplant-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 +1166,10 @@ directories listed in `vc-directory-exclusion-list'."
                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 +1201,11 @@ directories listed in `vc-directory-exclusion-list'."
          ;; 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