From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#63648: 29.0.90; project.el: with switch-use-entire-map, switch-project errors on non-project commands Date: Sun, 10 Sep 2023 18:30:09 +0300 Organization: LINKOV.NET Message-ID: <86edj6hyem.fsf@mail.linkov.net> References: <86jzwyxnxb.fsf@mail.linkov.net> <86o7m91z22.fsf@mail.linkov.net> <86pm6py6k4.fsf@mail.linkov.net> <86bki9y68h.fsf@mail.linkov.net> <86cz2f7bvo.fsf@mail.linkov.net> <86353axu48.fsf@mail.linkov.net> <87o7jfi00b.fsf@catern.com> <86msyhwrrg.fsf@mail.linkov.net> <86y1hs4kkg.fsf@mail.linkov.net> <86h6of66o3.fsf@mail.linkov.net> <86wmxb2qvh.fsf@mail.linkov.net> <8634zyjt0k.fsf@mail.linkov.net> <8d1fb7ac-5c82-0ec2-8ae2-d09c131ec165@gutov.dev> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="27687"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/30.0.50 (x86_64-pc-linux-gnu) Cc: Spencer Baugh , 63648@debbugs.gnu.org, sbaugh@catern.com To: Dmitry Gutov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Sep 10 17:34:22 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qfMS6-00070w-0P for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 10 Sep 2023 17:34:22 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qfMRm-0006UK-0X; Sun, 10 Sep 2023 11:34:02 -0400 Original-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 ) id 1qfMRj-0006U0-BR for bug-gnu-emacs@gnu.org; Sun, 10 Sep 2023 11:33:59 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qfMRj-0004Lj-25 for bug-gnu-emacs@gnu.org; Sun, 10 Sep 2023 11:33:59 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qfMRm-0007Gx-3W for bug-gnu-emacs@gnu.org; Sun, 10 Sep 2023 11:34:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 10 Sep 2023 15:34:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63648 X-GNU-PR-Package: emacs Original-Received: via spool by 63648-submit@debbugs.gnu.org id=B63648.169435998627889 (code B ref 63648); Sun, 10 Sep 2023 15:34:02 +0000 Original-Received: (at 63648) by debbugs.gnu.org; 10 Sep 2023 15:33:06 +0000 Original-Received: from localhost ([127.0.0.1]:51102 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qfMQr-0007Fk-HJ for submit@debbugs.gnu.org; Sun, 10 Sep 2023 11:33:06 -0400 Original-Received: from relay4-d.mail.gandi.net ([217.70.183.196]:44853) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qfMQp-0007FE-0l for 63648@debbugs.gnu.org; Sun, 10 Sep 2023 11:33:04 -0400 Original-Received: by mail.gandi.net (Postfix) with ESMTPSA id 8A3ABE0005; Sun, 10 Sep 2023 15:32:50 +0000 (UTC) In-Reply-To: <8d1fb7ac-5c82-0ec2-8ae2-d09c131ec165@gutov.dev> (Dmitry Gutov's message of "Fri, 1 Sep 2023 12:53:02 +0300") X-GND-Sasl: juri@linkov.net X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:269972 Archived-At: --=-=-= Content-Type: text/plain >>>> This could be fixed by adding special-handling of the default-directory >>>> for the current buffer in 'project-buffers'. >>> What kind of special handling? The "real" buffer-local value is hidden >>> until the "let" exists, the global value is nil, and if the buffer is not >>> a file-visiting one, there is no other file name to test against. >> Additional buffer-local variable like 'buffer-default-directory' could help. >> Or additional global variable 'global-default-directory'. Or even >> using the global value of the existing variable 'default-directory'. > > What code would use it instead of the local value of default-directory? > Only project-related code? Or other code as well? If it's the former, we > have an existing variable in the project package. If the latter, we'd need > some formal description of those usage rules to proceed. The former. So given all the considered constraints we have to admit there is a possibility that some rare non-project command that checks default-directory in all buffers might get a wrong value for one buffer when it's called immediately after 'C-x p p'. OTOH, such a reasonable compromise can help us fix other bugs such as bug#65558. So here is a complete tested patch that maintains backward-compatibility with older versions, and is localized to project.el without the need to discuss more fundamental changes on emacs-devel, and handles 100% of known cases such as reported in bug#58784, bug#63829, etc. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=other-project-prefix.patch diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2e6ae89a443..257c0da4264 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -197,6 +197,19 @@ project-current-directory-override "Value to use instead of `default-directory' when detecting the project. When it is non-nil, `project-current' will always skip prompting too.") +(make-obsolete-variable + 'project-current-directory-override + 'project-current-directory-old + "30.1") + +(defvar-local project-current-directory-old nil + "Value to use instead of `default-directory' when detecting the project. +For the next command after switching the project, this buffer-local +variable contains the original value of `default-directory'. +Whereas the buffer-local `default-directory' is temporarily set +to the root directory of the switched project. +When it is non-nil, `project-current' will always skip prompting too.") + (defcustom project-prompter #'project-prompt-project-dir "Function to call to prompt for a project. Called with no arguments and should return a project root dir." @@ -232,7 +245,8 @@ project-current (let ((pr (project--find-in-directory directory))) (cond (pr) - ((unless project-current-directory-override + ((unless (or project-current-directory-override + project-current-directory-old) maybe-prompt) (setq directory (funcall project-prompter) pr (project--find-in-directory directory)))) @@ -397,8 +411,10 @@ project-buffers (let ((root (expand-file-name (file-name-as-directory (project-root project)))) bufs) (dolist (buf (buffer-list)) - (when (string-prefix-p root (expand-file-name - (buffer-local-value 'default-directory buf))) + (when (string-prefix-p + root (expand-file-name + (or (buffer-local-value 'project-current-directory-old buf) + (buffer-local-value 'default-directory buf)))) (push buf bufs))) (nreverse bufs))) @@ -813,7 +829,9 @@ project-buffers dd bufs) (dolist (buf (buffer-list)) - (setq dd (expand-file-name (buffer-local-value 'default-directory buf))) + (setq dd (expand-file-name + (or (buffer-local-value 'project-current-directory-old buf) + (buffer-local-value 'default-directory buf)))) (when (and (string-prefix-p root dd) (not (cl-find-if (lambda (module) (string-prefix-p module dd)) modules))) @@ -842,7 +860,9 @@ project-prefix-map (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) - (define-key map "p" 'project-switch-project) + (define-key map "p" (if (< emacs-major-version 30) + 'project-switch-project + 'other-project-prefix)) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) @@ -889,10 +909,16 @@ project-other-window-command \\{project-prefix-map} \\{project-other-window-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-window) - (inhibit-same-window . t)) - project-other-window-map)) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-pop-up-window) + (inhibit-same-window . t)) + project-other-window-map) + (let ((inhibit-message t)) (other-window-prefix)) + (message "Display next project command buffer in a new window...") + (set-transient-map (make-composed-keymap project-prefix-map + project-other-window-map)))) +;; TODO: maybe rename to project-other-window-prefix ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command) ;;;###autoload @@ -904,8 +930,13 @@ project-other-frame-command \\{project-prefix-map} \\{project-other-frame-map}" (interactive) - (project--other-place-command '((display-buffer-pop-up-frame)) - project-other-frame-map)) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-pop-up-frame)) + project-other-frame-map) + (let ((inhibit-message t)) (other-frame-prefix)) + (message "Display next project command buffer in a new frame...") + (set-transient-map (make-composed-keymap project-prefix-map + project-other-frame-map)))) ;;;###autoload (define-key ctl-x-5-map "p" #'project-other-frame-command) @@ -917,7 +948,11 @@ project-other-tab-command \\{project-prefix-map}" (interactive) - (project--other-place-command '((display-buffer-in-new-tab)))) + (if (< emacs-major-version 30) + (project--other-place-command '((display-buffer-in-new-tab))) + (let ((inhibit-message t)) (other-tab-prefix)) + (message "Display next project command buffer in a new tab...") + (set-transient-map project-prefix-map))) ;;;###autoload (when (bound-and-true-p tab-prefix-map) @@ -1000,14 +1035,16 @@ project--find-default-from "Ensure FILENAME is in PROJECT. Usually, just return FILENAME. But if -`project-current-directory-override' is set, adjust it to be +`project-current-directory-old' is set, adjust it to be relative to PROJECT instead. This supports using a relative file name from the current buffer when switching projects with `project-switch-project' and then using a command like `project-find-file'." - (if-let (filename-proj (and project-current-directory-override - (project-current nil default-directory))) + (if-let (filename-proj (or (and project-current-directory-override + (project-current nil default-directory)) + (and project-current-directory-old + (project-current nil project-current-directory-old)))) ;; file-name-concat requires Emacs 28+ (concat (file-name-as-directory (project-root project)) (file-relative-name filename (project-root filename-proj))) @@ -1993,6 +2030,50 @@ project-switch-project (let ((project-current-directory-override dir)) (call-interactively command)))) +;;;###autoload +(defun other-project-prefix (dir) + "\"Switch\" to another project before 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 (funcall project-prompter))) + (if (symbolp project-switch-commands) + (let* ((project-current-directory-old default-directory) + (default-directory dir)) + (call-interactively project-switch-commands)) + (prefix-command-preserve-state) + (letrec ((minibuffer-depth (minibuffer-depth)) + (command this-command) + (old-buffer (current-buffer)) + (echofun (lambda () "[switch-project]")) + (postfun + (lambda () + (unless (or (eq this-command command) + (> (minibuffer-depth) minibuffer-depth)) + (remove-hook 'post-command-hook postfun) + (remove-hook 'prefix-command-echo-keystrokes-functions + echofun) + (when (buffer-live-p old-buffer) + (with-current-buffer old-buffer + (when project-current-directory-old + (setq-local default-directory project-current-directory-old) + (kill-local-variable 'project-current-directory-old)))))))) + (add-hook 'post-command-hook postfun) + (add-hook 'prefix-command-echo-keystrokes-functions echofun) + (setq-local project-current-directory-old default-directory) + (setq-local default-directory dir) + (message (project--keymap-prompt)) + (let ((commands-map + (let ((temp-map (make-sparse-keymap))) + (set-keymap-parent temp-map project-prefix-map) + (dolist (row project-switch-commands temp-map) + (when-let ((cmd (nth 0 row)) + (keychar (nth 2 row))) + (define-key temp-map (vector keychar) cmd)))))) + (set-transient-map commands-map))))) + ;;;###autoload (defun project-uniquify-dirname-transform (dirname) "Uniquify name of directory DIRNAME using `project-name', if in a project. diff --git a/lisp/window.el b/lisp/window.el index b9b032c33e9..b67b3dced9c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -9122,7 +9114,8 @@ display-buffer-override-next-command (> (minibuffer-depth) minibuffer-depth) ;; But don't remove immediately after ;; adding the hook by the same command below. - (eq this-command command)) + (eq this-command command) + (eq this-command 'other-project-prefix)) (funcall exitfun)))) ;; Call post-function after the next command finishes (bug#49057). (add-hook 'post-command-hook postfun) --=-=-=--