From: Spencer Baugh Date: Thu, 17 Aug 2023 19:41:04 +0000 (-0400) Subject: Support adjusting file-name-history to the current project X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e3209923c3f8c61f22934b9e72ab8840e7d5b9ac;p=emacs.git 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 --- diff --git a/etc/NEWS b/etc/NEWS index 66a5fcf6a62..2c9f3d4e4c8 100644 --- 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. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 32eb3bbb89f..3776d3d60d3 100644 --- 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