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: Fri, 22 Sep 2023 18:52:09 +0300 Organization: LINKOV.NET Message-ID: <86y1gynr2u.fsf@mail.linkov.net> References: <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> <86edj6hyem.fsf@mail.linkov.net> <8634zitwoy.fsf@mail.linkov.net> <50d46d30-a796-b855-0d4c-690d6cb3d15b@gutov.dev> <86il88x9cy.fsf@mail.linkov.net> <4367c45c-95b3-6a29-4ba3-068a3c748452@gutov.dev> <2e34e515-a921-a969-0915-bea94c745f8b@gutov.dev> <868r9258oi.fsf@mail.linkov.net> <86edishisp.fsf@mail.linkov.net> <6fc81cbf-a21f-c5b4-aa56-e8518b8570d7@gutov.dev> <86msxgatuy.fsf@mail.linkov.net> 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="24070"; 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 Fri Sep 22 18:06:42 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 1qjify-00067V-1B for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 22 Sep 2023 18:06:42 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qjidP-0005wl-G8; Fri, 22 Sep 2023 12:04:04 -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 1qjidE-0005j5-Fd for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 12:03:52 -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 1qjidE-000703-6R for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 12:03:52 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qjidO-0005IH-6S for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 12:04: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: Fri, 22 Sep 2023 16:04: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.169539859720275 (code B ref 63648); Fri, 22 Sep 2023 16:04:02 +0000 Original-Received: (at 63648) by debbugs.gnu.org; 22 Sep 2023 16:03:17 +0000 Original-Received: from localhost ([127.0.0.1]:37167 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qjice-0005Gq-P4 for submit@debbugs.gnu.org; Fri, 22 Sep 2023 12:03:17 -0400 Original-Received: from relay7-d.mail.gandi.net ([2001:4b98:dc4:8::227]:57369) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qjicb-0005GG-L2 for 63648@debbugs.gnu.org; Fri, 22 Sep 2023 12:03:14 -0400 Original-Received: by mail.gandi.net (Postfix) with ESMTPSA id 0ADE820003; Fri, 22 Sep 2023 16:02:53 +0000 (UTC) In-Reply-To: <86msxgatuy.fsf@mail.linkov.net> (Juri Linkov's message of "Thu, 21 Sep 2023 09:58:57 +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:271116 Archived-At: --=-=-= Content-Type: text/plain >> Probably. Would you like to propose one? So that I have something to >> compare to, and have something specific to put to the vote as well. > > Ok, something like this: Here is a more tested patch. It supports these cases: (setq project-switch-use-entire-map t) C-x p p C-b - should not include current buffer in the list of another project (bug#58784) C-x p p f M-n - should fetch the right default file name (bug#58784, bug#63829) C-u C-x p p f emoji TAB - should include ignored emoji-labels.el (bug#63648) C-x p p C-x d - should visit another project's root (bug#63648) The same with frames: C-x 5 p p C-b C-x 5 p p f M-n C-u C-x 5 p p f emoji TAB - should not show completions in another frame (bug#65558) C-x 5 p p C-x d --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=project-default-directory.patch diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 2e6ae89a443..9faacbe3512 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -197,6 +197,14 @@ 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.") +(defvar-local project-default-directory 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 +240,8 @@ project-current (let ((pr (project--find-in-directory directory))) (cond (pr) - ((unless project-current-directory-override + ((unless (or project-current-directory-override + project-default-directory) maybe-prompt) (setq directory (funcall project-prompter) pr (project--find-in-directory directory)))) @@ -397,8 +406,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-default-directory buf) + (buffer-local-value 'default-directory buf)))) (push buf bufs))) (nreverse bufs))) @@ -813,7 +824,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-default-directory 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 +855,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 +904,18 @@ 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) + (prefix-command-preserve-state) + (let ((inhibit-message t)) (other-window-prefix)) + (message "Display next project command buffer in a new window...") + ;; Should return exitfun from set-transient-map + (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 +927,15 @@ 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) + (prefix-command-preserve-state) + (let ((inhibit-message t)) (other-frame-prefix)) + (message "Display next project command buffer in a new frame...") + ;; Should return exitfun from set-transient-map + (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 +947,13 @@ 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))) + (prefix-command-preserve-state) + (let ((inhibit-message t)) (other-tab-prefix)) + (message "Display next project command buffer in a new tab...") + ;; Should return exitfun from set-transient-map + (set-transient-map project-prefix-map))) ;;;###autoload (when (bound-and-true-p tab-prefix-map) @@ -1000,14 +1036,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-default-directory' 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-default-directory + (project-current nil project-default-directory)))) ;; file-name-concat requires Emacs 28+ (concat (file-name-as-directory (project-root project)) (file-relative-name filename (project-root filename-proj))) @@ -1993,6 +2031,60 @@ 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-default-directory 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-default-directory + (setq-local default-directory project-default-directory) + (kill-local-variable 'project-default-directory)))))))) + (add-hook 'post-command-hook postfun) + (add-hook 'prefix-command-echo-keystrokes-functions echofun) + (setq-local project-default-directory default-directory) + (setq-local default-directory dir) + (message (concat (project--keymap-prompt) " or any global key.")) + (let ((map (make-sparse-keymap))) + (if project-switch-use-entire-map + (set-keymap-parent map project-prefix-map) + (dolist (row project-switch-commands map) + (when-let* ((cmd (nth 0 row)) + (key (if (nth 2 row) + (vector (nth 2 row)) + (where-is-internal + cmd (list project-prefix-map) t)))) + (define-key map key cmd)))) + (define-key map (vector help-char) + (lambda () + (interactive) + (let ((help-form "\ +You can use any global keybinding.")) + (help-form-show)))) + ;; Should return exitfun from set-transient-map + (set-transient-map map))))) + ;;;###autoload (defun project-uniquify-dirname-transform (dirname) "Uniquify name of directory DIRNAME using `project-name', if in a project. --=-=-=--