commit 0954689cb3243e3af4b0c12c08bdcad608fd8433 (HEAD, refs/remotes/origin/master) Author: Jim Porter Date: Mon Oct 17 21:25:37 2022 -0700 ; Fix some invalid Eshell syntax in an example * doc/misc/eshell.texi (Expansion): * etc/NEWS: Fix invalid Eshell syntax. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index d518eafd72..2945c05e85 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1176,7 +1176,7 @@ a number if possible. @item one or both (non-@code{nil}) lists Concatenate ``adjacent'' elements of each value (possibly converting -back to a number as above). For example, @samp{$list("a" "b")c} +back to a number as above). For example, @samp{$(list "a" "b")c} returns @samp{("a" "bc")}. @item anything else diff --git a/etc/NEWS b/etc/NEWS index e63c7742bc..b48aeee008 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2606,7 +2606,7 @@ otherwise be returned. *** Concatenating Eshell expansions now works more similarly to other shells. When concatenating an Eshell expansion that returns a list, "adjacent" elements of each operand are now concatenated together, -e.g. '$list("a" "b")c' returns '("a" "bc")'. See the "(eshell) +e.g. '$(list "a" "b")c' returns '("a" "bc")'. See the "(eshell) Expansion" node in the Eshell manual for more details. +++ commit fd4992d356a9c4225cb518a6a5309aaa1d0f640b Author: Jim Porter Date: Thu Sep 15 12:32:02 2022 -0700 Print the correct $PATH when Eshell's 'which' fails to find a command * lisp/eshell/esh-cmd.el (eshell/which): Use 'eshell-get-path' (bug#20008). diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index c5ceb3ffd1..4a41bbe8fa 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1274,8 +1274,9 @@ be finished later after the completion of an asynchronous subprocess." name) (eshell-search-path name))))) (if (not program) - (eshell-error (format "which: no %s in (%s)\n" - name (getenv "PATH"))) + (eshell-error (format "which: no %s in (%s)\n" + name (string-join (eshell-get-path t) + (path-separator)))) (eshell-printn program))))) (put 'eshell/which 'eshell-no-numeric-conversions t) commit cee1cbfd54375cdece23d4741ced6b0c7091f6d9 Author: Jim Porter Date: Thu Sep 15 12:24:37 2022 -0700 Improve handling of $PATH in Eshell for remote directories * lisp/eshell/esh-util.el (eshell-path-env, eshell-parse-colon-path): Make obsolete. (eshell-path-env-list): New variable. (eshell-connection-default-profile): New connection-local profile. (eshell-get-path): Reimplement using 'eshell-path-env-list'; add LITERAL-P argument. (eshell-set-path): New function. * lisp/eshell/esh-var.el (eshell-variable-aliases-list): Add entry for $PATH. (eshell-var-initialize): Add 'eshell-path-env-list' to 'eshell-subcommand-bindings'. * lisp/eshell/esh-ext.el (eshell-search-path): Use 'file-name-concat' instead of 'concat'. (eshell/addpath): Use 'eshell-get-path' and 'eshell-set-path'. * lisp/net/tramp-integration.el: Only apply Eshell hooks when 'eshell-path-env-list' is unbound. * test/lisp/eshell/esh-var-tests.el (esh-var-test/path-var/local-directory) (esh-var-test/path-var/remote-directory, esh-var-test/path-var/set) (esh-var-test/path-var/set-locally) (esh-var-test/path-var-preserve-across-hosts): New tests. * test/lisp/eshell/esh-ext-tests.el: New file. * test/lisp/eshell/eshell-tests-helpers.el (with-temp-eshell): Set 'eshell-last-dir-ring-file-name' to nil. (eshell-tests-remote-accessible-p, eshell-last-input) (eshell-last-output): New functions. (eshell-match-output, eshell-match-output--explainer): Use 'eshell-last-input' and 'eshell-last-output'. * doc/misc/eshell.texi (Variables): Document $PATH. * etc/NEWS: Announce this change (bug#57556). diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 21c1671a21..d518eafd72 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -942,6 +942,16 @@ When using @code{$-}, you can also access older directories in the directory ring via subscripting, e.g.@: @samp{$-[1]} refers to the working directory @emph{before} the previous one. +@vindex $PATH +@item $PATH +This specifies the directories to search for executable programs. Its +value is a string, separated by @code{":"} for Unix and GNU systems, +and @code{";"} for MS systems. This variable is connection-aware, so +whenever you change the current directory to a different host +(@pxref{Remote Files, , , emacs, The GNU Emacs Manual}), +the value will automatically update to reflect the search path on that +host. + @vindex $_ @item $_ This refers to the last argument of the last command. With a diff --git a/etc/NEWS b/etc/NEWS index d64614783b..e63c7742bc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -356,6 +356,11 @@ previous 'C-x ='. ** Eshell +*** Eshell's PATH is now derived from 'exec-path'. +For consistency with remote connections, Eshell now uses 'exec-path' +to determine the execution path on the local system, instead of using +the PATH environment variable directly. + --- *** 'source' and '.' no longer accept the '--help' option. This is for compatibility with the shell versions of these commands, diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 98902fc6f2..d513d750d9 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -77,7 +77,7 @@ but Eshell will be able to understand (let ((list (eshell-get-path)) suffixes n1 n2 file) (while list - (setq n1 (concat (car list) name)) + (setq n1 (file-name-concat (car list) name)) (setq suffixes eshell-binary-suffixes) (while suffixes (setq n2 (concat n1 (car suffixes))) @@ -239,17 +239,16 @@ causing the user to wonder if anything's really going on..." (?h "help" nil nil "display this usage message") :usage "[-b] PATH Adds the given PATH to $PATH.") - (if args - (progn - (setq eshell-path-env (getenv "PATH") - args (mapconcat #'identity args path-separator) - eshell-path-env - (if prepend - (concat args path-separator eshell-path-env) - (concat eshell-path-env path-separator args))) - (setenv "PATH" eshell-path-env)) - (dolist (dir (parse-colon-path (getenv "PATH"))) - (eshell-printn dir))))) + (let ((path (eshell-get-path t))) + (if args + (progn + (setq path (if prepend + (append args path) + (append path args))) + (eshell-set-path path) + (string-join path (path-separator))) + (dolist (dir path) + (eshell-printn dir)))))) (put 'eshell/addpath 'eshell-no-numeric-conversions t) (put 'eshell/addpath 'eshell-filename-arguments t) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 9258ca5e40..9b464a0a13 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -249,17 +249,60 @@ trailing newlines removed. Otherwise, this behaves as follows: It might be different from \(getenv \"PATH\"), when `default-directory' points to a remote host.") -(defun eshell-get-path () +(make-obsolete-variable 'eshell-path-env 'eshell-get-path "29.1") + +(defvar-local eshell-path-env-list nil) + +(connection-local-set-profile-variables + 'eshell-connection-default-profile + '((eshell-path-env-list . nil))) + +(connection-local-set-profiles + '(:application eshell) + 'eshell-connection-default-profile) + +(defun eshell-get-path (&optional literal-p) "Return $PATH as a list. -Add the current directory on MS-Windows." - (eshell-parse-colon-path - (if (eshell-under-windows-p) - (concat "." path-separator eshell-path-env) - eshell-path-env))) +If LITERAL-P is nil, return each directory of the path as a full, +possibly-remote file name; on MS-Windows, add the current +directory as the first directory in the path as well. + +If LITERAL-P is non-nil, return the local part of each directory, +as the $PATH was actually specified." + (with-connection-local-application-variables 'eshell + (let ((remote (file-remote-p default-directory)) + (path + (or eshell-path-env-list + ;; If not already cached, get the path from + ;; `exec-path', removing the last element, which is + ;; `exec-directory'. + (setq-connection-local eshell-path-env-list + (butlast (exec-path)))))) + (when (and (not literal-p) + (not remote) + (eshell-under-windows-p)) + (push "." path)) + (if (and remote (not literal-p)) + (mapcar (lambda (x) (file-name-concat remote x)) path) + path)))) + +(defun eshell-set-path (path) + "Set the Eshell $PATH to PATH. +PATH can be either a list of directories or a string of +directories separated by `path-separator'." + (with-connection-local-application-variables 'eshell + (setq-connection-local + eshell-path-env-list + (if (listp path) + path + ;; Don't use `parse-colon-path' here, since we don't want + ;; the additonal translations it does on each element. + (split-string path (path-separator)))))) (defun eshell-parse-colon-path (path-env) "Split string with `parse-colon-path'. Prepend remote identification of `default-directory', if any." + (declare (obsolete nil "29.1")) (let ((remote (file-remote-p default-directory))) (if remote (mapcar diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index caf143e1a1..57ea42f493 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -156,7 +156,14 @@ if they are quoted with a backslash." ("LINES" ,(lambda () (window-body-height nil 'remap)) t t) ("INSIDE_EMACS" eshell-inside-emacs t) - ;; for eshell-cmd.el + ;; for esh-ext.el + ("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator))) + . ,(lambda (_ value) + (eshell-set-path value) + value)) + t t) + + ;; for esh-cmd.el ("_" ,(lambda (indices quoted) (if (not indices) (car (last eshell-last-arguments)) @@ -249,7 +256,8 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (setq-local eshell-subcommand-bindings (append '((process-environment (eshell-copy-environment)) - (eshell-variable-aliases-list eshell-variable-aliases-list)) + (eshell-variable-aliases-list eshell-variable-aliases-list) + (eshell-path-env-list eshell-path-env-list)) eshell-subcommand-bindings)) (setq-local eshell-special-chars-inside-quoting diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 35c0636b1c..4be019edd9 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -136,16 +136,17 @@ been set up by `rfn-eshadow-setup-minibuffer'." (getenv "PATH")))) (with-eval-after-load 'esh-util - (add-hook 'eshell-mode-hook - #'tramp-eshell-directory-change) - (add-hook 'eshell-directory-change-hook - #'tramp-eshell-directory-change) - (add-hook 'tramp-integration-unload-hook - (lambda () - (remove-hook 'eshell-mode-hook - #'tramp-eshell-directory-change) - (remove-hook 'eshell-directory-change-hook - #'tramp-eshell-directory-change)))) + (unless (boundp 'eshell-path-env-list) + (add-hook 'eshell-mode-hook + #'tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + #'tramp-eshell-directory-change) + (add-hook 'tramp-integration-unload-hook + (lambda () + (remove-hook 'eshell-mode-hook + #'tramp-eshell-directory-change) + (remove-hook 'eshell-directory-change-hook + #'tramp-eshell-directory-change))))) ;;; Integration of recentf.el: diff --git a/test/lisp/eshell/esh-ext-tests.el b/test/lisp/eshell/esh-ext-tests.el new file mode 100644 index 0000000000..54191e9409 --- /dev/null +++ b/test/lisp/eshell/esh-ext-tests.el @@ -0,0 +1,76 @@ +;;; esh-ext-tests.el --- esh-ext test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for Eshell's external command handling. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'esh-ext) +(require 'eshell) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +;;; Tests: + +(ert-deftest esh-ext-test/addpath/end () + "Test that \"addpath\" adds paths to the end of $PATH." + (with-temp-eshell + (let ((eshell-path-env-list '("/some/path" "/other/path")) + (expected-path (string-join '("/some/path" "/other/path" "/new/path" + "/new/path2") + (path-separator)))) + (eshell-match-command-output "addpath /new/path /new/path2" + (concat expected-path "\n")) + (eshell-match-command-output "echo $PATH" + (concat expected-path "\n"))))) + +(ert-deftest esh-ext-test/addpath/begin () + "Test that \"addpath -b\" adds paths to the beginning of $PATH." + (with-temp-eshell + (let ((eshell-path-env-list '("/some/path" "/other/path")) + (expected-path (string-join '("/new/path" "/new/path2" "/some/path" + "/other/path") + (path-separator)))) + (eshell-match-command-output "addpath -b /new/path /new/path2" + (concat expected-path "\n")) + (eshell-match-command-output "echo $PATH" + (concat expected-path "\n"))))) + +(ert-deftest esh-ext-test/addpath/set-locally () + "Test adding to the path temporarily in a subcommand." + (let* ((eshell-path-env-list '("/some/path" "/other/path")) + (original-path (string-join eshell-path-env-list (path-separator))) + (local-path (string-join (append eshell-path-env-list '("/new/path")) + (path-separator)))) + (with-temp-eshell + (eshell-match-command-output + "{ addpath /new/path; env }" + (format "PATH=%s\n" (regexp-quote local-path))) + ;; After the last command, the previous $PATH value should be restored. + (eshell-match-command-output "echo $PATH" + (concat original-path "\n"))))) + +;; esh-ext-tests.el ends here diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index a7ac52ed24..d9b2585a32 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'tramp) (require 'ert) (require 'esh-mode) (require 'esh-var) @@ -610,6 +611,65 @@ it, since the setter is nil." (eshell-match-command-output "echo $INSIDE_EMACS[, 1]" "eshell"))) +(ert-deftest esh-var-test/path-var/local-directory () + "Test using $PATH in a local directory." + (let ((expected-path (string-join (eshell-get-path t) (path-separator)))) + (with-temp-eshell + (eshell-match-command-output "echo $PATH" (regexp-quote expected-path))))) + +(ert-deftest esh-var-test/path-var/remote-directory () + "Test using $PATH in a remote directory." + (skip-unless (eshell-tests-remote-accessible-p)) + (let* ((default-directory ert-remote-temporary-file-directory) + (expected-path (string-join (eshell-get-path t) (path-separator)))) + (with-temp-eshell + (eshell-match-command-output "echo $PATH" (regexp-quote expected-path))))) + +(ert-deftest esh-var-test/path-var/set () + "Test setting $PATH." + (let* ((path-to-set-list '("/some/path" "/other/path")) + (path-to-set (string-join path-to-set-list (path-separator)))) + (with-temp-eshell + (eshell-match-command-output (concat "set PATH " path-to-set) + (concat path-to-set "\n")) + (eshell-match-command-output "echo $PATH" (concat path-to-set "\n")) + (should (equal (eshell-get-path t) path-to-set-list))))) + +(ert-deftest esh-var-test/path-var/set-locally () + "Test setting $PATH temporarily for a single command." + (let* ((path-to-set-list '("/some/path" "/other/path")) + (path-to-set (string-join path-to-set-list (path-separator)))) + (with-temp-eshell + (eshell-match-command-output (concat "set PATH " path-to-set) + (concat path-to-set "\n")) + (eshell-match-command-output "PATH=/local/path env" + "PATH=/local/path\n") + ;; After the last command, the previous $PATH value should be restored. + (eshell-match-command-output "echo $PATH" (concat path-to-set "\n")) + (should (equal (eshell-get-path t) path-to-set-list))))) + +(ert-deftest esh-var-test/path-var/preserve-across-hosts () + "Test that $PATH can be set independently on multiple hosts." + (let ((local-directory default-directory) + local-path remote-path) + (with-temp-eshell + ;; Set the $PATH on localhost. + (eshell-insert-command "set PATH /local/path") + (setq local-path (eshell-last-output)) + ;; `cd' to a remote host and set the $PATH there too. + (eshell-insert-command + (format "cd %s" ert-remote-temporary-file-directory)) + (eshell-insert-command "set PATH /remote/path") + (setq remote-path (eshell-last-output)) + ;; Return to localhost and check that $PATH is the value we set + ;; originally. + (eshell-insert-command (format "cd %s" local-directory)) + (eshell-match-command-output "echo $PATH" (regexp-quote local-path)) + ;; ... and do the same for the remote host. + (eshell-insert-command + (format "cd %s" ert-remote-temporary-file-directory)) + (eshell-match-command-output "echo $PATH" (regexp-quote remote-path))))) + (ert-deftest esh-var-test/last-status-var-lisp-command () "Test using the \"last exit status\" ($?) variable with a Lisp command" (with-temp-eshell diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index e713e162ad..1d9674070c 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -31,11 +31,22 @@ (require 'eshell) (defvar eshell-history-file-name nil) +(defvar eshell-last-dir-ring-file-name nil) (defvar eshell-test--max-subprocess-time 5 "The maximum amount of time to wait for a subprocess to finish, in seconds. See `eshell-wait-for-subprocess'.") +(defun eshell-tests-remote-accessible-p () + "Return if a test involving remote files can proceed. +If using this function, be sure to load `tramp' near the +beginning of the test file." + (ignore-errors + (and + (file-remote-p ert-remote-temporary-file-directory) + (file-directory-p ert-remote-temporary-file-directory) + (file-writable-p ert-remote-temporary-file-directory)))) + (defmacro with-temp-eshell (&rest body) "Evaluate BODY in a temporary Eshell buffer." `(save-current-buffer @@ -44,6 +55,7 @@ See `eshell-wait-for-subprocess'.") ;; back on $HISTFILE. (process-environment (cons "HISTFILE" process-environment)) (eshell-history-file-name nil) + (eshell-last-dir-ring-file-name nil) (eshell-buffer (eshell t))) (unwind-protect (with-current-buffer eshell-buffer @@ -83,19 +95,25 @@ After inserting, call FUNC. If FUNC is nil, instead call (insert-and-inherit command) (funcall (or func 'eshell-send-input))) +(defun eshell-last-input () + "Return the input of the last Eshell command." + (buffer-substring-no-properties + eshell-last-input-start eshell-last-input-end)) + +(defun eshell-last-output () + "Return the output of the last Eshell command." + (buffer-substring-no-properties + (eshell-beginning-of-output) (eshell-end-of-output))) + (defun eshell-match-output (regexp) "Test whether the output of the last command matches REGEXP." - (string-match-p - regexp (buffer-substring-no-properties - (eshell-beginning-of-output) (eshell-end-of-output)))) + (string-match-p regexp (eshell-last-output))) (defun eshell-match-output--explainer (regexp) "Explain the result of `eshell-match-output'." `(mismatched-output - (command ,(buffer-substring-no-properties - eshell-last-input-start eshell-last-input-end)) - (output ,(buffer-substring-no-properties - (eshell-beginning-of-output) (eshell-end-of-output))) + (command ,(eshell-last-input)) + (output ,(eshell-last-output)) (regexp ,regexp))) (put 'eshell-match-output 'ert-explainer #'eshell-match-output--explainer) commit 7c41016fca5ab0638f1e2fed260e2ee41f3400c2 Author: Jim Porter Date: Sun Sep 25 21:47:26 2022 -0700 Allow setting the values of variable aliases in Eshell This makes commands like "COLUMNS=40 some-command" work as expected. * lisp/eshell/esh-cmd.el (eshell-subcommand-bindings): Remove 'process-environment' from here... * lisp/eshell/esh-var.el (eshell-var-initialize): ... and add to here, along with 'eshell-variable-aliases-list'. (eshell-inside-emacs): Convert to a 'defvar-local' to make it settable in a particular Eshell buffer. (eshell-variable-aliases-list): Make $?, $$, and $* read-only and update docstring. (eshell-set-variable): New function... (eshell-handle-local-variables, eshell/export, eshell/unset): ... use it. (eshell/set, pcomplete/eshell-mode/set): New functions. (eshell-get-variable): Get the variable alias's getter function when appropriate and use a safer method for checking function arity. * test/lisp/eshell/esh-var-tests.el (esh-var-test/set/env-var) (esh-var-test/set/symbol, esh-var-test/unset/env-var) (esh-var-test/unset/symbol, esh-var-test/setq, esh-var-test/export) (esh-var-test/local-variables, esh-var-test/alias/function) (esh-var-test/alias/function-pair, esh-var-test/alias/string) (esh-var-test/alias/string/prefer-lisp, esh-var-test/alias/symbol) (esh-var-test/alias/symbol-pair, esh-var-test/alias/export) (esh-var-test/alias/local-variables): New tests. * doc/misc/eshell.texi (Built-ins): Add 'set' and update 'unset' documentation. (Variables): Expand documentation of how to get/set variables. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 8036bbd83a..21c1671a21 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -694,10 +694,18 @@ used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is disabled by default. +@item set +@cmindex set +Set variable values, using the function @code{set} like a command +(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). +A variable name can be a symbol, in which case it refers to a Lisp +variable, or a string, referring to an environment variable +(@pxref{Arguments}). + @item setq @cmindex setq -Set variable values, using the function @code{setq} like a command. -@xref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}. +Set variable values, using the function @code{setq} like a command +(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}). @item source @cmindex source @@ -743,7 +751,9 @@ disabled by default. @item unset @cmindex unset -Unset an environment variable. +Unset one or more variables. As with @command{set}, a variable name +can be a symbol, in which case it refers to a Lisp variable, or a +string, referring to an environment variable. @item wait @cmindex wait @@ -881,12 +891,35 @@ For example, you could handle a subset of the options for the @node Variables @section Variables -Since Eshell is just an Emacs @acronym{REPL}@footnote{ +@vindex eshell-prefer-lisp-variables +Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{ Short for ``Read-Eval-Print Loop''. -} -, it does not have its own scope, and simply stores variables the same -you would in an Elisp program. Eshell provides a command version of -@code{setq} for convenience. +} and a command shell, it can refer to variables from two different +sources: ordinary Emacs Lisp variables, as well as environment +variables. By default, when using a variable in Eshell, it will first +look in the list of built-in variables, then in the list of +environment variables, and finally in the list of Lisp variables. If +you would prefer to use Lisp variables over environment variables, you +can set @code{eshell-prefer-lisp-variables} to @code{t}. + +You can set variables in a few different ways. To set a Lisp +variable, you can use the command @samp{setq @var{name} @var{value}}, +which works much like its Lisp counterpart (@pxref{Setting Variables, +, , elisp, The Emacs Lisp Reference Manual}). To set an environment +variable, use @samp{export @var{name}=@var{value}}. You can also use +@samp{set @var{variable} @var{value}}, which sets a Lisp variable if +@var{variable} is a symbol, or an environment variable if it's a +string (@pxref{Arguments}). Finally, you can temporarily set +environment variables for a single command with +@samp{@var{name}=@var{value} @var{command} @dots{}}. This is +equivalent to: + +@example +@{ + export @var{name}=@var{value} + @var{command} @dots{} +@} +@end example @subsection Built-in variables Eshell knows a few built-in variables: diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 3f3a1616ee..c5ceb3ffd1 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -261,9 +261,9 @@ the command." (defcustom eshell-subcommand-bindings '((eshell-in-subcommand-p t) (eshell-in-pipeline-p nil) - (default-directory default-directory) - (process-environment (eshell-copy-environment))) + (default-directory default-directory)) "A list of `let' bindings for subcommand environments." + :version "29.1" ; removed `process-environment' :type 'sexp :risky t) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 3c09fc52fb..caf143e1a1 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -113,7 +113,7 @@ (require 'pcomplete) (require 'ring) -(defconst eshell-inside-emacs (format "%s,eshell" emacs-version) +(defvar-local eshell-inside-emacs (format "%s,eshell" emacs-version) "Value for the `INSIDE_EMACS' environment variable.") (defgroup eshell-var nil @@ -162,8 +162,8 @@ if they are quoted with a backslash." (car (last eshell-last-arguments)) (eshell-apply-indices eshell-last-arguments indices quoted)))) - ("?" eshell-last-command-status) - ("$" eshell-last-command-result) + ("?" (eshell-last-command-status . nil)) + ("$" (eshell-last-command-result . nil)) ;; for em-alias.el and em-script.el ("0" eshell-command-name) @@ -176,7 +176,7 @@ if they are quoted with a backslash." ("7" ,(lambda () (nth 6 eshell-command-arguments)) nil t) ("8" ,(lambda () (nth 7 eshell-command-arguments)) nil t) ("9" ,(lambda () (nth 8 eshell-command-arguments)) nil t) - ("*" eshell-command-arguments)) + ("*" (eshell-command-arguments . nil))) "This list provides aliasing for variable references. Each member is of the following form: @@ -186,6 +186,11 @@ NAME defines the name of the variable, VALUE is a Lisp value used to compute the string value that will be returned when the variable is accessed via the syntax `$NAME'. +If VALUE is a cons (GET . SET), then variable references to NAME +will use GET to get the value, and SET to set it. GET and SET +can be one of the forms described below. If SET is nil, the +variable is read-only. + If VALUE is a function, its behavior depends on the value of SIMPLE-FUNCTION. If SIMPLE-FUNCTION is nil, call VALUE with two arguments: the list of the indices that were used in the reference, @@ -193,23 +198,30 @@ and either t or nil depending on whether or not the variable was quoted with double quotes. For example, if `NAME' were aliased to a function, a reference of `$NAME[10][20]' would result in that function being called with the arguments `((\"10\") (\"20\"))' and -nil. -If SIMPLE-FUNCTION is non-nil, call the function with no arguments -and then pass its return value to `eshell-apply-indices'. +nil. If SIMPLE-FUNCTION is non-nil, call the function with no +arguments and then pass its return value to `eshell-apply-indices'. + +When VALUE is a function, it's read-only by default. To make it +writeable, use the (GET . SET) form described above. If SET is a +function, it takes two arguments: a list of indices (currently +always nil, but reserved for future enhancement), and the new +value to set. -If VALUE is a string, return the value for the variable with that -name in the current environment. If no variable with that name exists -in the environment, but if a symbol with that same name exists and has -a value bound to it, return that symbol's value instead. You can -prefer symbol values over environment values by setting the value -of `eshell-prefer-lisp-variables' to t. +If VALUE is a string, get/set the value for the variable with +that name in the current environment. When getting the value, if +no variable with that name exists in the environment, but if a +symbol with that same name exists and has a value bound to it, +return that symbol's value instead. You can prefer symbol values +over environment values by setting the value of +`eshell-prefer-lisp-variables' to t. -If VALUE is a symbol, return the value bound to it. +If VALUE is a symbol, get/set the value bound to it. If VALUE has any other type, signal an error. Additionally, if COPY-TO-ENVIRONMENT is non-nil, the alias should be copied (a.k.a. \"exported\") to the environment of created subprocesses." + :version "29.1" :type '(repeat (list string sexp (choice (const :tag "Copy to environment" t) (const :tag "Use only in Eshell" nil)) @@ -234,6 +246,11 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." ;; changing a variable will affect all of Emacs. (unless eshell-modify-global-environment (setq-local process-environment (eshell-copy-environment))) + (setq-local eshell-subcommand-bindings + (append + '((process-environment (eshell-copy-environment)) + (eshell-variable-aliases-list eshell-variable-aliases-list)) + eshell-subcommand-bindings)) (setq-local eshell-special-chars-inside-quoting (append eshell-special-chars-inside-quoting '(?$))) @@ -282,9 +299,9 @@ copied (a.k.a. \"exported\") to the environment of created subprocesses." (while (string-match setvar command) (nconc l (list - (list 'setenv (match-string 1 command) - (match-string 2 command) - (= (length (match-string 2 command)) 0)))) + (list 'eshell-set-variable + (match-string 1 command) + (match-string 2 command)))) (setq command (eshell-stringify (car args)) args (cdr args))) (cdr l)) @@ -328,12 +345,11 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (defun eshell/export (&rest sets) "This alias allows the `export' command to act as bash users expect." - (while sets - (if (and (stringp (car sets)) - (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets))) - (setenv (match-string 1 (car sets)) - (match-string 2 (car sets)))) - (setq sets (cdr sets)))) + (dolist (set sets) + (when (and (stringp set) + (string-match "^\\([^=]+\\)=\\(.*\\)" set)) + (eshell-set-variable (match-string 1 set) + (match-string 2 set))))) (defun pcomplete/eshell-mode/export () "Completion function for Eshell's `export'." @@ -343,16 +359,28 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (eshell-envvar-names))))) (defun eshell/unset (&rest args) - "Unset an environment variable." - (while args - (if (stringp (car args)) - (setenv (car args) nil t)) - (setq args (cdr args)))) + "Unset one or more variables. +This is equivalent to calling `eshell/set' for all of ARGS with +the values of nil for each." + (dolist (arg args) + (eshell-set-variable arg nil))) (defun pcomplete/eshell-mode/unset () "Completion function for Eshell's `unset'." (while (pcomplete-here (eshell-envvar-names)))) +(defun eshell/set (&rest args) + "Allow command-ish use of `set'." + (let (last-value) + (while args + (setq last-value (eshell-set-variable (car args) (cadr args)) + args (cddr args))) + last-value)) + +(defun pcomplete/eshell-mode/set () + "Completion function for Eshell's `set'." + (while (pcomplete-here (eshell-envvar-names)))) + (defun eshell/setq (&rest args) "Allow command-ish use of `setq'." (let (last-value) @@ -566,18 +594,21 @@ INDICES is a list of index-lists (see `eshell-parse-indices'). If QUOTED is non-nil, this was invoked inside double-quotes." (if-let ((alias (assoc name eshell-variable-aliases-list))) (let ((target (nth 1 alias))) + (when (and (not (functionp target)) + (consp target)) + (setq target (car target))) (cond ((functionp target) (if (nth 3 alias) (eshell-apply-indices (funcall target) indices quoted) - (condition-case nil - (funcall target indices quoted) - (wrong-number-of-arguments - (display-warning - :warning (concat "Function for `eshell-variable-aliases-list' " - "entry should accept two arguments: INDICES " - "and QUOTED.'")) - (funcall target indices))))) + (let ((max-arity (cdr (func-arity target)))) + (if (or (eq max-arity 'many) (>= max-arity 2)) + (funcall target indices quoted) + (display-warning + :warning (concat "Function for `eshell-variable-aliases-list' " + "entry should accept two arguments: INDICES " + "and QUOTED.'")) + (funcall target indices))))) ((symbolp target) (eshell-apply-indices (symbol-value target) indices quoted)) (t @@ -594,6 +625,44 @@ If QUOTED is non-nil, this was invoked inside double-quotes." (getenv name))) indices quoted))) +(defun eshell-set-variable (name value) + "Set the variable named NAME to VALUE. +NAME can be a string (in which case it refers to an environment +variable or variable alias) or a symbol (in which case it refers +to a Lisp variable)." + (if-let ((alias (assoc name eshell-variable-aliases-list))) + (let ((target (nth 1 alias))) + (cond + ((functionp target) + (setq target nil)) + ((consp target) + (setq target (cdr target)))) + (cond + ((functionp target) + (funcall target nil value)) + ((null target) + (unless eshell-in-subcommand-p + (error "Variable `%s' is not settable" (eshell-stringify name))) + (push `(,name ,(lambda () value) t t) + eshell-variable-aliases-list) + value) + ;; Since getting a variable alias with a string target and + ;; `eshell-prefer-lisp-variables' non-nil gets the + ;; corresponding Lisp variable, make sure setting does the + ;; same. + ((and eshell-prefer-lisp-variables + (stringp target)) + (eshell-set-variable (intern target) value)) + (t + (eshell-set-variable target value)))) + (cond + ((stringp name) + (setenv name value)) + ((symbolp name) + (set name value)) + (t + (error "Unknown variable `%s'" (eshell-stringify name)))))) + (defun eshell-apply-indices (value indices &optional quoted) "Apply to VALUE all of the given INDICES, returning the sub-result. The format of INDICES is: diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index ad695e45d7..a7ac52ed24 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -25,6 +25,7 @@ (require 'ert) (require 'esh-mode) +(require 'esh-var) (require 'eshell) (require 'eshell-tests-helpers @@ -439,6 +440,150 @@ inside double-quotes" (eshell-command-result-equal "echo \"${echo \\\"000 010 020\\\"}[0]\"" "000")) + +;; Variable-related commands + +(ert-deftest esh-var-test/set/env-var () + "Test that `set' with a string variable name sets an environment variable." + (with-temp-eshell + (eshell-match-command-output "set VAR hello" "hello\n") + (should (equal (getenv "VAR") "hello"))) + (should-not (equal (getenv "VAR") "hello"))) + +(ert-deftest esh-var-test/set/symbol () + "Test that `set' with a symbol variable name sets a Lisp variable." + (let (eshell-test-value) + (eshell-command-result-equal "set #'eshell-test-value hello" + "hello") + (should (equal eshell-test-value "hello")))) + +(ert-deftest esh-var-test/unset/env-var () + "Test that `unset' with a string variable name unsets an env var." + (let ((process-environment (cons "VAR=value" process-environment))) + (with-temp-eshell + (eshell-match-command-output "unset VAR" "\\`\\'") + (should (equal (getenv "VAR") nil))) + (should (equal (getenv "VAR") "value")))) + +(ert-deftest esh-var-test/unset/symbol () + "Test that `unset' with a symbol variable name unsets a Lisp variable." + (let ((eshell-test-value "value")) + (eshell-command-result-equal "unset #'eshell-test-value" nil) + (should (equal eshell-test-value nil)))) + +(ert-deftest esh-var-test/setq () + "Test that `setq' sets Lisp variables." + (let (eshell-test-value) + (eshell-command-result-equal "setq eshell-test-value hello" + "hello") + (should (equal eshell-test-value "hello")))) + +(ert-deftest esh-var-test/export () + "Test that `export' sets environment variables." + (with-temp-eshell + (eshell-match-command-output "export VAR=hello" "\\`\\'") + (should (equal (getenv "VAR") "hello")))) + +(ert-deftest esh-var-test/local-variables () + "Test that \"VAR=value command\" temporarily sets variables." + (with-temp-eshell + (push "VAR=value" process-environment) + (eshell-match-command-output "VAR=hello env" "VAR=hello\n") + (should (equal (getenv "VAR") "value")))) + + +;; Variable aliases + +(ert-deftest esh-var-test/alias/function () + "Test using a variable alias defined as a function." + (with-temp-eshell + (push `("ALIAS" ,(lambda () "value") nil t) eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "value\n") + (eshell-match-command-output "set ALIAS hello" + "Variable `ALIAS' is not settable\n" + nil t))) + +(ert-deftest esh-var-test/alias/function-pair () + "Test using a variable alias defined as a pair of getter/setter functions." + (with-temp-eshell + (let ((eshell-test-value "value")) + (push `("ALIAS" (,(lambda () eshell-test-value) + . (lambda (_ value) + (setq eshell-test-value (upcase value)))) + nil t) + eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "value\n") + (eshell-match-command-output "set ALIAS hello" "HELLO\n") + (should (equal eshell-test-value "HELLO"))))) + +(ert-deftest esh-var-test/alias/string () + "Test using a variable alias defined as a string. +This should get/set the aliased environment variable." + (with-temp-eshell + (let ((eshell-test-value "lisp-value")) + (push "eshell-test-value=env-value" process-environment) + (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "env-value\n") + (eshell-match-command-output "set ALIAS hello" "hello\n") + (should (equal (getenv "eshell-test-value") "hello")) + (should (equal eshell-test-value "lisp-value"))))) + +(ert-deftest esh-var-test/alias/string/prefer-lisp () + "Test using a variable alias defined as a string. +This sets `eshell-prefer-lisp-variables' to t and should get/set +the aliased Lisp variable." + (with-temp-eshell + (let ((eshell-test-value "lisp-value") + (eshell-prefer-lisp-variables t)) + (push "eshell-test-value=env-value" process-environment) + (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "lisp-value\n") + (eshell-match-command-output "set ALIAS hello" "hello\n") + (should (equal (car process-environment) "eshell-test-value=env-value")) + (should (equal eshell-test-value "hello"))))) + +(ert-deftest esh-var-test/alias/symbol () + "Test using a variable alias defined as a symbol. +This should get/set the value bound to the symbol." + (with-temp-eshell + (let ((eshell-test-value "value")) + (push '("ALIAS" eshell-test-value) eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "value\n") + (eshell-match-command-output "set ALIAS hello" "hello\n") + (should (equal eshell-test-value "hello"))))) + +(ert-deftest esh-var-test/alias/symbol-pair () + "Test using a variable alias defined as a pair of symbols. +This should get the value bound to the symbol, but fail to set +it, since the setter is nil." + (with-temp-eshell + (let ((eshell-test-value "value")) + (push '("ALIAS" (eshell-test-value . nil)) eshell-variable-aliases-list) + (eshell-match-command-output "echo $ALIAS" "value\n") + (eshell-match-command-output "set ALIAS hello" + "Variable `ALIAS' is not settable\n" + nil t)))) + +(ert-deftest esh-var-test/alias/export () + "Test that `export' properly sets variable aliases." + (with-temp-eshell + (let ((eshell-test-value "value")) + (push `("ALIAS" (,(lambda () eshell-test-value) + . (lambda (_ value) (setq eshell-test-value value))) + nil t) + eshell-variable-aliases-list) + (eshell-match-command-output "export ALIAS=hello" "\\`\\'") + (should (equal eshell-test-value "hello"))))) + +(ert-deftest esh-var-test/alias/local-variables () + "Test that \"VAR=value cmd\" temporarily sets read-only variable aliases." + (with-temp-eshell + (let ((eshell-test-value "value")) + (push `("ALIAS" ,(lambda () eshell-test-value) t t) + eshell-variable-aliases-list) + (eshell-match-command-output "ALIAS=hello env" "ALIAS=hello\n") + (should (equal eshell-test-value "value"))))) + ;; Built-in variables commit f1caa10f04c980034f5ee6e0748cf3b03f460b2b Author: Jim Porter Date: Wed Sep 28 09:34:38 2022 -0700 ; Obsolete 'eshell/define' * lisp/eshell/esh-var.el (eshell/define): Make obsolete, and explain its current state. * doc/misc/eshell.texi (Built-ins): Remove 'define'. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 0ee33f2c2a..8036bbd83a 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -439,11 +439,6 @@ Print the current local time as a human-readable string. This command is similar to, but slightly different from, the GNU Coreutils @command{date} command. -@item define -@cmindex define -Define a variable alias. -@xref{Variable Aliases, , , elisp, The Emacs Lisp Reference Manual}. - @item diff @cmindex diff Compare files using Emacs's internal @code{diff} (not to be confused diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 36e59cd5a4..3c09fc52fb 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -302,6 +302,11 @@ This function is explicit for adding to `eshell-parse-argument-hook'." (defun eshell/define (var-alias definition) "Define a VAR-ALIAS using DEFINITION." + ;; FIXME: This function doesn't work (it produces variable aliases + ;; in a form not recognized by other parts of the code), and likely + ;; hasn't worked since before its introduction into Emacs. It + ;; should either be removed or fixed up. + (declare (obsolete nil "29.1")) (if (not definition) (setq eshell-variable-aliases-list (delq (assoc var-alias eshell-variable-aliases-list) commit 2c82530f475c71d90284b2b90980475f73f16a8b Author: Jim Porter Date: Sat Sep 24 18:13:03 2022 -0700 ; Allow ignoring errors when calling 'eshell-match-command-output' * test/lisp/eshell/eshell-tests-helpers.el (eshell-match-command-output): New argument IGNORE-ERRORS. * test/lisp/eshell/esh-var-tests.el (esh-var-test/last-status-var-lisp-command) (esh-var-test/last-status-var-lisp-form) (esh-var-test/last-status-var-lisp-form-2): Ignore errors when calling 'eshell-match-command-output'. diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index cb5b1766bb..ad695e45d7 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -472,9 +472,8 @@ inside double-quotes" "t\n0\n") (eshell-match-command-output "zerop 1; echo $?" "0\n") - (let ((debug-on-error nil)) - (eshell-match-command-output "zerop foo; echo $?" - "1\n")))) + (eshell-match-command-output "zerop foo; echo $?" + "1\n" nil t))) (ert-deftest esh-var-test/last-status-var-lisp-form () "Test using the \"last exit status\" ($?) variable with a Lisp form" @@ -484,9 +483,8 @@ inside double-quotes" "t\n0\n") (eshell-match-command-output "(zerop 1); echo $?" "2\n") - (let ((debug-on-error nil)) - (eshell-match-command-output "(zerop \"foo\"); echo $?" - "1\n"))))) + (eshell-match-command-output "(zerop \"foo\"); echo $?" + "1\n" nil t)))) (ert-deftest esh-var-test/last-status-var-lisp-form-2 () "Test using the \"last exit status\" ($?) variable with a Lisp form. @@ -497,9 +495,8 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." "0\n") (eshell-match-command-output "(zerop 0); echo $?" "0\n") - (let ((debug-on-error nil)) - (eshell-match-command-output "(zerop \"foo\"); echo $?" - "1\n"))))) + (eshell-match-command-output "(zerop \"foo\"); echo $?" + "1\n" nil t)))) (ert-deftest esh-var-test/last-status-var-ext-cmd () "Test using the \"last exit status\" ($?) variable with an external command" diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 73abfcbb55..e713e162ad 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -100,9 +100,16 @@ After inserting, call FUNC. If FUNC is nil, instead call (put 'eshell-match-output 'ert-explainer #'eshell-match-output--explainer) -(defun eshell-match-command-output (command regexp &optional func) - "Insert a COMMAND at the end of the buffer and match the output with REGEXP." - (eshell-insert-command command func) +(defun eshell-match-command-output (command regexp &optional func + ignore-errors) + "Insert a COMMAND at the end of the buffer and match the output with REGEXP. +FUNC is the function to call after inserting the text (see +`eshell-insert-command'). + +If IGNORE-ERRORS is non-nil, ignore any errors signaled when +inserting the command." + (let ((debug-on-error (and (not ignore-errors) debug-on-error))) + (eshell-insert-command command func)) (eshell-wait-for-subprocess) (should (eshell-match-output regexp))) commit 3cc356abfef8294abcb91dc421e3c63a561a11b4 Author: Jim Porter Date: Tue Oct 11 22:11:04 2022 -0700 Add helpers to dynamically assign connection-local values * lisp/files-x.el (connection-local-criteria) (connection-local-profile-name-for-setq): New variables. (with-connection-local-variables-1): ... let-bind them here. (connection-local-update-profile-variables) (connection-local-profile-name-for-criteria): New functions. (with-connection-local-application-variables, setq-connection-local): New macros. * test/lisp/files-x-tests.el: Require 'tramp-integration' (files-x-test--variable5, remote-lazy-var): New variables. (files-x-test-hack-connection-local-variables-apply): Expand checks. (files-x-test-with-connection-local-variables): Remove 'hack-connection-local-variables-apply' check (it belongs in the above test), and expand some other checks. (files-x-test--get-lazy-var, files-x-test--set-lazy-var): New functions. (files-x-test-connection-local-update-profile-variables) (files-x-test-setq-connection-local): New tests. * doc/lispref/variables.texi (Connection Local Variables): Split into two subsections and document the new features. * etc/NEWS: Announce 'setq-connection-local'. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 2a06169b21..cbe276b2dc 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2239,9 +2239,26 @@ still respecting file-local variables (@pxref{File Local Variables}). @cindex connection local variables Connection-local variables provide a general mechanism for different -variable settings in buffers with a remote connection. They are bound +variable settings in buffers with a remote connection (@pxref{Remote +Files,, Remote Files, emacs, The GNU Emacs Manual}). They are bound and set depending on the remote connection a buffer is dedicated to. +@menu +* Connection Local Profiles:: Storing variable settings to + apply to connections. +* Applying Connection Local Variables:: Using connection-local values + in your code. +@end menu + +@node Connection Local Profiles +@subsection Connection Local Profiles +@cindex connection local profiles + + Emacs uses connection-local profiles to store the variable settings +to apply to particular connections. You can then associate these with +remote connections by defining the criteria when they should apply, +using @code{connection-local-set-profiles}. + @defun connection-local-set-profile-variables profile variables This function defines a set of variable settings for the connection @var{profile}, which is a symbol. You can later assign the connection @@ -2356,6 +2373,14 @@ names. The function @code{connection-local-set-profiles} updates this list. @end deffn +@node Applying Connection Local Variables +@subsection Applying Connection Local Variables +@cindex connection local variables, applying + + When writing connection-aware code, you'll need to collect, and +possibly apply, any connection-local variables. There are several +ways to do this, as described below. + @defun hack-connection-local-variables criteria This function collects applicable connection-local variables associated with @var{criteria} in @@ -2384,9 +2409,9 @@ This function looks for connection-local variables according to @var{criteria}, and immediately applies them in the current buffer. @end defun -@defmac with-connection-local-variables &rest body -All connection-local variables, which are specified by -@code{default-directory}, are applied. +@defmac with-connection-local-application-variables application &rest body +Apply all connection-local variables for @code{application}, which are +specified by @code{default-directory}. After that, @var{body} is executed, and the connection-local variables are unwound. Example: @@ -2394,20 +2419,20 @@ are unwound. Example: @example @group (connection-local-set-profile-variables - 'remote-perl - '((perl-command-name . "/usr/local/bin/perl") + 'my-remote-perl + '((perl-command-name . "/usr/local/bin/perl5") (perl-command-switch . "-e %s"))) @end group @group (connection-local-set-profiles - '(:application tramp :protocol "ssh" :machine "remotehost") - 'remote-perl) + '(:application my-app :protocol "ssh" :machine "remotehost") + 'my-remote-perl) @end group @group (let ((default-directory "/ssh:remotehost:/working/dir/")) - (with-connection-local-variables + (with-connection-local-application-variables 'my-app do something useful)) @end group @end example @@ -2416,30 +2441,59 @@ are unwound. Example: @defvar connection-local-default-application The default application, a symbol, to be applied in @code{with-connection-local-variables}. It defaults to @code{tramp}, -but in case you want to overwrite Tramp's settings temporarily, you -could let-bind it like +but you can let-bind it to change the application temporarily +(@pxref{Local Variables}). + +This variable must not be changed globally. +@end defvar + +@defmac with-connection-local-variables &rest body +This is equivalent to +@code{with-connection-local-application-variables}, but uses +@code{connection-local-default-application} for the application. +@end defmac + +@defmac setq-connection-local [symbol form]@dots{} +This macro sets each @var{symbol} connection-locally to the result of +evaluating the corresponding @var{form}, using the connection-local +profile specified in @code{connection-local-profile-name-for-setq}; if +the profile name is @code{nil}, this macro will just set the variables +normally, as with @code{setq} (@pxref{Setting Variables}). + +For example, you can use this macro in combination with +@code{with-connection-local-variables} or +@code{with-connection-local-application-variables} to lazily +initialize connection-local settings: @example @group +(defvar my-app-variable nil) + (connection-local-set-profile-variables - 'my-remote-perl - '((perl-command-name . "/usr/local/bin/perl5") - (perl-command-switch . "-e %s"))) -@end group + 'my-app-connection-default-profile + '((my-app-variable . nil))) -@group (connection-local-set-profiles - '(:application my-app :protocol "ssh" :machine "remotehost") - 'my-remote-perl) + '(:application my-app) + 'my-app-connection-default-profile) @end group @group -(let ((default-directory "/ssh:remotehost:/working/dir/") - (connection-local-default-application 'my-app)) - (with-connection-local-variables - do something useful)) +(defun my-app-get-variable () + (with-connection-local-application-variables 'my-app + (or my-app-variable + (setq-connection-local my-app-variable + do something useful)))) @end group @end example +@end defmac + +@defvar connection-local-profile-name-for-setq +The connection-local profile name, a symbol, to use when setting +variables via @code{setq-connection-local}. This is let-bound in the +body of @code{with-connection-local-variables}, but you can also +let-bind it yourself if you'd like to set variables on a different +profile. This variable must not be changed globally. @end defvar diff --git a/etc/NEWS b/etc/NEWS index 041fe0bdbd..d64614783b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3219,6 +3219,13 @@ TIMEOUT is the idle time after which to deactivate the transient map. The default timeout value can be defined by the new variable 'set-transient-map-timeout'. ++++ +** New macro 'setq-connection-local'. +This allows dynamically setting variable values for a particular +connection within the body of 'with-connection-local-variables'. See +the "(elisp) Connection Local Variables" node in the Lisp Reference +manual for more information. + +++ ** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'. These function now take an optional comparison predicate argument. diff --git a/lisp/files-x.el b/lisp/files-x.el index 0131d495f2..3516592fc3 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -620,6 +620,18 @@ PROFILES is a list of connection profiles (symbols)." :group 'tramp :version "29.1") +(defvar connection-local-criteria nil + "The current connection-local criteria, or nil. +This is set while executing the body of +`with-connection-local-variables'.") + +(defvar connection-local-profile-name-for-setq nil + "The current connection-local profile name, or nil. +This is the name of the profile to use when setting variables via +`setq-connection-local'. Its value is derived from +`connection-local-criteria' and is set while executing the body +of `with-connection-local-variables'.") + (defsubst connection-local-normalize-criteria (criteria) "Normalize plist CRITERIA according to properties. Return a reordered plist." @@ -696,6 +708,23 @@ in order." (customize-set-variable 'connection-local-profile-alist connection-local-profile-alist)) +;;;###autoload +(defun connection-local-update-profile-variables (profile variables) + "Update the variable settings for PROFILE in-place. +VARIABLES is a list that declares connection-local variables for +the connection profile. An element in VARIABLES is an alist +whose elements are of the form (VAR . VALUE). + +Unlike `connection-local-set-profile-variables' (which see), this +function preserves the values of any existing variable +definitions that aren't listed in VARIABLES." + (when-let ((existing-variables + (nreverse (connection-local-get-profile-variables profile)))) + (dolist (var variables) + (setf (alist-get (car var) existing-variables) (cdr var))) + (setq variables (nreverse existing-variables))) + (connection-local-set-profile-variables profile variables)) + (defun hack-connection-local-variables (criteria) "Read connection-local variables according to CRITERIA. Store the connection-local variables in buffer local @@ -738,6 +767,15 @@ If APPLICATION is nil, `connection-local-default-application' is used." :user ,(file-remote-p default-directory 'user) :machine ,(file-remote-p default-directory 'host)))) +(defun connection-local-profile-name-for-criteria (criteria) + "Get a connection-local profile name based on CRITERIA." + (when criteria + (let (print-level print-length) + (intern (concat + "autogenerated-connection-local-profile/" + (prin1-to-string + (connection-local-normalize-criteria criteria))))))) + ;;;###autoload (defmacro with-connection-local-variables (&rest body) "Apply connection-local variables according to `default-directory'. @@ -745,16 +783,28 @@ Execute BODY, and unwind connection-local variables." (declare (debug t)) `(with-connection-local-variables-1 (lambda () ,@body))) +;;;###autoload +(defmacro with-connection-local-application-variables (application &rest body) + "Apply connection-local variables for APPLICATION in `default-directory'. +Execute BODY, and unwind connection-local variables." + (declare (debug t) (indent 1)) + `(let ((connection-local-default-application ,application)) + (with-connection-local-variables-1 (lambda () ,@body)))) + ;;;###autoload (defun with-connection-local-variables-1 (body-fun) "Apply connection-local variables according to `default-directory'. Call BODY-FUN with no args, and then unwind connection-local variables." (if (file-remote-p default-directory) - (let ((enable-connection-local-variables t) - (old-buffer-local-variables (buffer-local-variables)) - connection-local-variables-alist) - (hack-connection-local-variables-apply - (connection-local-criteria-for-default-directory)) + (let* ((enable-connection-local-variables t) + (connection-local-criteria + (connection-local-criteria-for-default-directory)) + (connection-local-profile-name-for-setq + (connection-local-profile-name-for-criteria + connection-local-criteria)) + (old-buffer-local-variables (buffer-local-variables)) + connection-local-variables-alist) + (hack-connection-local-variables-apply connection-local-criteria) (unwind-protect (funcall body-fun) ;; Cleanup. @@ -766,6 +816,49 @@ Call BODY-FUN with no args, and then unwind connection-local variables." ;; No connection-local variables to apply. (funcall body-fun))) +;;;###autoload +(defmacro setq-connection-local (&rest pairs) + "Set each VARIABLE connection-locally to VALUE. + +When `connection-local-profile-name-for-setq' is set, assign each +variable's value on that connection profile, and set that profile +for `connection-local-criteria'. You can use this in combination +with `with-connection-local-variables', as in + + (with-connection-local-variables + (setq-connection-local VARIABLE VALUE)) + +If there's no connection-local profile to use, just set the +variables normally, as with `setq'. + +The variables are literal symbols and should not be quoted. The +second VALUE is not computed until after the first VARIABLE is +set, and so on; each VALUE can use the new value of variables set +earlier in the `setq-connection-local'. The return value of the +`setq-connection-local' form is the value of the last VALUE. + +\(fn [VARIABLE VALUE]...)" + (declare (debug setq)) + (unless (zerop (mod (length pairs) 2)) + (error "PAIRS must have an even number of variable/value members")) + (let ((set-expr nil) + (profile-vars nil)) + (while pairs + (unless (symbolp (car pairs)) + (error "Attempting to set a non-symbol: %s" (car pairs))) + (push `(set ',(car pairs) ,(cadr pairs)) set-expr) + (push `(cons ',(car pairs) ,(car pairs)) profile-vars) + (setq pairs (cddr pairs))) + `(prog1 + ,(macroexp-progn (nreverse set-expr)) + (when connection-local-profile-name-for-setq + (connection-local-update-profile-variables + connection-local-profile-name-for-setq + (list ,@(nreverse profile-vars))) + (connection-local-set-profiles + connection-local-criteria + connection-local-profile-name-for-setq))))) + ;;;###autoload (defun path-separator () "The connection-local value of `path-separator'." diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 2f6d0d4a99..b1555a0266 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -23,6 +23,7 @@ (require 'ert) (require 'files-x) +(require 'tramp-integration) (defconst files-x-test--variables1 '((remote-shell-file-name . "/bin/bash") @@ -35,7 +36,11 @@ '((remote-null-device . "/dev/null"))) (defconst files-x-test--variables4 '((remote-null-device . "null"))) +(defconst files-x-test--variables5 + '((remote-lazy-var . nil) + (remote-null-device . "/dev/null"))) (defvar remote-null-device) +(defvar remote-lazy-var nil) (put 'remote-shell-file-name 'safe-local-variable #'identity) (put 'remote-shell-command-switch 'safe-local-variable #'identity) (put 'remote-shell-interactive-switch 'safe-local-variable #'identity) @@ -91,6 +96,28 @@ (connection-local-get-profile-variables 'remote-nullfile) files-x-test--variables4)))) +(ert-deftest files-x-test-connection-local-update-profile-variables () + "Test updating connection-local profile variables." + + ;; Declare (PROFILE VARIABLES) objects. + (let (connection-local-profile-alist connection-local-criteria-alist) + (connection-local-set-profile-variables + 'remote-bash (copy-alist files-x-test--variables1)) + (should + (equal + (connection-local-get-profile-variables 'remote-bash) + files-x-test--variables1)) + + ;; Updating overwrites only the values specified in this call, but + ;; retains all the other values from previous calls. + (connection-local-update-profile-variables + 'remote-bash files-x-test--variables2) + (should + (equal + (connection-local-get-profile-variables 'remote-bash) + (cons (car files-x-test--variables2) + (cdr files-x-test--variables1)))))) + (ert-deftest files-x-test-connection-local-set-profiles () "Test setting connection-local profiles." @@ -233,9 +260,12 @@ (nreverse (copy-tree files-x-test--variables2))))) ;; The variables exist also as local variables. (should (local-variable-p 'remote-shell-file-name)) + (should (local-variable-p 'remote-null-device)) ;; The proper variable value is set. (should - (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")))) + (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null")))) ;; The third test case. Both criteria `files-x-test--criteria1' ;; and `files-x-test--criteria2' apply, but there are no double @@ -274,13 +304,11 @@ (should-not (local-variable-p 'remote-shell-file-name)) (should-not (boundp 'remote-shell-file-name)))))) -(defvar tramp-connection-local-default-shell-variables) -(defvar tramp-connection-local-default-system-variables) - (ert-deftest files-x-test-with-connection-local-variables () "Test setting connection-local variables." - (let (connection-local-profile-alist connection-local-criteria-alist) + (let ((connection-local-profile-alist connection-local-profile-alist) + (connection-local-criteria-alist connection-local-criteria-alist)) (connection-local-set-profile-variables 'remote-bash files-x-test--variables1) (connection-local-set-profile-variables @@ -291,29 +319,6 @@ (connection-local-set-profiles nil 'remote-ksh 'remote-nullfile) - (with-temp-buffer - (let ((enable-connection-local-variables t)) - (hack-connection-local-variables-apply nil) - - ;; All connection-local variables are set. They apply in - ;; reverse order in `connection-local-variables-alist'. - (should - (equal connection-local-variables-alist - (append - (nreverse (copy-tree files-x-test--variables3)) - (nreverse (copy-tree files-x-test--variables2))))) - ;; The variables exist also as local variables. - (should (local-variable-p 'remote-shell-file-name)) - (should (local-variable-p 'remote-null-device)) - ;; The proper variable values are set. - (should - (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) - (should - (string-equal (symbol-value 'remote-null-device) "/dev/null")) - - ;; A candidate connection-local variable is not bound yet. - (should-not (local-variable-p 'remote-shell-command-switch)))) - (with-temp-buffer ;; Use the macro. We need a remote `default-directory'. (let ((enable-connection-local-variables t) @@ -331,18 +336,18 @@ (with-connection-local-variables ;; All connection-local variables are set. They apply in ;; reverse order in `connection-local-variables-alist'. - ;; Since we ha a remote default directory, Tramp's settings + ;; Since we have a remote default directory, Tramp's settings ;; are appended as well. (should (equal connection-local-variables-alist (append - (nreverse (copy-tree files-x-test--variables3)) - (nreverse (copy-tree files-x-test--variables2)) (nreverse (copy-tree tramp-connection-local-default-shell-variables)) (nreverse - (copy-tree tramp-connection-local-default-system-variables))))) + (copy-tree tramp-connection-local-default-system-variables)) + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables2))))) ;; The variables exist also as local variables. (should (local-variable-p 'remote-shell-file-name)) (should (local-variable-p 'remote-null-device)) @@ -352,15 +357,21 @@ (should (string-equal (symbol-value 'remote-null-device) "/dev/null")) - ;; Run another instance of `with-connection-local-variables' - ;; with a different application. - (let ((connection-local-default-application (cadr files-x-test--application))) - (with-connection-local-variables - ;; The proper variable values are set. - (should - (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")) - (should - (string-equal (symbol-value 'remote-null-device) "/dev/null")))) + ;; Run `with-connection-local-application-variables' to use a + ;; different application. + (with-connection-local-application-variables + (cadr files-x-test--application) + (should + (equal + connection-local-variables-alist + (append + (nreverse (copy-tree files-x-test--variables3)) + (nreverse (copy-tree files-x-test--variables1))))) + ;; The proper variable values are set. + (should + (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash")) + (should + (string-equal (symbol-value 'remote-null-device) "/dev/null"))) ;; The variable values are reset. (should (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh")) @@ -376,5 +387,60 @@ (should-not (boundp 'remote-shell-file-name)) (should (string-equal (symbol-value 'remote-null-device) "null")))))) +(defun files-x-test--get-lazy-var () + "Get the connection-local value of `remote-lazy-var'. +If it's not initialized yet, initialize it." + (with-connection-local-application-variables + (cadr files-x-test--application) + (or remote-lazy-var + (setq-connection-local remote-lazy-var + (or (file-remote-p default-directory 'host) + "local"))))) + +(defun files-x-test--set-lazy-var (value) + "Set the connection-local value of `remote-lazy-var'" + (with-connection-local-application-variables + (cadr files-x-test--application) + (setq-connection-local remote-lazy-var value))) + +(ert-deftest files-x-test-setq-connection-local () + "Test dynamically setting connection local variables." + (let (connection-local-profile-alist connection-local-criteria-alist) + (connection-local-set-profile-variables + 'remote-lazy files-x-test--variables5) + (connection-local-set-profiles + files-x-test--application + 'remote-lazy) + + ;; Test the initial local value. + (should (equal (files-x-test--get-lazy-var) "local")) + + ;; Set the local value and make sure it retains the value we set. + (should (equal (files-x-test--set-lazy-var "here") "here")) + (should (equal (files-x-test--get-lazy-var) "here")) + + (let ((default-directory "/method:host:")) + ;; Test the initial remote value. + (should (equal (files-x-test--get-lazy-var) "host")) + + ;; Set the remote value and make sure it retains the value we set. + (should (equal (files-x-test--set-lazy-var "there") "there")) + (should (equal (files-x-test--get-lazy-var) "there")) + ;; Set another connection-local variable. + (with-connection-local-application-variables + (cadr files-x-test--application) + (setq-connection-local remote-null-device "null"))) + + ;; Make sure we get the local value we set above. + (should (equal (files-x-test--get-lazy-var) "here")) + (should-not (boundp 'remote-null-device)) + + ;; Make sure we get the remote values we set above. + (let ((default-directory "/method:host:")) + (should (equal (files-x-test--get-lazy-var) "there")) + (with-connection-local-application-variables + (cadr files-x-test--application) + (should (equal remote-null-device "null")))))) + (provide 'files-x-tests) ;;; files-x-tests.el ends here commit 1beb389e472ab8132b478c9f24dd0ab6b7398670 Author: Jim Porter Date: Wed Oct 12 11:28:05 2022 -0700 ; Remove over-quoting of :application values in connection-local variables * test/lisp/files-x-tests.el (files-x-test--application) (files-x-test--another-application): * doc/lispref/variables.texi (Connection Local Variables): Remove extra quotes. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 1d891618da..2a06169b21 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2311,13 +2311,13 @@ always applies. Example: @example @group (connection-local-set-profiles - '(:application 'tramp :protocol "ssh" :machine "localhost") + '(:application tramp :protocol "ssh" :machine "localhost") 'remote-bash 'remote-null-device) @end group @group (connection-local-set-profiles - '(:application 'tramp :protocol "sudo" + '(:application tramp :protocol "sudo" :user "root" :machine "localhost") 'remote-ksh 'remote-null-device) @end group @@ -2329,13 +2329,13 @@ Therefore, the example above would be equivalent to @example @group (connection-local-set-profiles - '(:application 'tramp :protocol "ssh" :machine "localhost") + '(:application tramp :protocol "ssh" :machine "localhost") 'remote-bash) @end group @group (connection-local-set-profiles - '(:application 'tramp :protocol "sudo" + '(:application tramp :protocol "sudo" :user "root" :machine "localhost") 'remote-ksh) @end group @@ -2365,7 +2365,7 @@ Example: @example @group (hack-connection-local-variables - '(:application 'tramp :protocol "ssh" :machine "localhost")) + '(:application tramp :protocol "ssh" :machine "localhost")) @end group @group @@ -2401,7 +2401,7 @@ are unwound. Example: @group (connection-local-set-profiles - '(:application 'tramp :protocol "ssh" :machine "remotehost") + '(:application tramp :protocol "ssh" :machine "remotehost") 'remote-perl) @end group @@ -2429,7 +2429,7 @@ could let-bind it like @group (connection-local-set-profiles - '(:application 'my-app :protocol "ssh" :machine "remotehost") + '(:application my-app :protocol "ssh" :machine "remotehost") 'my-remote-perl) @end group diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 7ee2f0c1a6..2f6d0d4a99 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -42,9 +42,9 @@ (put 'remote-shell-login-switch 'safe-local-variable #'identity) (put 'remote-null-device 'safe-local-variable #'identity) -(defconst files-x-test--application '(:application 'my-application)) +(defconst files-x-test--application '(:application my-application)) (defconst files-x-test--another-application - '(:application 'another-application)) + '(:application another-application)) (defconst files-x-test--protocol '(:protocol "my-protocol")) (defconst files-x-test--user '(:user "my-user")) (defconst files-x-test--machine '(:machine "my-machine")) commit f4442d49f6490cb754bad66dd34a182d5eae06d9 Author: Paul Eggert Date: Sun Oct 16 21:35:47 2022 -0700 Improve ‘random’ doc re nonces * doc/lispref/numbers.texi (Random Numbers): Improve coverage of random seed, entropy pools, and why one shouldn’t use ‘random’ for nonces. See Bug#58472. diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index fdcda328d8..2c7a1d3266 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -1238,6 +1238,9 @@ any given seed, the @code{random} function always generates the same sequence of numbers. By default, Emacs initializes the random seed at startup, in such a way that the sequence of values of @code{random} (with overwhelming likelihood) differs in each Emacs run. +The random seed is typically initialized from system entropy; +however, on obsolescent platforms lacking entropy pools, +the seed is taken from less-random volatile data such as the current time. Sometimes you want the random number sequence to be repeatable. For example, when debugging a program whose behavior depends on the random @@ -1256,12 +1259,45 @@ nonnegative and less than @var{limit}. Otherwise, the value might be any fixnum, i.e., any integer from @code{most-negative-fixnum} through @code{most-positive-fixnum} (@pxref{Integer Basics}). -If @var{limit} is @code{t}, it means to choose a new seed as if Emacs -were restarting, typically from the system entropy. On systems -lacking entropy pools, choose the seed from less-random volatile data -such as the current time. - If @var{limit} is a string, it means to choose a new seed based on the -string's contents. +string's contents. This causes later calls to @code{random} to return +a reproducible sequence of results. + +If @var{limit} is @code{t}, it means to choose a new seed as if Emacs +were restarting. This causes later calls to @code{random} to return +an unpredictable sequence of results. @end defun + +If you need a random nonce for cryptographic purposes, using +@code{random} is typically not the best approach, for several reasons: + +@itemize @bullet +@item +Although you can use @code{(random t)} to consult system entropy, +doing so can adversely affect other parts of your program that benefit +from reproducible results. + +@item +The system-dependent pseudo-random number generator (PRNG) used by +@code{random} is not necessarily suitable for cryptography. + +@item +A call to @code{(random t)} does not give direct access to system +entropy; the entropy is passed through the system-dependent PRNG, thus +possibly biasing the results. + +@item +On typical platforms the random seed contains only 32 bits, which is +typically narrower than an Emacs fixnum, and is not nearly enough for +cryptographic purposes. + +@item +A @code{(random t)} call leaves information about the nonce scattered +about Emacs's internal state, increasing the size of the internal +attack surface. + +@item +On obsolescent platforms lacking entropy pools, @code{(random t)} is +seeded from a cryptographically weak source. +@end itemize commit 0dbd1dbe7d82331f3fda9a0d0b29373149fa7ce5 Author: Po Lu Date: Tue Oct 18 08:52:01 2022 +0800 Fix bug#58584 * src/xterm.c (x_handle_selection_monitor_event): Return if selection event is one Emacs asked for. (handle_one_xevent): In that case, drop the event and don't let it reach GTK. diff --git a/src/xterm.c b/src/xterm.c index 07a8c5e1c3..7c3ab87e87 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -17855,7 +17855,7 @@ x_handle_wm_state (struct frame *f, struct input_event *ie) #ifdef HAVE_XFIXES -static void +static bool x_handle_selection_monitor_event (struct x_display_info *dpyinfo, XEvent *event) { @@ -17865,7 +17865,7 @@ x_handle_selection_monitor_event (struct x_display_info *dpyinfo, notify = (XFixesSelectionNotifyEvent *) event; if (notify->window != dpyinfo->selection_tracking_window) - return; + return false; for (i = 0; i < dpyinfo->n_monitored_selections; ++i) { @@ -17873,6 +17873,8 @@ x_handle_selection_monitor_event (struct x_display_info *dpyinfo, if (notify->selection == dpyinfo->monitored_selections[i].name) dpyinfo->monitored_selections[i].owner = notify->owner; } + + return true; } Window @@ -24141,8 +24143,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_XFIXES if (dpyinfo->xfixes_supported_p && event->type == (dpyinfo->xfixes_event_base - + XFixesSelectionNotify)) - x_handle_selection_monitor_event (dpyinfo, event); + + XFixesSelectionNotify) + && x_handle_selection_monitor_event (dpyinfo, event)) + /* GTK 3 crashes if an XFixesSelectionNotify arrives with a + window other than the root window, because it wants to know + the screen in order to determine the compositing manager + selection name. (bug#58584) */ + *finish = X_EVENT_DROP; #endif OTHER: #ifdef USE_X_TOOLKIT commit be3d9f717dd317eafc8f511072040a5ff8c1071c Author: Dmitry Gutov Date: Tue Oct 18 02:49:21 2022 +0300 ; Fix comment diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 2a09d70209..df51f52bc7 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1699,7 +1699,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-revert-file buffer-file-name))) (with-temp-buffer ;; Trying to support CVS too. Assuming that vc-diff - ;; there will usually the diff root in default-directory. + ;; there will usually have diff root in default-directory. (when (vc-find-backend-function backend 'root) (setq-local default-directory (vc-call-backend backend 'root (car files)))) commit 5e7726552340a3a27b3445b2094bdcc004277d2a Author: Dmitry Gutov Date: Tue Oct 18 02:33:43 2022 +0300 Follow-up fixes for vc-default-checkin-patch * lisp/vc/vc.el (vc-default-checkin-patch): Call vc-revert-file on buffer-file-name (vc-backend failed on relative name sometimes). Delete the tmp dir after copying all files back, not just the first one. Bug#52349, https://lists.gnu.org/archive/html/emacs-devel/2022-10/msg01446.html. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7152b51eff..2a09d70209 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1696,7 +1696,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (progn (dolist (f files) (with-current-buffer (find-file-noselect f) - (vc-revert-file f))) + (vc-revert-file buffer-file-name))) (with-temp-buffer ;; Trying to support CVS too. Assuming that vc-diff ;; there will usually the diff root in default-directory. @@ -1724,8 +1724,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (expand-file-name f) t) (with-current-buffer (get-file-buffer f) - (revert-buffer t t t)) - (delete-directory tmpdir t))))) + (revert-buffer t t t))) + (delete-directory tmpdir t)))) ;;; Additional entry points for examining version histories commit c2b79d9148f21c3717f1eaa2d37b837b0922b94c Author: Alan Mackenzie Date: Mon Oct 17 20:33:26 2022 +0000 CC Mode: Don't fontify as types variables with the same names as struct tags This fixes bug #58534. * lisp/progmodes/cc-engine.el (c-forward-type): Only regard "struct" keywords which create self contained types (e.g. C++'s "typename") as creating found types. * lisp/progmodes/cc-langs.el (c-self-contained-typename-kwds (c-self-contained-typename-key): New language consts and variable. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 223b1e917f..596cccdf48 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9055,7 +9055,8 @@ multi-line strings (but not C++, for example)." (c-forward-<>-arglist t) (c-forward-syntactic-ws)) - (let ((start (point)) pos res name-res id-start id-end id-range) + (let ((start (point)) pos res name-res id-start id-end id-range + post-prefix-pos) ;; Skip leading type modifiers. If any are found we know it's a ;; prefix of a type. @@ -9067,6 +9068,7 @@ multi-line strings (but not C++, for example)." (c-forward-syntactic-ws) (or (eq res 'no-id) (setq res 'prefix)))) + (setq post-prefix-pos (point)) (cond ((looking-at c-typeof-key) ; e.g. C++'s "decltype". @@ -9099,9 +9101,12 @@ multi-line strings (but not C++, for example)." (setq name-res (c-forward-name)) (setq res (not (null name-res))) (when (eq name-res t) - ;; In many languages the name can be used without the - ;; prefix, so we add it to `c-found-types'. - (c-add-type pos (point)) + ;; With some keywords the name can be used without the prefix, so we + ;; add the name to `c-found-types' when this is the case. + (when (save-excursion + (goto-char post-prefix-pos) + (looking-at c-self-contained-typename-key)) + (c-add-type pos (point))) (when (and c-record-type-identifiers c-last-identifier-range) (c-record-type-id c-last-identifier-range))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index b17718cfd5..6ccd6c30df 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2294,11 +2294,22 @@ declaration with a type as a default value. This is used only in C++ Mode, e.g. \"\"." t nil c++ '("class" "typename")) - (c-lang-defconst c-template-typename-key t (c-make-keywords-re t (c-lang-const c-template-typename-kwds))) (c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key)) +(c-lang-defconst c-self-contained-typename-kwds + "Keywords where the following name is a type name which can be +used in declarations without the keyword." + t nil + c++ '("typename")) + +(c-lang-defconst c-self-contained-typename-key + ;; Adorned regexp matching `c-self-contained-typename-key'. + t (c-make-keywords-re t (c-lang-const c-self-contained-typename-kwds))) +(c-lang-defvar c-self-contained-typename-key + (c-lang-const c-self-contained-typename-key)) + (c-lang-defconst c-type-prefix-kwds "Keywords where the following name - if any - is a type name, and where the keyword together with the symbol works as a type in commit 1e9341672d53fa9b297858dc47f7318974abc80e Author: Stefan Kangas Date: Mon Oct 17 20:21:05 2022 +0200 Prefer defvar-keymap in fortran.el * lisp/progmodes/fortran.el (fortran-mode-map): Prefer defvar-keymap. diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 58d7a2026e..6791e2fc9f 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1,7 +1,6 @@ ;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*- -;; Copyright (C) 1986, 1993-1995, 1997-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Author: Michael D. Prange ;; Maintainer: emacs-devel@gnu.org @@ -624,34 +623,32 @@ Used in the Fortran entry in `hs-special-modes-alist'.") st) "Syntax table used to parse Fortran expressions for printing in GUD.") -(defvar fortran-mode-map - (let ((map (make-sparse-keymap))) - (define-key map ";" 'fortran-abbrev-start) - (define-key map "\C-c;" 'fortran-comment-region) - ;; The default comment-dwim does at least as much as this. -;;; (define-key map "\M-;" 'fortran-indent-comment) - (define-key map "\M-\n" 'fortran-split-line) - (define-key map "\M-\C-n" 'fortran-end-of-block) - (define-key map "\M-\C-p" 'fortran-beginning-of-block) - (define-key map "\M-\C-q" 'fortran-indent-subprogram) - (define-key map "\C-c\C-w" 'fortran-window-create-momentarily) - (define-key map "\C-c\C-r" 'fortran-column-ruler) - (define-key map "\C-c\C-p" 'fortran-previous-statement) - (define-key map "\C-c\C-n" 'fortran-next-statement) - (define-key map "\C-c\C-d" 'fortran-join-line) ; like f90 - (define-key map "\M-^" 'fortran-join-line) ; subvert delete-indentation - (define-key map "0" 'fortran-electric-line-number) - (define-key map "1" 'fortran-electric-line-number) - (define-key map "2" 'fortran-electric-line-number) - (define-key map "3" 'fortran-electric-line-number) - (define-key map "4" 'fortran-electric-line-number) - (define-key map "5" 'fortran-electric-line-number) - (define-key map "6" 'fortran-electric-line-number) - (define-key map "7" 'fortran-electric-line-number) - (define-key map "8" 'fortran-electric-line-number) - (define-key map "9" 'fortran-electric-line-number) - map) - "Keymap used in Fortran mode.") +(defvar-keymap fortran-mode-map + :doc "Keymap used in Fortran mode." + ";" #'fortran-abbrev-start + "C-c ;" #'fortran-comment-region + ;; The default comment-dwim does at least as much as this. + ;; "M-;" #'fortran-indent-comment + "C-M-j" #'fortran-split-line + "C-M-n" #'fortran-end-of-block + "C-M-p" #'fortran-beginning-of-block + "C-M-q" #'fortran-indent-subprogram + "C-c C-w" #'fortran-window-create-momentarily + "C-c C-r" #'fortran-column-ruler + "C-c C-p" #'fortran-previous-statement + "C-c C-n" #'fortran-next-statement + "C-c C-d" #'fortran-join-line ; like f90 + "M-^" #'fortran-join-line ; subvert delete-indentation + "0" #'fortran-electric-line-number + "1" #'fortran-electric-line-number + "2" #'fortran-electric-line-number + "3" #'fortran-electric-line-number + "4" #'fortran-electric-line-number + "5" #'fortran-electric-line-number + "6" #'fortran-electric-line-number + "7" #'fortran-electric-line-number + "8" #'fortran-electric-line-number + "9" #'fortran-electric-line-number) (define-abbrev-table 'fortran-mode-abbrev-table commit 1dd6ad69907c6dcf11970c5f8f445f7399d7f863 Author: Stefan Kangas Date: Mon Oct 17 20:10:40 2022 +0200 Update version information in Gnus manual * doc/misc/gnus.texi (Gnus Versions): Update with some information from https://www.gnus.org/history.html (Ma Gnus): Explain that Gnus is now developed together with Emacs. (Bug#58161) diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 4180b9be10..ec728c09ad 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -26911,10 +26911,17 @@ Gnus 5.10 on May 1st 2003 (24 releases). On the January 4th 2004, No Gnus was begun. +Gnus 5.11 was bundled with GNU Emacs 22.1 in June 2007. + +A version of No Gnus was released as Gnus 5.13 with GNU Emacs 23.1 in +July 2009. + On April 19, 2010 Gnus development was moved to Git. On the January 31th 2012, Ma Gnus was begun. +Since then, Gnus has only been released together with Emacs. + If you happen upon a version of Gnus that has a prefixed name---``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'', ``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus''---don't @@ -29080,8 +29087,9 @@ moving articles to a group that has not turned auto-expire on. @subsubsection Ma Gnus @cindex Ma Gnus -I'm sure there will be lots of text here. It's really spelled 真 -Gnus. +It's really spelled 真Gnus. Ma Gnus was the code name for the +development version of Gnus started in 2012. These days, Gnus is only +released together with Emacs. New features in Ma Gnus: @@ -29111,6 +29119,8 @@ The new hooks @code{gnus-gcc-pre-body-encode-hook} and the message body of the Gcc copy of a sent message. @xref{Archived Messages}. +For more recent changes, see the Emacs @file{NEWS} files. + @end itemize @end itemize commit dd7f1bb3a137f697552cce6bad8a364035e9c497 Author: Basil L. Contovounesios Date: Mon Oct 17 18:40:45 2022 +0300 Silence recent comp-tests.el lexvar warnings * test/lisp/emacs-lisp/comp-tests.el: Mark used native-compile variables as special to pacify unknown lexvar warnings in the default build. (with-test-native-compile-prune-cache): Instrument macro arguments for debugging and indent conventionally. Reindent all callers. (test-native-compile-prune-cache/dont-delete-in-parent-of-cache): Simplify file name expansion. diff --git a/test/lisp/emacs-lisp/comp-tests.el b/test/lisp/emacs-lisp/comp-tests.el index 31f32dad1f..082b641fe3 100644 --- a/test/lisp/emacs-lisp/comp-tests.el +++ b/test/lisp/emacs-lisp/comp-tests.el @@ -25,7 +25,11 @@ (require 'ert-x) (require 'comp) +(defvar comp-native-version-dir) +(defvar native-comp-eln-load-path) + (defmacro with-test-native-compile-prune-cache (&rest body) + (declare (indent 0) (debug t)) `(ert-with-temp-directory testdir (setq testdir (expand-file-name "eln-cache" testdir)) (make-directory testdir) @@ -42,32 +46,32 @@ (ert-deftest test-native-compile-prune-cache () (skip-unless (featurep 'native-compile)) (with-test-native-compile-prune-cache - (native-compile-prune-cache) - (should (file-directory-p c1)) - (should (file-regular-p (expand-file-name "some.eln" c1))) - (should (file-regular-p (expand-file-name "some.eln.tmp" c1))) - (should-not (file-directory-p c2)) - (should-not (file-regular-p (expand-file-name "some.eln" c2))) - (should-not (file-regular-p (expand-file-name "some.eln.tmp" c2))))) + (native-compile-prune-cache) + (should (file-directory-p c1)) + (should (file-regular-p (expand-file-name "some.eln" c1))) + (should (file-regular-p (expand-file-name "some.eln.tmp" c1))) + (should-not (file-directory-p c2)) + (should-not (file-regular-p (expand-file-name "some.eln" c2))) + (should-not (file-regular-p (expand-file-name "some.eln.tmp" c2))))) (ert-deftest test-native-compile-prune-cache/delete-only-eln () (skip-unless (featurep 'native-compile)) (with-test-native-compile-prune-cache - (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo")) - (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo")) - (native-compile-prune-cache) - (should (file-regular-p (expand-file-name "keep1.txt" c1))) - (should (file-regular-p (expand-file-name "keep2.txt" c2))))) + (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo")) + (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo")) + (native-compile-prune-cache) + (should (file-regular-p (expand-file-name "keep1.txt" c1))) + (should (file-regular-p (expand-file-name "keep2.txt" c2))))) (ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache () (skip-unless (featurep 'native-compile)) (with-test-native-compile-prune-cache - (let ((f1 (expand-file-name "some.eln" (expand-file-name ".." testdir))) - (f2 (expand-file-name "some.eln" testdir))) - (with-temp-file f1 (insert "foo")) - (with-temp-file f2 (insert "foo")) - (native-compile-prune-cache) - (should (file-regular-p f1)) - (should (file-regular-p f2))))) + (let ((f1 (expand-file-name "../some.eln" testdir)) + (f2 (expand-file-name "some.eln" testdir))) + (with-temp-file f1 (insert "foo")) + (with-temp-file f2 (insert "foo")) + (native-compile-prune-cache) + (should (file-regular-p f1)) + (should (file-regular-p f2))))) ;;; comp-tests.el ends here commit eff4a4f49a7c45df9d27f0515c07d8e8727d84bb Author: Stefan Kangas Date: Mon Oct 17 15:26:56 2022 +0200 Improve native-compile-prune-cache messages * lisp/emacs-lisp/comp.el (native-compile-prune-cache): Quote name of pruned directory. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 460d260192..b7c792e64b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4342,7 +4342,7 @@ of (commands) to run simultaneously." (not (equal (file-name-nondirectory (directory-file-name subdir)) comp-native-version-dir))) - (message "Deleting %s..." subdir) + (message "Deleting `%s'..." subdir) ;; We're being overly cautious here -- there shouldn't be ;; anything but .eln files in these directories. (dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'")) commit 40b734c5003c71dc533d588bb00ea51a983bd730 Author: Stefan Kangas Date: Mon Oct 17 15:26:21 2022 +0200 Don't prune *.eln files in parent of eln-load-path * lisp/emacs-lisp/comp.el (native-compile-prune-cache): Don't prune *.eln files in parent directory of `native-comp-eln-load-path'. * test/lisp/emacs-lisp/comp-tests.el (test-native-compile-prune-cache/dont-delete-in-parent-of-cache): New test. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 686c7aeb3d..460d260192 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4334,7 +4334,9 @@ of (commands) to run simultaneously." ;; `invocation-directory'. (setq dir (expand-file-name dir invocation-directory)) (when (file-exists-p dir) - (dolist (subdir (directory-files dir t)) + (dolist (subdir (seq-filter + (lambda (f) (not (string-match (rx "/." (? ".") eos) f))) + (directory-files dir t))) (when (and (file-directory-p subdir) (file-writable-p subdir) (not (equal (file-name-nondirectory diff --git a/test/lisp/emacs-lisp/comp-tests.el b/test/lisp/emacs-lisp/comp-tests.el index 97761cd728..31f32dad1f 100644 --- a/test/lisp/emacs-lisp/comp-tests.el +++ b/test/lisp/emacs-lisp/comp-tests.el @@ -59,4 +59,15 @@ (should (file-regular-p (expand-file-name "keep1.txt" c1))) (should (file-regular-p (expand-file-name "keep2.txt" c2))))) +(ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache () + (skip-unless (featurep 'native-compile)) + (with-test-native-compile-prune-cache + (let ((f1 (expand-file-name "some.eln" (expand-file-name ".." testdir))) + (f2 (expand-file-name "some.eln" testdir))) + (with-temp-file f1 (insert "foo")) + (with-temp-file f2 (insert "foo")) + (native-compile-prune-cache) + (should (file-regular-p f1)) + (should (file-regular-p f2))))) + ;;; comp-tests.el ends here commit 24b85b10e388303c9c871a65ccf5deeed19b04f8 Author: Stefan Kangas Date: Mon Oct 17 10:37:08 2022 +0200 Add tests for native-compile-prune-cache * test/lisp/comp-tests.el: New file. diff --git a/test/lisp/emacs-lisp/comp-tests.el b/test/lisp/emacs-lisp/comp-tests.el new file mode 100644 index 0000000000..97761cd728 --- /dev/null +++ b/test/lisp/emacs-lisp/comp-tests.el @@ -0,0 +1,62 @@ +;;; comp-tests.el --- Tests for comp.el -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'ert-x) +(require 'comp) + +(defmacro with-test-native-compile-prune-cache (&rest body) + `(ert-with-temp-directory testdir + (setq testdir (expand-file-name "eln-cache" testdir)) + (make-directory testdir) + (let* ((c1 (expand-file-name "29.0.50-cur" testdir)) + (c2 (expand-file-name "29.0.50-old" testdir)) + (native-comp-eln-load-path (list testdir)) + (comp-native-version-dir "29.0.50-cur")) + (dolist (d (list c1 c2)) + (make-directory d) + (with-temp-file (expand-file-name "some.eln" d) (insert "foo")) + (with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo"))) + ,@body))) + +(ert-deftest test-native-compile-prune-cache () + (skip-unless (featurep 'native-compile)) + (with-test-native-compile-prune-cache + (native-compile-prune-cache) + (should (file-directory-p c1)) + (should (file-regular-p (expand-file-name "some.eln" c1))) + (should (file-regular-p (expand-file-name "some.eln.tmp" c1))) + (should-not (file-directory-p c2)) + (should-not (file-regular-p (expand-file-name "some.eln" c2))) + (should-not (file-regular-p (expand-file-name "some.eln.tmp" c2))))) + +(ert-deftest test-native-compile-prune-cache/delete-only-eln () + (skip-unless (featurep 'native-compile)) + (with-test-native-compile-prune-cache + (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo")) + (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo")) + (native-compile-prune-cache) + (should (file-regular-p (expand-file-name "keep1.txt" c1))) + (should (file-regular-p (expand-file-name "keep2.txt" c2))))) + +;;; comp-tests.el ends here commit abf683bb0324b9c5d01adb90aedb6aa6fa7175e9 Author: Po Lu Date: Mon Oct 17 20:56:20 2022 +0800 Fix pieces of code being too expensive over slow network connections * lisp/menu-bar.el (menu-bar-edit-menu): Test buffer-read-only before gui-backend-selection-exists-p. This places the less expensive condition before the more expensive one. * src/xfns.c (compute_tip_xy): Use cached monitor attributes whenever available. (Fx_show_tip): Remove code that really did nothing. (Fx_backspace_delete_keys_p): Do not download the entire keymap from the server upon creating a frame. * src/xmenu.c (create_and_show_popup_menu): Use x_translate_coordinates_to_root. (x_menu_show): Use x_translate_coordinates_to_root. * src/xselect.c (Fx_selection_exists_p): If a temporary selection owner can be found, use it. * src/xterm.c (x_translate_coordinates_to_root) (x_handle_selection_monitor_event, x_find_selection_owner): New functions. These functions try to avoid downloading data from the X server in places that are called very often (i.e. during tool bar updates.) (handle_one_xevent): Handle selection notify events. Also catch some mistakes found. Fetch all kinds of key names as well. (x_create_special_window): New function. (x_term_init, x_delete_display): Ask for all key names. Also, passively monitor selections that are given to `x-selection-exists-p' during redisplay, so we do not have to ask the server about them upon each redisplay. (syms_of_xterm): New variable `x-fast-selection-list'. * src/xterm.h (struct x_monitored_selection): New structure. (X_INVALID_WINDOW): New define. (struct x_display_info): New fields for selection monitoring. Also, record the fixes extension base. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index c2c18320b1..526bccbbac 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -527,12 +527,12 @@ `(menu-item "Paste" yank :enable (funcall ',(lambda () - (and (or + (and (not buffer-read-only) + (or (gui-backend-selection-exists-p 'CLIPBOARD) (if (featurep 'ns) ; like paste-from-menu (cdr yank-menu) - kill-ring)) - (not buffer-read-only)))) + kill-ring))))) :help "Paste (yank) text most recently cut/copied" :keys ,(lambda () (if cua-mode diff --git a/src/xfns.c b/src/xfns.c index 9112448899..e8732986eb 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -8443,7 +8443,17 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, unblock_input (); XSETFRAME (frame, f); - attributes = Fx_display_monitor_attributes_list (frame); + +#if defined HAVE_XRANDR || defined USE_GTK + if (!NILP (FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list)) + /* Use cached values if available to avoid fetching the + monitor list from the X server. If XRandR is not + available, then fetching the attributes will probably not + sync anyway, and will thus be relatively harmless. */ + attributes = FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list; + else +#endif + attributes = Fx_display_monitor_attributes_list (frame); /* Try to determine the monitor where the mouse pointer is and its geometry. See bug#22549. */ @@ -8693,9 +8703,6 @@ Text larger than the specified size is clipped. */) int old_windows_or_buffers_changed = windows_or_buffers_changed; specpdl_ref count = SPECPDL_INDEX (); Lisp_Object window, size, tip_buf; - Window child; - XWindowAttributes child_attrs; - int dest_x_return, dest_y_return; bool displayed; #ifdef ENABLE_CHECKING struct glyph_row *row, *end; @@ -8946,41 +8953,6 @@ Text larger than the specified size is clipped. */) /* Show tooltip frame. */ block_input (); - /* If the display is composited, then WM_TRANSIENT_FOR must be set - as well, or else the compositing manager won't display - decorations correctly, even though the tooltip window is override - redirect. See - https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html - - Perhaps WM_TRANSIENT_FOR should be used in place of - override-redirect anyway. The ICCCM only recommends - override-redirect if the pointer will be grabbed. */ - - if (XTranslateCoordinates (FRAME_X_DISPLAY (f), - FRAME_DISPLAY_INFO (f)->root_window, - FRAME_DISPLAY_INFO (f)->root_window, - root_x, root_y, &dest_x_return, - &dest_y_return, &child) - && child != None) - { - /* But only if the child is not override-redirect, which can - happen if the pointer is above a menu. */ - - if (XGetWindowAttributes (FRAME_X_DISPLAY (f), - child, &child_attrs) - || child_attrs.override_redirect) - XDeleteProperty (FRAME_X_DISPLAY (tip_f), - FRAME_X_WINDOW (tip_f), - FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); - else - XSetTransientForHint (FRAME_X_DISPLAY (tip_f), - FRAME_X_WINDOW (tip_f), child); - } - else - XDeleteProperty (FRAME_X_DISPLAY (tip_f), - FRAME_X_WINDOW (tip_f), - FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for); - #ifndef USE_XCB XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), root_x, root_y, width, height); @@ -9452,13 +9424,21 @@ usual X keysyms. Value is `lambda' if we cannot determine if both keys are present and mapped to the usual X keysyms. */) (Lisp_Object frame) { +#ifdef HAVE_XKB + XkbDescPtr kb; + struct frame *f; + Display *dpy; + Lisp_Object have_keys; + int delete_keycode, backspace_keycode, i; +#endif + #ifndef HAVE_XKB return Qlambda; #else - XkbDescPtr kb; - struct frame *f = decode_window_system_frame (frame); - Display *dpy = FRAME_X_DISPLAY (f); - Lisp_Object have_keys; + delete_keycode = 0; + backspace_keycode = 0; + f = decode_window_system_frame (frame); + dpy = FRAME_X_DISPLAY (f); if (!FRAME_DISPLAY_INFO (f)->supports_xkb) return Qlambda; @@ -9474,50 +9454,39 @@ present and mapped to the usual X keysyms. */) XK_Delete are mapped to any key. But if any of those are mapped to some non-intuitive key combination (Meta-Shift-Ctrl-whatever) and the user doesn't know about it, it is better to return false here. - It is more obvious to the user what to do if she/he has two keys + It is more obvious to the user what to do if there are two keys clearly marked with names/symbols and one key does something not - expected (i.e. she/he then tries the other). + expected (and the user then tries the other). The cases where Backspace/Delete is mapped to some other key combination are rare, and in those cases, normal-erase-is-backspace can be turned on manually. */ have_keys = Qnil; - kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd); - if (kb) + kb = FRAME_DISPLAY_INFO (f)->xkb_desc; + if (kb && kb->names) { - int delete_keycode = 0, backspace_keycode = 0, i; - - if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success) + for (i = kb->min_key_code; (i < kb->max_key_code + && (delete_keycode == 0 + || backspace_keycode == 0)); + ++i) { - for (i = kb->min_key_code; - (i < kb->max_key_code - && (delete_keycode == 0 || backspace_keycode == 0)); - ++i) - { - /* The XKB symbolic key names can be seen most easily in - the PS file generated by `xkbprint -label name - $DISPLAY'. */ - if (memcmp ("DELE", kb->names->keys[i].name, 4) == 0) - delete_keycode = i; - else if (memcmp ("BKSP", kb->names->keys[i].name, 4) == 0) - backspace_keycode = i; - } - - XkbFreeNames (kb, 0, True); + /* The XKB symbolic key names can be seen most easily in + the PS file generated by `xkbprint -label name + $DISPLAY'. */ + if (!memcmp ("DELE", kb->names->keys[i].name, 4)) + delete_keycode = i; + else if (!memcmp ("BKSP", kb->names->keys[i].name, 4)) + backspace_keycode = i; } - /* As of libX11-1.6.2, XkbGetMap manual says that you should use - XkbFreeClientMap to free the data returned by XkbGetMap. But - this function just frees the data referenced from KB and not - KB itself. To free KB as well, call XkbFreeKeyboard. */ - XkbFreeKeyboard (kb, XkbAllMapComponentsMask, True); - - if (delete_keycode - && backspace_keycode + if (delete_keycode && backspace_keycode && XKeysymToKeycode (dpy, XK_Delete) == delete_keycode && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode) have_keys = Qt; } + else + /* The keyboard names couldn't be obtained for some reason. */ + have_keys = Qlambda; unblock_input (); return have_keys; #endif diff --git a/src/xmenu.c b/src/xmenu.c index 1452b3c6d1..9d35e3529f 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1521,26 +1521,15 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, if (use_pos_func) { - Window dummy_window; - /* Not invoked by a click. pop up at x/y. */ pos_func = menu_position_func; /* Adjust coordinates to be root-window-relative. */ block_input (); - XTranslateCoordinates (FRAME_X_DISPLAY (f), - - /* From-window, to-window. */ - FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->root_window, - - /* From-position, to-position. */ - x, y, &x, &y, - - /* Child of win. */ - &dummy_window); + x_translate_coordinates_to_root (f, x, y, &x, &y); #ifdef HAVE_GTK3 - /* Use window scaling factor to adjust position for hidpi screens. */ + /* Use window scaling factor to adjust position for scaled + outputs. */ x /= xg_get_scale (f); y /= xg_get_scale (f); #endif @@ -1743,7 +1732,6 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, XButtonPressedEvent *event = &(dummy.xbutton); LWLIB_ID menu_id; Widget menu; - Window dummy_window; #if defined HAVE_XINPUT2 && defined USE_MOTIF XEvent property_dummy; Atom property_atom; @@ -1775,17 +1763,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Adjust coordinates to be root-window-relative. */ block_input (); x += FRAME_LEFT_SCROLL_BAR_AREA_WIDTH (f); - XTranslateCoordinates (FRAME_X_DISPLAY (f), - - /* From-window, to-window. */ - FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->root_window, - - /* From-position, to-position. */ - x, y, &x, &y, - - /* Child of win. */ - &dummy_window); + x_translate_coordinates_to_root (f, x, y, &x, &y); unblock_input (); event->x_root = x; @@ -2569,9 +2547,6 @@ Lisp_Object x_menu_show (struct frame *f, int x, int y, int menuflags, Lisp_Object title, const char **error_name) { -#ifdef HAVE_X_WINDOWS - Window dummy_window; -#endif Window root; XMenu *menu; int pane, selidx, lpane, status; @@ -2620,17 +2595,7 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, inhibit_garbage_collection (); #ifdef HAVE_X_WINDOWS - XTranslateCoordinates (FRAME_X_DISPLAY (f), - - /* From-window, to-window. */ - FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->root_window, - - /* From-position, to-position. */ - x, y, &x, &y, - - /* Child of win. */ - &dummy_window); + x_translate_coordinates_to_root (f, x, y, &x, &y); #else /* MSDOS without X support. */ x += f->left_pos; diff --git a/src/xselect.c b/src/xselect.c index 66782d4172..498c28af53 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2376,12 +2376,19 @@ On Nextstep, TERMINAL is unused. */) { Window owner; Atom atom; +#ifdef HAVE_XFIXES + Window temp_owner; +#endif struct frame *f = frame_for_x_selection (terminal); struct x_display_info *dpyinfo; CHECK_SYMBOL (selection); - if (NILP (selection)) selection = QPRIMARY; - if (EQ (selection, Qt)) selection = QSECONDARY; + + if (NILP (selection)) + selection = QPRIMARY; + + if (EQ (selection, Qt)) + selection = QSECONDARY; if (!f) return Qnil; @@ -2392,10 +2399,22 @@ On Nextstep, TERMINAL is unused. */) return Qt; atom = symbol_to_x_atom (dpyinfo, selection); - if (atom == 0) return Qnil; + + if (!atom) + return Qnil; + +#ifdef HAVE_XFIXES + /* See if this information can be obtained without a roundtrip. */ + temp_owner = x_find_selection_owner (dpyinfo, atom); + + if (temp_owner != X_INVALID_WINDOW) + return (temp_owner != None ? Qt : Qnil); +#endif + block_input (); owner = XGetSelectionOwner (dpyinfo->display, atom); unblock_input (); + return (owner ? Qt : Qnil); } diff --git a/src/xterm.c b/src/xterm.c index ee6db62bb9..07a8c5e1c3 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13659,6 +13659,43 @@ x_translate_coordinates (struct frame *f, int root_x, int root_y, } } +/* Translate the given coordinates from the edit window of FRAME, + taking into account any cached root window offsets. This is mainly + used from the popup menu code. */ + +void +x_translate_coordinates_to_root (struct frame *f, int x, int y, + int *x_out, int *y_out) +{ + struct x_output *output; + Window dummy; + + output = FRAME_X_OUTPUT (f); + + if (output->window_offset_certain_p) + { + /* Use the cached root window offset. */ + *x_out = x + output->root_x; + *y_out = y + output->root_y; + + return; + } + + /* Otherwise, do the transform manually and compute and cache the + root window position. */ + if (!XTranslateCoordinates (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->root_window, + x, y, x_out, y_out, &dummy)) + *x_out = 0, *y_out = 0; + else + { + /* Cache the root window offset of the edit window. */ + output->window_offset_certain_p = true; + output->root_x = *x_out - x; + output->root_y = *y_out - y; + } +} + /* The same, but for an XIDeviceEvent. */ #ifdef HAVE_XINPUT2 @@ -17816,6 +17853,44 @@ x_handle_wm_state (struct frame *f, struct input_event *ie) XFree (data); } +#ifdef HAVE_XFIXES + +static void +x_handle_selection_monitor_event (struct x_display_info *dpyinfo, + XEvent *event) +{ + XFixesSelectionNotifyEvent *notify; + int i; + + notify = (XFixesSelectionNotifyEvent *) event; + + if (notify->window != dpyinfo->selection_tracking_window) + return; + + for (i = 0; i < dpyinfo->n_monitored_selections; ++i) + { + /* We don't have to keep track of timestamps here. */ + if (notify->selection == dpyinfo->monitored_selections[i].name) + dpyinfo->monitored_selections[i].owner = notify->owner; + } +} + +Window +x_find_selection_owner (struct x_display_info *dpyinfo, Atom selection) +{ + int i; + + for (i = 0; i < dpyinfo->n_monitored_selections; ++i) + { + if (selection == dpyinfo->monitored_selections[i].name) + return dpyinfo->monitored_selections[i].owner; + } + + return X_INVALID_WINDOW; +} + +#endif + /* Handles the XEvent EVENT on display DPYINFO. *FINISH is X_EVENT_GOTO_OUT if caller should stop reading events. @@ -20495,7 +20570,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { int old_left = f->left_pos; int old_top = f->top_pos; - Lisp_Object frame = Qnil; + Lisp_Object frame; XSETFRAME (frame, f); @@ -23348,7 +23423,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Handle all disabled devices now, to prevent things happening out-of-order later. */ - if (ndevices) + if (n_disabled) { xi_disable_devices (dpyinfo, disabled, n_disabled); n_disabled = 0; @@ -23753,12 +23828,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, | XkbModifierMapMask | XkbVirtualModsMask), dpyinfo->xkb_desc) == Success) - XkbGetNames (dpyinfo->display, - XkbGroupNamesMask | XkbVirtualModNamesMask, + XkbGetNames (dpyinfo->display, XkbAllNamesMask, dpyinfo->xkb_desc); else { - XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True); + XkbFreeKeyboard (dpyinfo->xkb_desc, + XkbAllComponentsMask, True); dpyinfo->xkb_desc = NULL; } } @@ -23772,8 +23847,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XkbUseCoreKbd); if (dpyinfo->xkb_desc) - XkbGetNames (dpyinfo->display, - XkbGroupNamesMask | XkbVirtualModNamesMask, + XkbGetNames (dpyinfo->display, XkbAllNamesMask, dpyinfo->xkb_desc); } @@ -24063,6 +24137,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (inev.ie.kind != NO_EVENT) x_dnd_update_tooltip_now (); } +#endif +#ifdef HAVE_XFIXES + if (dpyinfo->xfixes_supported_p + && event->type == (dpyinfo->xfixes_event_base + + XFixesSelectionNotify)) + x_handle_selection_monitor_event (dpyinfo, event); #endif OTHER: #ifdef USE_X_TOOLKIT @@ -28564,6 +28644,27 @@ xi_check_toolkit (Display *display) #endif +#ifdef HAVE_XFIXES + +/* Create and return a special window for receiving events such as + selection notify events. The window is an 1x1 unmapped + override-redirect InputOnly window at -1, -1, which should prevent + it from doing anything. */ + +static Window +x_create_special_window (struct x_display_info *dpyinfo) +{ + XSetWindowAttributes attrs; + + attrs.override_redirect = True; + + return XCreateWindow (dpyinfo->display, dpyinfo->root_window, + -1, -1, 1, 1, 0, CopyFromParent, InputOnly, + CopyFromParent, CWOverrideRedirect, &attrs); +} + +#endif + /* Open a connection to X display DISPLAY_NAME, and return the structure that describes the open display. If obtaining the XCB connection or toolkit-specific display fails, return NULL. Signal @@ -28585,6 +28686,22 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) GdkDisplay *gdpy; GdkScreen *gscr; #endif +#ifdef HAVE_XFIXES + Lisp_Object tem, lisp_name; + int num_fast_selections; + Atom selection_name; +#ifdef USE_XCB + xcb_get_selection_owner_cookie_t *selection_cookies; + xcb_get_selection_owner_reply_t *selection_reply; + xcb_generic_error_t *selection_error; +#endif +#endif + int i; + + USE_SAFE_ALLOCA; + + /* Avoid warnings when SAFE_ALLOCA is not actually used. */ + ((void) SAFE_ALLOCA (0)); block_input (); @@ -28737,12 +28854,14 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #endif unblock_input (); + + SAFE_FREE (); return 0; } #ifdef USE_XCB xcb_conn = XGetXCBConnection (dpy); - if (xcb_conn == 0) + if (!xcb_conn) { #ifdef USE_GTK xg_display_close (dpy); @@ -28755,6 +28874,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #endif /* ! USE_GTK */ unblock_input (); + + SAFE_FREE (); return 0; } #endif @@ -29307,8 +29428,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) XkbUseCoreKbd); if (dpyinfo->xkb_desc) - XkbGetNames (dpyinfo->display, - XkbGroupNamesMask | XkbVirtualModNamesMask, + XkbGetNames (dpyinfo->display, XkbAllNamesMask, dpyinfo->xkb_desc); XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd, @@ -29318,9 +29438,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #endif #ifdef HAVE_XFIXES - int xfixes_event_base, xfixes_error_base; + int xfixes_error_base; dpyinfo->xfixes_supported_p - = XFixesQueryExtension (dpyinfo->display, &xfixes_event_base, + = XFixesQueryExtension (dpyinfo->display, + &dpyinfo->xfixes_event_base, &xfixes_error_base); if (dpyinfo->xfixes_supported_p) @@ -29371,7 +29492,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) XScreenNumberOfScreen (dpyinfo->screen)); { - int i; enum { atom_count = ARRAYELTS (x_atom_refs) }; /* 1 for _XSETTINGS_SN. */ enum { total_atom_count = 2 + atom_count }; @@ -29539,8 +29659,100 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->protected_windows_max = 256; #endif +#ifdef HAVE_XFIXES + /* Initialize selection tracking for the selections in + x-fast-selection-list. */ + + if (CONSP (Vx_fast_selection_list) + && dpyinfo->xfixes_supported_p + && dpyinfo->xfixes_major >= 1) + { + num_fast_selections = 0; + tem = Vx_fast_selection_list; + + FOR_EACH_TAIL_SAFE (tem) + { + if (!SYMBOLP (XCAR (tem))) + continue; + + num_fast_selections++; + } + + dpyinfo->n_monitored_selections = num_fast_selections; + dpyinfo->selection_tracking_window + = x_create_special_window (dpyinfo); + dpyinfo->monitored_selections + = xmalloc (num_fast_selections + * sizeof *dpyinfo->monitored_selections); + + num_fast_selections = 0; + tem = Vx_fast_selection_list; + + FOR_EACH_TAIL_SAFE (tem) + { + lisp_name = XCAR (tem); + + if (!SYMBOLP (lisp_name)) + continue; + + selection_name = symbol_to_x_atom (dpyinfo, lisp_name); + dpyinfo->monitored_selections[num_fast_selections++].name + = selection_name; + dpyinfo->monitored_selections[num_fast_selections - 1].owner + = X_INVALID_WINDOW; + + /* Select for selection input. */ + XFixesSelectSelectionInput (dpyinfo->display, + dpyinfo->selection_tracking_window, + selection_name, + (XFixesSetSelectionOwnerNotifyMask + | XFixesSetSelectionOwnerNotifyMask + | XFixesSelectionClientCloseNotifyMask)); + } + +#ifdef USE_XCB + selection_cookies = SAFE_ALLOCA (sizeof *selection_cookies + * num_fast_selections); +#endif + + /* Now, ask for the current owners of all those selections. */ + for (i = 0; i < num_fast_selections; ++i) + { +#ifdef USE_XCB + selection_cookies[i] + = xcb_get_selection_owner (dpyinfo->xcb_connection, + dpyinfo->monitored_selections[i].name); +#else + dpyinfo->monitored_selections[i].owner + = XGetSelectionOwner (dpyinfo->display, + dpyinfo->monitored_selections[i].name); +#endif + } + +#ifdef USE_XCB + for (i = 0; i < num_fast_selections; ++i) + { + selection_reply + = xcb_get_selection_owner_reply (dpyinfo->xcb_connection, + selection_cookies[i], + &selection_error); + + if (selection_reply) + { + dpyinfo->monitored_selections[i].owner + = selection_reply->owner; + free (selection_reply); + } + else if (selection_error) + free (selection_error); + } +#endif + } +#endif + unblock_input (); + SAFE_FREE (); return dpyinfo; } @@ -29676,6 +29888,10 @@ x_delete_display (struct x_display_info *dpyinfo) xfree (dpyinfo->x_id_name); xfree (dpyinfo->x_dnd_atoms); xfree (dpyinfo->color_cells); +#ifdef HAVE_XFIXES + if (dpyinfo->monitored_selections) + xfree (dpyinfo->monitored_selections); +#endif #ifdef USE_TOOLKIT_SCROLL_BARS xfree (dpyinfo->protected_windows); #endif @@ -30643,4 +30859,17 @@ It should accept a single argument, a string describing the locale of the input method, and return a coding system that can decode keyboard input generated by said input method. */); Vx_input_coding_function = Qnil; + + DEFVAR_LISP ("x-fast-selection-list", Vx_fast_selection_list, + doc: /* List of selections for which `x-selection-exists-p' should be fast. + +List of selection names as atoms that will be monitored by Emacs for +ownership changes when the X server supports the XFIXES extension. +The result of the monitoring is then used by `x-selection-exists-p' to +avoid a server round trip, which is important as it is called while +updating the tool bar. The value of this variable is only read upon +connection setup. */); + /* The default value of this variable is chosen so that updating the + tool bar does not require a call to _XReply. */ + Vx_fast_selection_list = list1 (QCLIPBOARD); } diff --git a/src/xterm.h b/src/xterm.h index 55fd193a29..0f00dc42f7 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -308,6 +308,22 @@ struct x_failable_request unsigned long end; }; +#ifdef HAVE_XFIXES + +struct x_monitored_selection +{ + /* The name of the selection. */ + Atom name; + + /* The current owner of the selection. */ + Window owner; +}; + +/* An invalid window. */ +#define X_INVALID_WINDOW 0xffffffff + +#endif + /* For each X display, we have a structure that records information about it. */ @@ -778,6 +794,7 @@ struct x_display_info bool xfixes_supported_p; int xfixes_major; int xfixes_minor; + int xfixes_event_base; #endif #ifdef HAVE_XSYNC @@ -828,6 +845,17 @@ struct x_display_info /* Pointer to the next request in `failable_requests'. */ struct x_failable_request *next_failable_request; +#ifdef HAVE_XFIXES + /* Array of selections being monitored and their owners. */ + struct x_monitored_selection *monitored_selections; + + /* Window used to monitor those selections. */ + Window selection_tracking_window; + + /* The number of those selections. */ + int n_monitored_selections; +#endif + /* The pending drag-and-drop time for middle-click based drag-and-drop emulation. */ Time pending_dnd_time; @@ -1656,6 +1684,10 @@ extern void x_cr_draw_frame (cairo_t *, struct frame *); extern Lisp_Object x_cr_export_frames (Lisp_Object, cairo_surface_type_t); #endif +#ifdef HAVE_XFIXES +extern Window x_find_selection_owner (struct x_display_info *, Atom); +#endif + #ifdef HAVE_XRENDER extern void x_xrender_color_from_gc_background (struct frame *, GC, XRenderColor *, bool); @@ -1664,6 +1696,8 @@ extern void x_xr_apply_ext_clip (struct frame *, GC); extern void x_xr_reset_ext_clip (struct frame *); #endif +extern void x_translate_coordinates_to_root (struct frame *, int, int, + int *, int *); extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *, int *, int *, int *, unsigned int *); commit b9aff5fdb89092b68ebd7782c8dc85e6daca14b2 Author: Lars Ingebrigtsen Date: Mon Oct 17 14:30:54 2022 +0200 Fix spurious "Compilation finished" native-comp messages * lisp/emacs-lisp/comp.el (native--compile-async): Don't start the async compilation if we didn't add anything. This avoids spurious "Compilation finished" messages in the *Async* buffer when it turned out that all the files we considered nativecomping were skipped. diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c300c44a8d..686c7aeb3d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4167,7 +4167,8 @@ bytecode definition was not changed in the meantime)." (error "LOAD must be nil, t or 'late")) (unless (listp files) (setf files (list files))) - (let (file-list) + (let ((added-something nil) + file-list) (dolist (file-or-dir files) (cond ((file-directory-p file-or-dir) (dolist (file (if recursively @@ -4195,11 +4196,15 @@ bytecode definition was not changed in the meantime)." (make-directory out-dir t)) (if (file-writable-p out-filename) (setf comp-files-queue - (append comp-files-queue `((,file . ,load)))) + (append comp-files-queue `((,file . ,load))) + added-something t) (display-warning 'comp (format "No write access for %s skipping." out-filename))))))) - (when (zerop (comp-async-runnings)) + ;; Perhaps nothing passed `native-compile-async-skip-p'? + (when (and added-something + ;; Don't start if there's one already running. + (zerop (comp-async-runnings))) (comp-run-async-workers)))) commit 5176d006114390885a3a34fd80a8e25687558edc Author: Lars Ingebrigtsen Date: Mon Oct 17 10:48:12 2022 +0200 Avoid having the async compile log saying it's compiling loaddefs * lisp/loadup.el (featurep): Define the hash table in nativecomp builds (but not otherwise). A more natural place to define this would be in comp.el, but comp.el isn't loaded yet when we load the .elc file that updates comp--no-native-compile. We could change the load order and move the definition to comp.el, though. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Allow inhibiting nativecomp earlier (bug#57627). * lisp/emacs-lisp/comp.el (native-compile-async-skip-p): Use the data. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3ceb5da804..692a87f6d5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2323,9 +2323,15 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (and byte-compile-current-file - (byte-compile-insert-header byte-compile-current-file - byte-compile--outbuffer)) + (when byte-compile-current-file + (byte-compile-insert-header byte-compile-current-file + byte-compile--outbuffer) + ;; Instruct native-comp to ignore this file. + (when (bound-and-true-p no-native-compile) + (with-current-buffer byte-compile--outbuffer + (insert + "(when (boundp 'comp--no-native-compile) + (puthash load-file-name t comp--no-native-compile))\n\n")))) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 889bffa3f5..c300c44a8d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4119,6 +4119,7 @@ the deferred compilation mechanism." LOAD and SELECTOR work as described in `native--compile-async'." ;; Make sure we are not already compiling `file' (bug#40838). (or (gethash file comp-async-compilations) + (gethash (file-name-with-extension file "elc") comp--no-native-compile) (cond ((null selector) nil) ((functionp selector) (not (funcall selector file))) diff --git a/lisp/loadup.el b/lisp/loadup.el index c01c827a75..e940a32100 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -501,7 +501,10 @@ lost after dumping"))) bin-dest-dir) ;; Relative filename from the built uninstalled binary. (file-relative-name file invocation-directory))))) - comp-loaded-comp-units-h)))) + comp-loaded-comp-units-h))) + ;; Set up the mechanism to allow inhibiting native-comp via + ;; file-local variables. + (defvar comp--no-native-compile (make-hash-table :test #'equal))) (when (hash-table-p purify-flag) (let ((strings 0)