* bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors
@ 2023-02-28 1:22 dick
2023-02-28 16:20 ` Dmitry Gutov
0 siblings, 1 reply; 2+ messages in thread
From: dick @ 2023-02-28 1:22 UTC (permalink / raw)
To: 61861
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: 0001-Catch-project.el-up-to-projectile-s-dwim-behaviors.patch --]
[-- Type: text/x-diff, Size: 36289 bytes --]
From 4f1ab3ca1db5e2aa2fb71599918f6d1c32ebf95e Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@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@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
^ permalink raw reply related [flat|nested] 2+ messages in thread* bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors
2023-02-28 1:22 bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors dick
@ 2023-02-28 16:20 ` Dmitry Gutov
0 siblings, 0 replies; 2+ messages in thread
From: Dmitry Gutov @ 2023-02-28 16:20 UTC (permalink / raw)
To: dick, 61861
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?
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-02-28 16:20 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-02-28 1:22 bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors dick
2023-02-28 16:20 ` Dmitry Gutov
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.