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: Wed, 30 Aug 2023 19:27:27 +0300 Organization: LINKOV.NET Message-ID: <86y1hs4kkg.fsf@mail.linkov.net> References: <86wn10e1wl.fsf@mail.linkov.net> <482a1ebc-165c-a0a4-98c0-5c404d1b1d0d@gutov.dev> <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> 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="3571"; 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 Wed Aug 30 18:41:45 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 1qbOGG-0000mt-NN for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 30 Aug 2023 18:41:44 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qbOFV-0002Sa-QT; Wed, 30 Aug 2023 12:40:57 -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 1qbOFU-0002S6-0O for bug-gnu-emacs@gnu.org; Wed, 30 Aug 2023 12:40:56 -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 1qbOFT-0001f4-On for bug-gnu-emacs@gnu.org; Wed, 30 Aug 2023 12:40:55 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qbOFb-0007Vg-Bw for bug-gnu-emacs@gnu.org; Wed, 30 Aug 2023 12:41:03 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 30 Aug 2023 16:41:03 +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.169341365028816 (code B ref 63648); Wed, 30 Aug 2023 16:41:03 +0000 Original-Received: (at 63648) by debbugs.gnu.org; 30 Aug 2023 16:40:50 +0000 Original-Received: from localhost ([127.0.0.1]:53854 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qbOFN-0007Uh-KP for submit@debbugs.gnu.org; Wed, 30 Aug 2023 12:40:50 -0400 Original-Received: from relay6-d.mail.gandi.net ([2001:4b98:dc4:8::226]:36099) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qbOFL-0007UQ-BC for 63648@debbugs.gnu.org; Wed, 30 Aug 2023 12:40:48 -0400 Original-Received: by mail.gandi.net (Postfix) with ESMTPSA id CBBEDC000A; Wed, 30 Aug 2023 16:40:29 +0000 (UTC) In-Reply-To: (Dmitry Gutov's message of "Tue, 29 Aug 2023 23:40:19 +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:268730 Archived-At: --=-=-= Content-Type: text/plain >> There is no code where to bind a dynamic variable, because its value >> should be available for the next command in the command loop. >> If you agree there is no other way to implement this than next-default-directory, >> then I could bring up the discussion on emacs-devel. > > Before we dive into all that, why not try advice on 'command-execute'? For > the PoC code at least. It's in Lisp since 2013. Thanks for bringing up 'command-execute'. I forgot it was moved from C to Lisp, so the change is simpler and not needed to discuss on emacs-devel. Then advice on 'command-execute' will be required to support older Emacs versions in project.el. But for Emacs 30 I modified my previous patch, and the next version is below: > The comment in its body does say "Called directly from the C code", but I'm > not sure if that has any direct implications for us. Also interesting how 'command-execute' handles 'debug-on-next-call' similar to 'next-default-directory'. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=next-default-directory.patch diff --git a/lisp/simple.el b/lisp/simple.el index 05a3c4b93d6..ff665111a5d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2752,6 +2752,9 @@ oclosure-interactive-form (let ((if (cconv--interactive-helper--if f))) `(interactive ,(if (functionp if) `(funcall ',if) if)))) +(defvar next-default-directory nil + "Default directory for the next command.") + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. @@ -2803,7 +2806,11 @@ command-execute (execute-kbd-macro final prefixarg)) (t ;; Pass `cmd' rather than `final', for the backtrace's sake. - (prog1 (call-interactively cmd record-flag keys) + (prog1 (if next-default-directory + (let ((default-directory next-default-directory)) + (prog1 (call-interactively cmd record-flag keys) + (setq next-default-directory nil))) + (call-interactively cmd record-flag keys)) (when-let ((info (and (symbolp cmd) (not (get cmd 'command-execute-obsolete-warned)) diff --git a/lisp/window.el b/lisp/window.el index b9b032c33e9..006531ab017 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 'project-switch-project)) (funcall exitfun)))) ;; Call post-function after the next command finishes (bug#49057). (add-hook 'post-command-hook postfun) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 7aaf7a9f9fb..f87bb750e23 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -193,9 +193,10 @@ project-find-functions 'project-current-directory-override "29.1") -(defvar project-current-directory-override nil - "Value to use instead of `default-directory' when detecting the project. -When it is non-nil, `project-current' will always skip prompting too.") +(define-obsolete-variable-alias + 'project-current-directory-override + 'next-default-directory + "30.1") (defcustom project-prompter #'project-prompt-project-dir "Function to call to prompt for a project. @@ -227,12 +228,11 @@ project-current 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))) + (unless directory (setq directory default-directory)) (let ((pr (project--find-in-directory directory))) (cond (pr) - ((unless project-current-directory-override + ((unless next-default-directory maybe-prompt) (setq directory (funcall project-prompter) pr (project--find-in-directory directory)))) @@ -846,8 +846,8 @@ project-prefix-map ;;;###autoload (define-key ctl-x-map "p" project-prefix-map) -;; We can't have these place-specific maps inherit from -;; project-prefix-map because project--other-place-command needs to +;; Maybe we can have these place-specific maps inherit from +;; project-prefix-map because set-transient-map maybe needs to ;; know which map the key binding came from, as if it came from one of ;; these maps, we don't want to set display-buffer-overriding-action @@ -863,16 +863,6 @@ project-other-frame-map map) "Keymap for project commands that display buffers in other frames.") -(defun project--other-place-command (action &optional map) - (let* ((key (read-key-sequence-vector nil t)) - (place-cmd (lookup-key map key)) - (generic-cmd (lookup-key project-prefix-map key)) - (switch-to-buffer-obey-display-actions t) - (display-buffer-overriding-action (unless place-cmd action))) - (if-let ((cmd (or place-cmd generic-cmd))) - (call-interactively cmd) - (user-error "%s is undefined" (key-description key))))) - ;;;###autoload (defun project-other-window-command () "Run project command, displaying resultant buffer in another window. @@ -882,9 +872,10 @@ 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)) + (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))) ;;;###autoload (define-key ctl-x-4-map "p" #'project-other-window-command) @@ -897,8 +888,10 @@ 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)) + (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) @@ -910,7 +903,9 @@ project-other-tab-command \\{project-prefix-map}" (interactive) - (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) @@ -993,13 +988,13 @@ 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 +`next-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 + (if-let (filename-proj (and next-default-directory (project-current nil default-directory))) ;; file-name-concat requires Emacs 28+ (concat (file-name-as-directory (project-root project)) @@ -1893,16 +1888,17 @@ project-switch-commands (character :tag "Explicit key")))) (symbol :tag "Single command"))) -(defcustom project-switch-use-entire-map nil - "Whether `project-switch-project' will use the entire `project-prefix-map'. -If nil, `project-switch-project' will only recognize commands -listed in `project-switch-commands', and will signal an error -when other commands are invoked. If this is non-nil, all the -keys in `project-prefix-map' are valid even if they aren't -listed in the dispatch menu produced from `project-switch-commands'." - :type 'boolean - :group 'project - :version "28.1") +;; OBSOLETE? +;; (defcustom project-switch-use-entire-map nil +;; "Whether `project-switch-project' will use the entire `project-prefix-map'. +;; If nil, `project-switch-project' will only recognize commands +;; listed in `project-switch-commands', and will signal an error +;; when other commands are invoked. If this is non-nil, all the +;; keys in `project-prefix-map' are valid even if they aren't +;; listed in the dispatch menu produced from `project-switch-commands'." +;; :type 'boolean +;; :group 'project +;; :version "28.1") (defcustom project-key-prompt-style (if (facep 'help-key-binding) t @@ -1938,39 +1934,6 @@ project--keymap-prompt project-switch-commands " ")) -(defun project--switch-project-command () - (let* ((commands-menu - (mapcar - (lambda (row) - (if (characterp (car row)) - ;; Deprecated format. - ;; XXX: Add a warning about it? - (reverse row) - row)) - project-switch-commands)) - (commands-map - (let ((temp-map (make-sparse-keymap))) - (set-keymap-parent temp-map project-prefix-map) - (dolist (row commands-menu temp-map) - (when-let ((cmd (nth 0 row)) - (keychar (nth 2 row))) - (define-key temp-map (vector keychar) cmd))))) - command) - (while (not command) - (let* ((overriding-local-map commands-map) - (choice (read-key-sequence (project--keymap-prompt)))) - (when (setq command (lookup-key commands-map choice)) - (unless (or project-switch-use-entire-map - (assq command commands-menu)) - ;; TODO: Add some hint to the prompt, like "key not - ;; recognized" or something. - (setq command nil))) - (let ((global-command (lookup-key (current-global-map) choice))) - (when (memq global-command - '(keyboard-quit keyboard-escape-quit)) - (call-interactively global-command))))) - command)) - ;;;###autoload (defun project-switch-project (dir) "\"Switch\" to another project by running an Emacs command. @@ -1980,11 +1943,18 @@ project-switch-project When called in a program, it will use the project corresponding to directory DIR." (interactive (list (funcall project-prompter))) - (let ((command (if (symbolp project-switch-commands) - project-switch-commands - (project--switch-project-command)))) - (let ((project-current-directory-override dir)) - (call-interactively command)))) + (if (symbolp project-switch-commands) + (let ((default-directory dir)) + (call-interactively project-switch-commands)) + (let* ((echofun (lambda () "[switch-project]")) + (postfun (lambda () (remove-hook + 'prefix-command-echo-keystrokes-functions + echofun)))) + (setq next-default-directory dir) + (message (project--keymap-prompt)) + (add-hook 'prefix-command-echo-keystrokes-functions echofun) + (prefix-command-preserve-state) + (set-transient-map project-prefix-map nil postfun)))) ;;;###autoload (defun project-uniquify-dirname-transform (dirname) diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 5a206b67db1..bc8c0553f40 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -41,7 +41,7 @@ project/quoted-directory (skip-unless (executable-find "grep")) (ert-with-temp-directory directory (let ((default-directory directory) - (project-current-directory-override t) + (next-default-directory directory) (project-find-functions nil) (project-list-file (expand-file-name "projects" directory)) --=-=-=--