Package: emacs;
Reported by: dick <dick.r.chiang <at> gmail.com>
Date: Tue, 28 Feb 2023 05:31:02 UTC
Severity: wishlist
Tags: patch
Found in version 30.0.50
To reply to this bug, email your comments to 61861 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
bug-gnu-emacs <at> gnu.org:bug#61861; Package emacs.
(Tue, 28 Feb 2023 05:31:02 GMT) Full text and rfc822 format available.dick <dick.r.chiang <at> gmail.com>:bug-gnu-emacs <at> gnu.org.
(Tue, 28 Feb 2023 05:31:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: dick <dick.r.chiang <at> gmail.com> To: bug-gnu-emacs <bug-gnu-emacs <at> gnu.org> Subject: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors Date: Mon, 27 Feb 2023 20:22:34 -0500
[0001-Catch-project.el-up-to-projectile-s-dwim-behaviors.patch (text/x-diff, inline)]
From 4f1ab3ca1db5e2aa2fb71599918f6d1c32ebf95e Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang <at> gmail.com>
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 <at> frou.org")
+ ,@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
bug-gnu-emacs <at> gnu.org:bug#61861; Package emacs.
(Tue, 28 Feb 2023 16:22:02 GMT) Full text and rfc822 format available.Message #8 received at 61861 <at> debbugs.gnu.org (full text, mbox):
From: Dmitry Gutov <dgutov <at> yandex.ru> To: dick <dick.r.chiang <at> gmail.com>, 61861 <at> debbugs.gnu.org Subject: Re: bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors Date: Tue, 28 Feb 2023 18:20:49 +0200
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?
Stefan Kangas <stefankangas <at> gmail.com>
to control <at> debbugs.gnu.org.
(Mon, 04 Sep 2023 08:54:03 GMT) Full text and rfc822 format available.bug-gnu-emacs <at> gnu.org:bug#61861; Package emacs.
(Wed, 12 Feb 2025 04:40:02 GMT) Full text and rfc822 format available.Message #13 received at 61861 <at> debbugs.gnu.org (full text, mbox):
From: Stefan Kangas <stefankangas <at> gmail.com> To: Dmitry Gutov <dgutov <at> yandex.ru> Cc: 61861 <at> debbugs.gnu.org, dick <dick.r.chiang <at> gmail.com> Subject: Re: bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors Date: Tue, 11 Feb 2025 20:39:27 -0800
Dmitry Gutov <dgutov <at> yandex.ru> writes: > 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. dick, could you please resend these patches in smaller chunks with a rationale? > Second: projectile defaults to mru project when it can't find one?
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.