Stefan Kangas <stefankangas@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.Received: (at 61861) by debbugs.gnu.org; 28 Feb 2023 16:21:02 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Tue Feb 28 11:21:01 2023 Received: from localhost ([127.0.0.1]:51868 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1pX2ir-0004mM-HP for submit <at> debbugs.gnu.org; Tue, 28 Feb 2023 11:21:01 -0500 Received: from mail-ed1-f49.google.com ([209.85.208.49]:39920) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <raaahh@HIDDEN>) id 1pX2ip-0004m7-A3 for 61861 <at> debbugs.gnu.org; Tue, 28 Feb 2023 11:20:59 -0500 Received: by mail-ed1-f49.google.com with SMTP id f13so42309276edz.6 for <61861 <at> debbugs.gnu.org>; Tue, 28 Feb 2023 08:20:59 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=content-transfer-encoding:in-reply-to:from:references:to :content-language:subject:user-agent:mime-version:date:message-id :sender:from:to:cc:subject:date:message-id:reply-to; bh=Ix9pOSaTs++Q4/PG0DU4wf6HqEnufB0K7LZuj0tsBa8=; b=aV/RFfOfKc8c9Pzux5EnnLFLLYMg8YGuhn7jWxyDinPIe4oTViMqqolotVfy677amf PGz8czAYuqXOGp2zrwny4TZd/JD8OGQAhzJidULjwgcIFNc0P+0zDyqXj/2UbdkIP21N HQT7zFsQD9A7SiGWBdXcEVvk1v9//OHM+AuEHDf3UC6eyGCsfxTPFYEUM9dOsucN6d2X CuiEs7LvbmgIEoYqw0pj/nAWSegXNVEMD/IY4gkefnwg10f9AniLqF5JOw0ji1fBoVvq d3wLMTXCUXeMfQyP2yfO0GmTVNcBl9NJ2FNSJVGDFXjqcBs07NxhSAl0AZovEwXdnWvv Rz4Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:in-reply-to:from:references:to :content-language:subject:user-agent:mime-version:date:message-id :sender:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=Ix9pOSaTs++Q4/PG0DU4wf6HqEnufB0K7LZuj0tsBa8=; b=TNbcS0z/2YxTKh7eRkXqACsa8wPL92A10OJ/2V1jC3rcBbrpvnvBNh7m3Yo7oZd5u1 B28Fv75hHjoYXsh4IfL8fHNqLY6MtE5HgyrwSeMq8Jd5E3of/cPgPvvo6K5EVr44HfNX pkdyWfj8QB02ypik0R3FfO1lRFRN6wLKxAVBNFs+cjfNjlJOYfSyfIqbl2hFpoCiEExl Rrr+5WoJIE04NRFg9UXBLq64rf2GQZDiQ2oRkql9/94NfHe3C9CQYJxoT+Vs9nsl6kuS FDVt3wbFlYXZgHvmpBg2iRvFmPvXYMcrYdAfn3FCRy4mota0CQELT3Jeamn++Z/dVZY2 fZvQ== X-Gm-Message-State: AO0yUKUJW01aDoX9k/p1Q3uB1B9SSaxSYh5RP+tWeP4bZodAaCmPvG5V 6B7fg1Bhef3P4vJ2jcPXoXQ= X-Google-Smtp-Source: AK7set+EE/+IZNU0zaN/3FG4xY8Rvcf49HcX/l1gM4lhMzzSSOrEeWUvF31i5cw7YqdfJp87TN+QuA== X-Received: by 2002:a17:907:771a:b0:8b1:7fe9:ac69 with SMTP id kw26-20020a170907771a00b008b17fe9ac69mr3440604ejc.75.1677601252576; Tue, 28 Feb 2023 08:20:52 -0800 (PST) Received: from [192.168.0.2] ([46.251.119.176]) by smtp.googlemail.com with ESMTPSA id m9-20020a1709060d8900b008ec4333fd65sm4690521eji.188.2023.02.28.08.20.51 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Tue, 28 Feb 2023 08:20:52 -0800 (PST) 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 Subject: Re: bug#61861: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors Content-Language: en-US To: dick <dick.r.chiang@HIDDEN>, 61861 <at> debbugs.gnu.org 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 X-Spam-Score: -0.9 (/) X-Debbugs-Envelope-To: 61861 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.9 (-) 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?
bug-gnu-emacs@HIDDEN:bug#61861; Package emacs.
Full text available.
Received: (at submit) by debbugs.gnu.org; 28 Feb 2023 05:30:15 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Feb 28 00:30:15 2023
Received: from localhost ([127.0.0.1]:49479 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1pWsZ2-0008T1-4X
for submit <at> debbugs.gnu.org; Tue, 28 Feb 2023 00:30:15 -0500
Received: from lists.gnu.org ([209.51.188.17]:33840)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <dick.r.chiang@HIDDEN>) id 1pWohV-0007uh-Du
for submit <at> debbugs.gnu.org; Mon, 27 Feb 2023 20:22:43 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <dick.r.chiang@HIDDEN>)
id 1pWohV-0007Ob-80
for bug-gnu-emacs@HIDDEN; Mon, 27 Feb 2023 20:22:41 -0500
Received: from mail-qt1-x82b.google.com ([2607:f8b0:4864:20::82b])
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
(Exim 4.90_1) (envelope-from <dick.r.chiang@HIDDEN>)
id 1pWohR-0001Wl-UU
for bug-gnu-emacs@HIDDEN; Mon, 27 Feb 2023 20:22:40 -0500
Received: by mail-qt1-x82b.google.com with SMTP id z6so9032558qtv.0
for <bug-gnu-emacs@HIDDEN>; Mon, 27 Feb 2023 17:22:36 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=gmail.com; s=20210112; t=1677547356;
h=content-disposition:mime-version:message-id:date:subject:to:from
:from:to:cc:subject:date:message-id:reply-to;
bh=SglkcLDBTTEfjZmkyvth357TYJPIASvWDbz6bZ08ieo=;
b=PxbQCPAHU4R3VgUVSeEaQSCtwVWYLxrwD+xDq/Ugd5u63IhyfdK1xe02HtgshHOWyo
gtbVpjxyVWXh8UdsiYxeuRX2LTCEduumgVjgOJ3eaoOI83V+7Ld62HTLuwrXoPHRJyZB
7cQCoPbSiXjCWJohNfwuWuqK0hYA56qsfhjfdCbW68sMk0+HJ1EaLo1/cENXFumP1wR5
vBHDGBL2fRw+qH+22TAPIyufr14IC2K0NvsMCJN2DgtO6ZeobhiQEr0AlnXCTWC+xgft
uFFjLqsO2a9YSCphOSnZo+LtrTMSUjfTbjxvv2BGJZAjYshibGAkfAo8nbAnOyMsmZ97
GtEA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20210112; t=1677547356;
h=content-disposition:mime-version:message-id:date:subject:to:from
:x-gm-message-state:from:to:cc:subject:date:message-id:reply-to;
bh=SglkcLDBTTEfjZmkyvth357TYJPIASvWDbz6bZ08ieo=;
b=IbOdmgHAtAjusOZio0V4TUbeLExZ7pZSsuPveFdSVIsMS5xGAWnFP1pT8FfGmZRpgl
GpL46QzYm8njZLf9SqeZNVYn8hHqLLR3U9B+rQ+paveRMttpXchLnsCyhaw9aqsgWQrh
cE6tgTQURr8Fw7MxOU3PJXXTgdYSUwg8/A94kbApkIE1sDlinMyBI3vbYrg3sYuXXDie
wVqZ9EjDMF5irTNjSHsyd4VtbVVXCKsBQ6ELBmQ9ofJsWhATWEDrBgUJEt/I9FEDV45C
Jb4CvvoKdTJIXHN/0j2+emeCgRs6XPXoV1H5x1WMRPl13FmaTESDOh89+Z9GWpErxnlJ
1iwA==
X-Gm-Message-State: AO0yUKWgLHmH6Z5xfjtBe6fMPoAx/pJ6Q1fwKXr7bQHfpNuYLCphodNv
tg6HgWfFmvYjnZAJWCb0w2dgzFX2+0I=
X-Google-Smtp-Source: AK7set+seab0+MUnsYvx4LmL1DR2ZSuQdtX+OLiKwy9ZzBlHO2DOiC4EpUipG72vE8en4HwgJzjejw==
X-Received: by 2002:a05:622a:110f:b0:3b4:79f8:26c3 with SMTP id
e15-20020a05622a110f00b003b479f826c3mr2274790qty.33.1677547355705;
Mon, 27 Feb 2023 17:22:35 -0800 (PST)
Received: from localhost (pool-71-190-212-243.nycmny.fios.verizon.net.
[71.190.212.243]) by smtp.gmail.com with ESMTPSA id
u2-20020ac83d42000000b003bfc0cca1b7sm5636460qtf.49.2023.02.27.17.22.35
for <bug-gnu-emacs@HIDDEN>
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Mon, 27 Feb 2023 17:22:35 -0800 (PST)
From: dick <dick.r.chiang@HIDDEN>
To: bug-gnu-emacs <bug-gnu-emacs@HIDDEN>
Subject: 30.0.50; [PATCH] Catch project.el to projectile's dwim behaviors
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-Debbugs-Envelope-To: submit
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
dick <dick.r.chiang@HIDDEN>:bug-gnu-emacs@HIDDEN.
Full text available.bug-gnu-emacs@HIDDEN:bug#61861; Package emacs.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.