GNU logs - #61861, boring messages

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors
Resent-From: dick <dick.r.chiang@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Tue, 28 Feb 2023 05:31:02 +0000
Resent-Message-ID: <handler.61861.B.167756221532558 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 61861 <at> debbugs.gnu.org
From: dick <dick.r.chiang@HIDDEN>
Date: Mon, 27 Feb 2023 20:22:34 -0500
Message-ID: <87v8jmfusl.fsf@dick>
MIME-Version: 1.0
Content-Type: text/x-diff
Content-Disposition: inline;
 filename=0001-Catch-project.el-up-to-projectile-s-dwim-behaviors.patch
Received-SPF: pass client-ip=2607:f8b0:4864:20::82b;
 envelope-from=dick.r.chiang@HIDDEN; helo=mail-qt1-x82b.google.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001,
 RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001,
 SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.3 (-)
X-Mailman-Approved-At: Tue, 28 Feb 2023 00:30:10 -0500
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.3 (--)

From 4f1ab3ca1db5e2aa2fb71599918f6d1c32ebf95e Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@HIDDEN>
Date: Mon, 27 Feb 2023 19:55:55 -0500
Subject: [PATCH] Catch project.el up to projectile's dwim behaviors.

src/emacs -Q --batch \
 --eval "(setq project-list-file (make-temp-name \"/tmp/qux\"))" \
 --eval "(if installation-directory \
             (condition-case err \
                 (let ((default-directory installation-directory)) \
                   (project-query-replace-regexp \
                     (concat \"nim\" \"rod\") \"stunad\")) \
               (user-error (princ (format \"%s\n\"
                                          (error-message-string err))))) \
           (princ \"!! run from src/emacs !!\n\"))"

* lisp/progmodes/project.el (project-get-project, project-current):
Rationalize interfaces.
(project--files-in-directory): Whitespace.
(project-try-vc): Avoid swallowing errors.
(project-files): De-obfuscate.
(project--vc-list-files): Whitespace.
(project-find-regexp, project-or-external-find-regexp, project-find-file,
project-or-external-find-file, project-find-dir, project-dired,
project-vc-dir, project-eshell, project-shell, project-async-shell-command,
project-shell-command, project-search, project-query-replace-regexp,
project-compile, project--read-project-buffer, project-list-buffers,
project-kill-buffers, project-switch-project): DWIM.
(project--read-file-cpd-relative): De-obfuscate.
(project-find-file-in): Whitespace.
(project-most-recent-project): New DWIM function.
(project-remember-project, project-prompt-project-dir): De-obfuscate.
(project-execute-extended-command): Rationalize interfaces.
(project-remember-projects-under): Avoid backslashes.
* lisp/progmodes/xref.el (xref-matches-in-files): Do expand-file-name here.
* test/lisp/progmodes/project-tests.el (project-switch-project-extant-buffer,
project-implicit-project-absorption, project-assume-mru-project): Test.
(project-vc-extra-root-markers-supports-wildcards): Dude.
---
 lisp/progmodes/project.el            | 340 +++++++++++++--------------
 lisp/progmodes/xref.el               |   2 +-
 test/lisp/progmodes/project-tests.el |  99 +++++++-
 3 files changed, 266 insertions(+), 175 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 11228226592..565c2f85f5a 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -60,7 +60,7 @@
 ;;
 ;; Transient project:
 ;;
-;; An instance of this type can be returned by `project-current' if no
+;; An instance of this type can be returned by `project-get-project' if no
 ;; project was detected automatically, and the user had to pick a
 ;; directory manually.  The fileset it describes is the whole
 ;; directory, with the exception of some standard ignored files and
@@ -203,38 +203,42 @@ project-current-directory-override
 When it is non-nil, `project-current' will always skip prompting too.")
 
 ;;;###autoload
-(defun project-current (&optional maybe-prompt directory)
-  "Return the project instance in DIRECTORY, defaulting to `default-directory'.
-
-When no project is found in that directory, the result depends on
-the value of MAYBE-PROMPT: if it is nil or omitted, return nil,
-else ask the user for a directory in which to look for the
-project, and if no project is found there, return a \"transient\"
-project instance.
-
-The \"transient\" project instance is a special kind of value
-which denotes a project rooted in that directory and includes all
-the files under the directory except for those that match entries
-in `vc-directory-exclusion-list' or `grep-find-ignored-files'.
-
-See the doc string of `project-find-functions' for the general form
-of the project instance object."
-  (unless directory (setq directory (or project-current-directory-override
-                                        default-directory)))
-  (let ((pr (project--find-in-directory directory)))
-    (cond
-     (pr)
-     ((unless project-current-directory-override
-        maybe-prompt)
+(defun project-get-project (&optional directory)
+  "Return the project for DIRECTORY, and mark as most recently used.
+DIRECTORY defaults to `default-directory'.  If no project obtains
+from DIRECTORY, prompt the user for an alternate directory.  If
+no project obtains from the alternate, return the \"transient\"
+project instance and do not adjust recently used projects."
+  (let* ((directory (or directory
+                        project-current-directory-override
+                        default-directory))
+         (pr (project--find-in-directory directory)))
+    (when (and (not pr)
+               (not project-current-directory-override))
       (setq directory (project-prompt-project-dir)
-            pr (project--find-in-directory directory))))
-    (when maybe-prompt
-      (if pr
-          (project-remember-project pr)
+            pr (project--find-in-directory directory)))
+    (if pr
+        (prog1 pr
+          (project-remember-project pr))
+      (prog1 (cons 'transient directory)
         (project--remove-from-project-list
-         directory "Project `%s' not found; removed from list")
-        (setq pr (cons 'transient directory))))
-    pr))
+         directory "Project `%s' not found; removed from list")))))
+
+;;;###autoload
+(defun project-current (&optional maybe-prompt directory)
+  "Return the project for DIRECTORY.
+DIRECTORY defaults to `default-directory'.
+Under MAYBE-PROMPT, calls `project-get-project'."
+  ;; Gradually replace occurrences of (project-current t)
+  ;; with (project-get-project), and replace (project-current nil dir)
+  ;; with (let ((default-directory dir)) (project-current))
+  (if maybe-prompt
+      (project-get-project directory)
+    (let ((pr (project--find-in-directory
+               (or directory
+                   project-current-directory-override
+                   default-directory))))
+      (prog1 pr (when pr (project-remember-project pr))))))
 
 (defun project--find-in-directory (dir)
   (run-hook-with-args-until-success 'project-find-functions dir))
@@ -327,11 +331,6 @@ project--files-in-directory
   (require 'find-dired)
   (require 'xref)
   (let* ((default-directory dir)
-         ;; Make sure ~/ etc. in local directory name is
-         ;; expanded and not left for the shell command
-         ;; to interpret.
-         (localdir (file-name-unquote (file-local-name (expand-file-name dir))))
-         (dfn (directory-file-name localdir))
          (command (format "%s -H . %s -type f %s -print0"
                           find-program
                           (xref--find-ignores-arguments ignores "./")
@@ -347,14 +346,12 @@ project--files-in-directory
                             "")))
          res)
     (with-temp-buffer
-      (let ((status
-             (process-file-shell-command command nil t))
+      (let ((status (process-file-shell-command command nil t))
             (pt (point-min)))
         (unless (zerop status)
           (goto-char (point-min))
-          (if (and
-               (not (eql status 127))
-               (search-forward "Permission denied\n" nil t))
+          (if (and (not (eql status 127))
+                   (search-forward "Permission denied\n" nil t))
               (let ((end (1- (point))))
                 (re-search-backward "\\`\\|\0")
                 (error "File listing failed: %s"
@@ -365,21 +362,17 @@ project--files-in-directory
           (push (buffer-substring-no-properties (1+ pt) (1- (point)))
                 res)
           (setq pt (point)))))
-    (project--remote-file-names
-     (mapcar (lambda (s) (concat dfn s))
-             (sort res #'string<)))))
-
-(defun project--remote-file-names (local-files)
-  "Return LOCAL-FILES as if they were on the system of `default-directory'.
-Also quote LOCAL-FILES if `default-directory' is quoted."
-  (let ((remote-id (file-remote-p default-directory)))
-    (if (not remote-id)
-        (if (file-name-quoted-p default-directory)
-            (mapcar #'file-name-quote local-files)
-          local-files)
-      (mapcar (lambda (file)
-                (concat remote-id file))
-              local-files))))
+    (setq res (sort res #'string<))
+    (if-let ((remote-id (file-remote-p default-directory)))
+        (mapcar (lambda (file)
+                  (concat remote-id
+                          (directory-file-name
+                           (file-name-unquote
+                            (file-local-name
+                             (expand-file-name default-directory))))
+                          file))
+                res)
+      (mapcar (lambda (s) (concat (directory-file-name default-directory) s)) res))))
 
 (cl-defgeneric project-buffers (project)
   "Return the list of all live buffers that belong to PROJECT.
@@ -539,10 +532,8 @@ project-try-vc
                dir
                (lambda (d)
                  ;; Maybe limit count to 100 when we can drop Emacs < 28.
-                 (setq last-matches
-                       (condition-case nil
-                           (directory-files d nil marker-re t)
-                         (file-missing nil))))))
+                 (when (file-directory-p d)
+                   (setq last-matches (directory-files d nil marker-re t))))))
              (backend
               (cl-find-if
                (lambda (b)
@@ -604,18 +595,13 @@ project-files
        (when backend
          (require (intern (concat "vc-" (downcase (symbol-name backend))))))
        (if (and (file-equal-p dir (nth 2 project))
-                (cond
-                 ((eq backend 'Hg))
-                 ((and (eq backend 'Git)
-                       (or
-                        (not ignores)
-                        (version<= "1.9" (vc-git--program-version)))))))
+                (or (eq backend 'Hg)
+                    (and (eq backend 'Git)
+                         (or (not ignores)
+                             (version<= "1.9" (vc-git--program-version))))))
            (project--vc-list-files dir backend ignores)
-         (project--files-in-directory
-          dir
-          (project--dir-ignores project dir)))))
-   (or dirs
-       (list (project-root project)))))
+         (project--files-in-directory dir (project--dir-ignores project dir)))))
+   (or dirs (list (project-root project)))))
 
 (declare-function vc-git--program-version "vc-git")
 (declare-function vc-git--run-command-string "vc-git")
@@ -625,16 +611,15 @@ project--vc-list-files
   (defvar vc-git-use-literal-pathspecs)
   (pcase backend
     (`Git
-     (let* ((default-directory (expand-file-name (file-name-as-directory dir)))
+     (let* ((default-directory dir)
             (args '("-z"))
             (vc-git-use-literal-pathspecs nil)
             (include-untracked (project--value-in-dir
                                 'project-vc-include-untracked
                                 dir))
             files)
-       (setq args (append args
-                          '("-c" "--exclude-standard")
-                          (and include-untracked '("-o"))))
+       (setq args (append args '("-c" "--exclude-standard")
+                          (when include-untracked '("-o"))))
        (when extra-ignores
          (setq args (append args
                             (cons "--"
@@ -663,7 +648,7 @@ project--vc-list-files
                                    extra-ignores)))))
        (setq files
              (mapcar
-              (lambda (file) (concat default-directory file))
+              (lambda (file) (concat (file-name-as-directory dir) file))
               (split-string
                (apply #'vc-git--run-command-string nil "ls-files" args)
                "\0" t)))
@@ -675,17 +660,16 @@ project--vc-list-files
                   (lambda (module)
                     (when (file-directory-p module)
                       (project--vc-list-files
-                       (concat default-directory module)
+                       (concat (file-name-as-directory dir) module)
                        backend
                        extra-ignores)))
                   submodules)))
-           (setq files
-                 (apply #'nconc files sub-files))))
+           (setq files (apply #'nconc files sub-files))))
        ;; 'git ls-files' returns duplicate entries for merge conflicts.
        ;; XXX: Better solutions welcome, but this seems cheap enough.
        (delete-consecutive-dups files)))
     (`Hg
-     (let* ((default-directory (expand-file-name (file-name-as-directory dir)))
+     (let* ((default-directory dir)
             (include-untracked (project--value-in-dir
                                 'project-vc-include-untracked
                                 dir))
@@ -693,16 +677,12 @@ project--vc-list-files
                         "--no-status"
                         "-0")))
        (when extra-ignores
-         (setq args (nconc args
-                           (mapcan
-                            (lambda (i)
-                              (list "--exclude" i))
-                            extra-ignores))))
+         (setq args (nconc args (mapcan (lambda (i) (list "--exclude" i))
+                                        extra-ignores))))
        (with-temp-buffer
          (apply #'vc-hg-command t 0 "." "status" args)
-         (mapcar
-          (lambda (s) (concat default-directory s))
-          (split-string (buffer-string) "\0" t)))))))
+         (mapcar (lambda (s) (concat (file-name-as-directory dir) s))
+                 (split-string (buffer-string) "\0" t)))))))
 
 (defun project--vc-merge-submodules-p (dir)
   (project--value-in-dir
@@ -924,7 +904,7 @@ project-find-regexp
   (require 'xref)
   (require 'grep)
   (let* ((caller-dir default-directory)
-         (pr (project-current t))
+         (pr (project-most-recent-project))
          (default-directory (project-root pr))
          (files
           (if (not current-prefix-arg)
@@ -956,7 +936,7 @@ project-or-external-find-regexp
 pattern to search for."
   (interactive (list (project--read-regexp)))
   (require 'xref)
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (default-directory (project-root pr))
          (files
           (project-files pr (cons
@@ -992,7 +972,7 @@ project-find-file
 interactively, include all files under the project root, except
 for VCS directories listed in `vc-directory-exclusion-list'."
   (interactive "P")
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (root (project-root pr))
          (dirs (list root)))
     (project-find-file-in
@@ -1011,7 +991,7 @@ project-or-external-find-file
 interactively, include all files under the project root, except
 for VCS directories listed in `vc-directory-exclusion-list'."
   (interactive "P")
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (dirs (cons
                 (project-root pr)
                 (project-external-roots pr))))
@@ -1039,39 +1019,40 @@ project--read-file-cpd-relative
 MB-DEFAULT is used as part of \"future history\", to be inserted
 by the user at will."
   (let* ((common-parent-directory
-          (let ((common-prefix (try-completion "" all-files)))
-            (if (> (length common-prefix) 0)
-                (file-name-directory common-prefix))))
-         (cpd-length (length common-parent-directory))
-         (prompt (if (zerop cpd-length)
-                     prompt
-                   (concat prompt (format " in %s" common-parent-directory))))
-         (included-cpd (when (member common-parent-directory all-files)
-                         (setq all-files
-                               (delete common-parent-directory all-files))
-                         t))
-         (substrings (mapcar (lambda (s) (substring s cpd-length)) all-files))
-         (_ (when included-cpd
-              (setq substrings (cons "./" substrings))))
-         (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)
-                             (mapcan
-                              (lambda (s)
-                                (and (string-prefix-p abbr-cpd s)
-                                     (not (eq abbr-cpd-length (length s)))
-                                     (list (substring s abbr-cpd-length))))
-                              (symbol-value hist))))
-                    (project--completing-read-strict prompt
-                                                     new-collection
-                                                     predicate
-                                                     hist mb-default)))
+          (or (let ((common-prefix (try-completion "" all-files)))
+                (unless (zerop (length common-prefix))
+                  (file-name-directory common-prefix)))
+              ""))
+         (relname (cl-letf* ((new-collection
+                              (project--file-completion-table
+                               (mapcar
+                                (lambda (file)
+                                  (let ((s (substring
+                                            file (length common-parent-directory))))
+                                    (if (string-empty-p s) "." s)))
+                                all-files)))
+                             (history-add-new-input nil)
+                             (abbr-cpd (abbreviate-file-name common-parent-directory))
+                             (abbr-cpd-length (length abbr-cpd))
+                             ((symbol-value hist)
+                              (mapcan
+                               (lambda (s)
+                                 (and (string-prefix-p abbr-cpd s)
+                                      (not (eq abbr-cpd-length (length s)))
+                                      (list (substring s abbr-cpd-length))))
+                               (symbol-value hist))))
+                    (project--completing-read-strict
+                     (concat prompt
+                             (unless (string-empty-p common-parent-directory)
+                               (format " [%s]" (directory-file-name
+                                                common-parent-directory))))
+                     new-collection
+                     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))
+    (prog1 absname
+      (when (and hist history-add-new-input)
+        (add-to-history hist (abbreviate-file-name absname))))))
 
 (defun project--read-file-absolute (prompt
                                     all-files &optional predicate
@@ -1094,17 +1075,16 @@ project-find-file-in
                            (lambda (dir)
                              (concat dir "/"))
                            vc-directory-exclusion-list))
-         (all-files
-          (if include-all
-              (mapcan
-               (lambda (dir) (project--files-in-directory dir vc-dirs-ignores))
-               dirs)
-            (project-files project dirs)))
+         (all-files (if include-all
+                        (mapcan (lambda (dir)
+                                  (project--files-in-directory dir vc-dirs-ignores))
+                                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)))
-    (if (string= file "")
+    (if (string-empty-p file)
         (user-error "You didn't specify the file")
       (find-file file))))
 
@@ -1126,7 +1106,7 @@ project--completing-read-strict
 (defun project-find-dir ()
   "Start Dired in a directory inside the current project."
   (interactive)
-  (let* ((project (project-current t))
+  (let* ((project (project-most-recent-project))
          (all-files (project-files project))
          (completion-ignore-case read-file-name-completion-ignore-case)
          ;; FIXME: This misses directories without any files directly
@@ -1146,13 +1126,13 @@ project-find-dir
 (defun project-dired ()
   "Start Dired in the current project's root."
   (interactive)
-  (dired (project-root (project-current t))))
+  (dired (project-root (project-most-recent-project))))
 
 ;;;###autoload
 (defun project-vc-dir ()
   "Run VC-Dir in the current project's root."
   (interactive)
-  (vc-dir (project-root (project-current t))))
+  (vc-dir (project-root (project-most-recent-project))))
 
 (declare-function comint-check-proc "comint")
 
@@ -1165,7 +1145,7 @@ project-shell
 if one already exists."
   (interactive)
   (require 'comint)
-  (let* ((default-directory (project-root (project-current t)))
+  (let* ((default-directory (project-root (project-most-recent-project)))
          (default-project-shell-name (project-prefixed-buffer-name "shell"))
          (shell-buffer (get-buffer default-project-shell-name)))
     (if (and shell-buffer (not current-prefix-arg))
@@ -1183,7 +1163,7 @@ project-eshell
 if one already exists."
   (interactive)
   (defvar eshell-buffer-name)
-  (let* ((default-directory (project-root (project-current t)))
+  (let* ((default-directory (project-root (project-most-recent-project)))
          (eshell-buffer-name (project-prefixed-buffer-name "eshell"))
          (eshell-buffer (get-buffer eshell-buffer-name)))
     (if (and eshell-buffer (not current-prefix-arg))
@@ -1195,7 +1175,7 @@ project-async-shell-command
   "Run `async-shell-command' in the current project's root directory."
   (declare (interactive-only async-shell-command))
   (interactive)
-  (let ((default-directory (project-root (project-current t))))
+  (let ((default-directory (project-root (project-most-recent-project))))
     (call-interactively #'async-shell-command)))
 
 ;;;###autoload
@@ -1203,7 +1183,7 @@ project-shell-command
   "Run `shell-command' in the current project's root directory."
   (declare (interactive-only shell-command))
   (interactive)
-  (let ((default-directory (project-root (project-current t))))
+  (let ((default-directory (project-root (project-most-recent-project))))
     (call-interactively #'shell-command)))
 
 (declare-function fileloop-continue "fileloop" ())
@@ -1216,7 +1196,7 @@ project-search
 command \\[fileloop-continue]."
   (interactive "sSearch (regexp): ")
   (fileloop-initialize-search
-   regexp (project-files (project-current t)) 'default)
+   regexp (project-files (project-most-recent-project)) 'default)
   (fileloop-continue))
 
 ;;;###autoload
@@ -1239,7 +1219,10 @@ project-query-replace-regexp
    ;; XXX: Filter out Git submodules, which are not regular files.
    ;; `project-files' can return those, which is arguably suboptimal,
    ;; but removing them eagerly has performance cost.
-   (cl-delete-if-not #'file-regular-p (project-files (project-current t)))
+   (cl-delete-if-not (lambda (file)
+                       (and (file-regular-p file)
+                            (not (find-file-name-handler file 'insert-file-contents))))
+                 (project-files (project-most-recent-project)))
    'default)
   (fileloop-continue))
 
@@ -1270,7 +1253,7 @@ project-compile
   "Run `compile' in the project root."
   (declare (interactive-only compile))
   (interactive)
-  (let ((default-directory (project-root (project-current t)))
+  (let ((default-directory (project-root (project-most-recent-project)))
         (compilation-buffer-name-function
          (or project-compilation-buffer-name-function
              compilation-buffer-name-function)))
@@ -1300,7 +1283,7 @@ project-ignore-buffer-conditions
   :package-version '(project . "0.8.2"))
 
 (defun project--read-project-buffer ()
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (current-buffer (current-buffer))
          (other-buffer (other-buffer current-buffer))
          (other-name (buffer-name other-buffer))
@@ -1365,7 +1348,7 @@ project-list-buffers
 start with a space (which are for internal use).  With prefix argument
 ARG, show only buffers that are visiting files."
   (interactive "P")
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (buffer-list-function
           (lambda ()
             (seq-filter
@@ -1506,7 +1489,7 @@ project-kill-buffers
 
 Also see the `project-kill-buffers-display-buffer-list' variable."
   (interactive)
-  (let* ((pr (project-current t))
+  (let* ((pr (project-most-recent-project))
          (bufs (project--buffers-to-kill pr))
          (query-user (lambda ()
                        (yes-or-no-p
@@ -1582,19 +1565,28 @@ project--write-project-list
       (write-region nil nil filename nil 'silent))))
 
 ;;;###autoload
-(defun project-remember-project (pr &optional no-write)
+(defun project-most-recent-project ()
+  (project--ensure-read-project-list)
+  (let ((pr (or (project-current)
+                (when-let ((mru (caar project--list)))
+                  (project--find-in-directory mru))
+                (project-get-project))))
+    (prog1 pr (project-remember-project pr))))
+
+;;;###autoload
+(defun project-remember-project (pr &optional _no-write)
   "Add project PR to the front of the project list.
 Save the result in `project-list-file' if the list of projects
 has changed, and NO-WRITE is nil."
   (project--ensure-read-project-list)
-  (let ((dir (project-root pr)))
-    (unless (equal (caar project--list) dir)
-      (dolist (ent project--list)
-        (when (equal dir (car ent))
-          (setq project--list (delq ent project--list))))
-      (push (list dir) project--list)
-      (unless no-write
-        (project--write-project-list)))))
+  (let* ((dir (project-root pr))
+         (extant (cl-find-if (lambda (entry) (equal dir (car entry)))
+                             project--list)))
+    (setq project--list (delq extant project--list))
+    (push (list dir) project--list)
+    (when (and (not extant)
+               (not (bound-and-true-p ert--running-tests)))
+      (project--write-project-list))))
 
 (defun project--remove-from-project-list (project-root report-message)
   "Remove directory PROJECT-ROOT of a missing project from the project list.
@@ -1623,19 +1615,17 @@ project-prompt-project-dir
 see `project-list-file'.
 It's also possible to enter an arbitrary directory not in the list."
   (project--ensure-read-project-list)
-  (let* ((dir-choice "... (choose a dir)")
-         (choices
-          ;; XXX: Just using this for the category (for the substring
-          ;; completion style).
-          (project--file-completion-table
-           (append project--list `(,dir-choice))))
-         (pr-dir ""))
-    (while (equal pr-dir "")
-      ;; If the user simply pressed RET, do this again until they don't.
-      (setq pr-dir (completing-read "Select project: " choices nil t)))
-    (if (equal pr-dir dir-choice)
+  (let* (pr
+         (dir-choice "... (choose a dir)")
+         (choices (project--file-completion-table
+                   (append project--list `(,dir-choice)))))
+    (while (string-empty-p
+            ;; Even under require-match, `completing-read' allows RET
+            ;; to yield an empty string.
+            (setq pr (completing-read "Select project: " choices nil t))))
+    (if (equal pr dir-choice)
         (read-directory-name "Select directory: " default-directory nil t)
-      pr-dir)))
+      pr)))
 
 ;;;###autoload
 (defun project-known-project-roots ()
@@ -1648,7 +1638,7 @@ project-execute-extended-command
   "Execute an extended command in project root."
   (declare (interactive-only command-execute))
   (interactive)
-  (let ((default-directory (project-root (project-current t))))
+  (let ((default-directory (project-root (project-most-recent-project))))
     (call-interactively #'execute-extended-command)))
 
 (defun project-remember-projects-under (dir &optional recursive)
@@ -1672,7 +1662,7 @@ project-remember-projects-under
         (when-let ((project (project--find-in-directory subdir))
                    (project-root (project-root project))
                    ((not (gethash project-root known))))
-          (project-remember-project project t)
+          (project-remember-project project)
           (puthash project-root t known)
           (message "Found %s..." project-root)
           (setq count (1+ count)))
@@ -1818,18 +1808,22 @@ project--switch-project-command
 
 ;;;###autoload
 (defun project-switch-project (dir)
-  "\"Switch\" to another project by running an Emacs command.
+  "Switch to another project by running an Emacs command.
 The available commands are presented as a dispatch menu
 made from `project-switch-commands'.
 
 When called in a program, it will use the project corresponding
 to directory DIR."
   (interactive (list (project-prompt-project-dir)))
-  (let ((command (if (symbolp project-switch-commands)
-                     project-switch-commands
-                   (project--switch-project-command))))
-    (let ((project-current-directory-override dir))
-      (call-interactively command))))
+  (if-let ((pr (let ((default-directory dir))
+                 (project-current)))
+           (mru (cl-find-if #'buffer-file-name (project-buffers pr))))
+      (project-switch-to-buffer mru)
+    (let ((command (if (symbolp project-switch-commands)
+                       project-switch-commands
+                     (project--switch-project-command))))
+      (let ((project-current-directory-override dir))
+        (call-interactively command)))))
 
 (provide 'project)
 ;;; project.el ends here
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 38c424402a0..b23a628816a 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1908,7 +1908,7 @@ xref-matches-in-files
     (with-current-buffer output
       (erase-buffer)
       (with-temp-buffer
-        (insert (mapconcat #'identity files "\0"))
+        (insert (mapconcat #'expand-file-name files "\0"))
         (setq default-directory dir)
         (setq status
               (xref--with-connection-local-variables
diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el
index 5a206b67db1..21fb71ac58e 100644
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -32,6 +32,10 @@
 (require 'ert-x) ; ert-with-temp-directory
 (require 'grep)
 (require 'xref)
+(require 'vc)
+(require 'vc-git)
+(require 'log-edit)
+
 
 (ert-deftest project/quoted-directory ()
   "Check that `project-files' and `project-find-regexp' deal with
@@ -110,6 +114,99 @@ project-ignores-bug-50240
                      (list
                       (expand-file-name "some-file" dir)))))))
 
+(ert-deftest project-switch-project-extant-buffer ()
+  "Prefer just switching to the mru buffer of the switched-to project instead
+of bringing up `project-switch-commands'."
+  (ert-with-temp-directory dir1
+    (ert-with-temp-directory dir2
+      (cl-letf* ((switch-called-on nil)
+                 ((symbol-function 'switch-project)
+                  (lambda () (interactive)
+                    (setq default-directory project-current-directory-override
+                          switch-called-on default-directory)))
+                 (project1 (make-project-tests--trivial :root dir1))
+                 (project2 (make-project-tests--trivial :root dir2))
+                 (project-find-functions
+                  (list (lambda (dir)
+                          (assoc-default dir (list (cons dir1 project1)
+                                                   (cons dir2 project2))))))
+                 (project-switch-commands 'switch-project)
+                 (buf2 (progn
+                         (make-empty-file (expand-file-name "some-file" dir2))
+                         (find-file-noselect (expand-file-name "some-file" dir2)))))
+        (project-switch-project dir1)
+        (should (equal switch-called-on dir1))
+        (should (equal (project-root (project-current)) dir1))
+        (project-switch-project dir2)
+        (should (equal switch-called-on dir1)) ; not dir2
+        (should (equal (project-root (project-current)) dir2))
+        (should (eq (current-buffer) buf2))
+        (let (kill-buffer-query-functions) (kill-buffer buf2))))))
+
+(ert-deftest project-assume-mru-project ()
+  "Assume mru project if default-directory is project-less."
+  (ert-with-temp-directory dir1
+    (ert-with-temp-directory dir2
+      (cl-letf* ((project2 (make-project-tests--trivial :root dir2))
+                 (project-find-functions
+                  (list (lambda (dir)
+                          (assoc-default dir (list (cons dir2 project2))))))
+                 (buf1 (progn
+                         (make-empty-file (expand-file-name "some-file" dir1))
+                         (find-file-noselect (expand-file-name "some-file" dir1))))
+                 (buf2 (progn
+                         (make-empty-file (expand-file-name "some-file" dir2))
+                         (find-file-noselect (expand-file-name "some-file" dir2))))
+                 ((symbol-function 'read-buffer)
+                  (lambda (_prompt other-buffer &rest _args)
+                    other-buffer)))
+        (switch-to-buffer buf1)
+        (should-not (project-current))
+        (switch-to-buffer buf2)
+        (should (equal (project-root (project-current)) dir2))
+        (switch-to-buffer buf1)
+        (call-interactively #'project-switch-to-buffer)
+        (should (eq (current-buffer) buf2))
+        (let (kill-buffer-query-functions)
+          (kill-buffer buf1)
+          (kill-buffer buf2))))))
+
+(defmacro project-tests--mock-repo (&rest body)
+  (declare (indent defun))
+  `(let* ((dir (make-temp-file "project-tests" t))
+          (default-directory dir))
+     (unwind-protect
+         (progn
+           (vc-git-create-repo)
+           (vc-git-command nil 0 nil "config" "--add" "user.name" "frou")
+           (vc-git-command nil 0 nil "config" "--add" "user.email" "frou@HIDDEN")
+           ,@body)
+       (delete-directory dir t))))
+
+(ert-deftest project-implicit-project-absorption ()
+  "Running a project command should register the project without further ado."
+  (skip-unless (executable-find vc-git-program))
+  (project-tests--mock-repo
+    (with-temp-file "foo")
+    (condition-case err
+        (progn
+          (vc-git-register (split-string "foo"))
+          (vc-git-checkin (split-string "foo") "No-Verify: yes
+his fooness")
+          (vc-git-checkout nil (vc-git--rev-parse "HEAD")))
+      (error (signal (car err) (with-current-buffer "*vc*" (buffer-string)))))
+    (cl-letf (((symbol-function 'read-buffer)
+               (lambda (&rest _args)
+                 (current-buffer))))
+      (switch-to-buffer (find-file-noselect "foo"))
+      (should-not (cl-some (lambda (project)
+                             (equal default-directory (car project)))
+                           project--list))
+      (call-interactively #'project-switch-to-buffer)
+      (should (cl-some (lambda (project)
+                         (equal default-directory (car project)))
+                       project--list)))))
+
 (defvar project-tests--this-file (or (bound-and-true-p byte-compile-current-file)
                                      (and load-in-progress load-file-name)
                                      buffer-file-name))
@@ -136,7 +233,7 @@ project-vc-extra-root-markers-supports-wildcards
          (_ (vc-file-clearprops dir))
          (project-vc-extra-root-markers '("files-x-tests.*"))
          (project (project-current nil dir)))
-    (should-not (null project))
+    (should project)
     (should (string-match-p "/test/lisp/\\'" (project-root project)))))
 
 (ert-deftest project-vc-supports-project-in-different-dir ()
-- 
2.38.1

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: dick <dick.r.chiang@HIDDEN>
Subject: bug#61861: Acknowledgement (30.0.50; [PATCH] Catch project.el to
 projectile's dwim behaviors)
Message-ID: <handler.61861.B.167756221532558.ack <at> debbugs.gnu.org>
References: <87v8jmfusl.fsf@dick>
X-Gnu-PR-Message: ack 61861
X-Gnu-PR-Package: emacs
X-Gnu-PR-Keywords: patch
Reply-To: 61861 <at> debbugs.gnu.org
Date: Tue, 28 Feb 2023 05:31:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

Your message has been sent to the package maintainer(s):
 bug-gnu-emacs@HIDDEN

If you wish to submit further information on this problem, please
send it to 61861 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
61861: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D61861
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to bug-gnu-emacs@HIDDEN:

Subject: bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors
Resent-From: Dmitry Gutov <dgutov@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@HIDDEN
Resent-Date: Tue, 28 Feb 2023 16:22:02 +0000
Resent-Message-ID: <handler.61861.B61861.167760126218390 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: dick <dick.r.chiang@HIDDEN>, 61861 <at> debbugs.gnu.org
Message-ID: <a44df703-9c72-f0c1-b006-db08c30fa696@HIDDEN>
Date: Tue, 28 Feb 2023 18:20:49 +0200
MIME-Version: 1.0
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101
 Thunderbird/102.7.1
Content-Language: en-US
References: <87v8jmfusl.fsf@dick>
From: Dmitry Gutov <dgutov@HIDDEN>
In-Reply-To: <87v8jmfusl.fsf@dick>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

On 28/02/2023 03:22, dick wrote:
> * lisp/progmodes/project.el (project-get-project, project-current):
> Rationalize interfaces.
> (project--files-in-directory): Whitespace.
> (project-try-vc): Avoid swallowing errors.
> (project-files): De-obfuscate.
> (project--vc-list-files): Whitespace.
> (project-find-regexp, project-or-external-find-regexp, project-find-file,
> project-or-external-find-file, project-find-dir, project-dired,
> project-vc-dir, project-eshell, project-shell, project-async-shell-command,
> project-shell-command, project-search, project-query-replace-regexp,
> project-compile, project--read-project-buffer, project-list-buffers,
> project-kill-buffers, project-switch-project): DWIM.
> (project--read-file-cpd-relative): De-obfuscate.
> (project-find-file-in): Whitespace.
> (project-most-recent-project): New DWIM function.
> (project-remember-project, project-prompt-project-dir): De-obfuscate.
> (project-execute-extended-command): Rationalize interfaces.
> (project-remember-projects-under): Avoid backslashes.
> * lisp/progmodes/xref.el (xref-matches-in-files): Do expand-file-name here.
> * test/lisp/progmodes/project-tests.el (project-switch-project-extant-buffer,
> project-implicit-project-absorption, project-assume-mru-project): Test.
> (project-vc-extra-root-markers-supports-wildcards): Dude.

First of all, lots of changes without rationalization, that's not 
actionable.

Second: projectile defaults to mru project when it can't find one?

Message received at control <at> debbugs.gnu.org:

Received: (at control) by debbugs.gnu.org; 4 Sep 2023 08:54:01 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Sep 04 04:54:01 2023
Received: from localhost ([127.0.0.1]:48530 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1qd5LN-00036E-8E
	for submit <at> debbugs.gnu.org; Mon, 04 Sep 2023 04:54:01 -0400
Received: from mail-lf1-x12f.google.com ([2a00:1450:4864:20::12f]:54304)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <stefankangas@HIDDEN>) id 1qd5LL-00035z-Qo
 for control <at> debbugs.gnu.org; Mon, 04 Sep 2023 04:54:00 -0400
Received: by mail-lf1-x12f.google.com with SMTP id
 2adb3069b0e04-5009d4a4897so1976080e87.0
 for <control <at> debbugs.gnu.org>; Mon, 04 Sep 2023 01:53:59 -0700 (PDT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=gmail.com; s=20221208; t=1693817634; x=1694422434; darn=debbugs.gnu.org;
 h=to:subject:message-id:date:mime-version:from:from:to:cc:subject
 :date:message-id:reply-to;
 bh=L8COkKw1LEt0XwUuQNVRTlZ2duEf/U8koUxM+J7w60c=;
 b=Zo+Y8Ho2UfQEVgpNMEkbyubImzNl4WgYULSEkBD1ApHD1Jr4LWSK35DC8qGZGAz9V5
 ntMa/gHi1CdwxbvY373h53QEIUHeek4fjhMvcxSi6TzhDxJTyDPep63oYYrGC6RFRPTd
 yXPDszslWujTJvV27Bsf4RrilXzUKaG3HY36GwUhIyBqKpdEGvKFTeFp1IntXPv/M3X+
 +li2ynKy4kqFp+spIRNAeYaJE0v94AvZtwoPURtKDFdVccG0ak+QmjklWNlacqaDly1q
 RU1whtLo+rOXcdvpaZQVLTlO7riBtgZSjbWFBUERTF4s0G70z3q4HNol2x4WXKnCzms5
 6E+w==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20221208; t=1693817634; x=1694422434;
 h=to:subject:message-id:date:mime-version:from:x-gm-message-state
 :from:to:cc:subject:date:message-id:reply-to;
 bh=L8COkKw1LEt0XwUuQNVRTlZ2duEf/U8koUxM+J7w60c=;
 b=eW8PifeiMfHWoSxPUm5iXded9znoPRXrTpWRtXDXSf0A61cKKUsTBEC0g8x2HBcQJy
 IItxcb4wq9GrKAWvJmBEJdtOAmHXFpwwty+dTmq3oMuqRqfR4FNVVgXoB1lSSFj1aW3T
 0fZOX1UlJZr0qtTWM3uSBEnwRTOBFoOhJZRIm/UafUS2HHvbfcqbJ3J1bBZR2d4B7wyT
 LrrdetKoCPRXsteG74x6MDzZRSg7s11K6clDZ+rdmu9muyjjUuzGH/qJA8iPQc2NYBKJ
 jsBJQKxMpRuq2wDwZDym47DSTm7ijG1Vyi3dwI21mNnQjmJ6Ikrxe+uPotzDfvrL4M7L
 +XXg==
X-Gm-Message-State: AOJu0YxrjZGgx7u8Nnqd14yd+mrttaMnQcapFQF7vWtkN8AVqbD8Jbux
 TgDAYNS7eCXilDlAEKEizWxOEucJtzELvA2V0RZRqFt4VWw=
X-Google-Smtp-Source: AGHT+IF5UQlGQBNpcUU1OUmi1VKz/c6jk1Z2iaplIiX+Btgiz97Rw/cx+um4kuKY5Zk0uck0szzzSwU1ahheImxMOCM=
X-Received: by 2002:a05:6512:b8e:b0:500:9b7d:ee22 with SMTP id
 b14-20020a0565120b8e00b005009b7dee22mr7437078lfv.60.1693817634164; Mon, 04
 Sep 2023 01:53:54 -0700 (PDT)
Received: from 753933720722 named unknown by gmailapi.google.com with
 HTTPREST; Mon, 4 Sep 2023 01:53:53 -0700
From: Stefan Kangas <stefankangas@HIDDEN>
MIME-Version: 1.0
Date: Mon, 4 Sep 2023 01:53:53 -0700
Message-ID: <CADwFkmkpN-=KfSi=5QOmkzUxZhQ5Hxb=8L+NMBjzWji5=8=owA@HIDDEN>
Subject: control message for bug #61861
To: control <at> debbugs.gnu.org
Content-Type: text/plain; charset="UTF-8"
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: control
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

severity 61861 wishlist
quit

Last modified: Mon, 4 Sep 2023 09:00:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.