From 67654fe96577823e6fcbd3e88b9779653f8b6201 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 12 Dec 2023 17:39:51 +0100 Subject: [PATCH] New macro connection-local-p * doc/lispref/variables.texi (Applying Connection Local Variables): Add macro 'connection-local-p'. * etc/NEWS: Add macro `connection-local-p'. * lisp/files-x.el (connection-local-p): New macro. (connection-local-value): Add debug declaration. * lisp/net/tramp-compat.el (tramp-compat-connection-local-p): New macro. * lisp/net/tramp-crypt.el (tramp-crypt-cleanup-connection): Bind `tramp-crypt-enabled'. * test/lisp/files-x-tests.el (files-x-test-connection-local-value): * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes) (tramp-test35-remote-path): Adapt tests. --- doc/lispref/variables.texi | 9 ++++++++- etc/NEWS | 7 ++++--- lisp/files-x.el | 14 ++++++++++++++ lisp/net/tramp-compat.el | 12 ++++++++++++ lisp/net/tramp-crypt.el | 3 ++- test/lisp/files-x-tests.el | 17 ++++++++++++++++- test/lisp/net/tramp-tests.el | 4 +++- 7 files changed, 59 insertions(+), 7 deletions(-) diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 36468bddffa..85a28c1d9c1 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -2487,7 +2487,7 @@ are unwound. Example: @defvar connection-local-default-application The default application, a symbol, to be applied in -@code{with-connection-local-variables} and +@code{with-connection-local-variables}, @code{connection-local-p} and @code{connection-local-value}. It defaults to @code{tramp}, but you can let-bind it to change the application temporarily (@pxref{Local Variables}). @@ -2546,6 +2546,13 @@ profile. This variable must not be changed globally. @end defvar +@defmac connection-local-p symbol &optional application +This macro returns non-@code{nil} if @var{symbol} has a +connection-local binding for @var{application}. If @var{application} +is @code{nil}, the value of +@code{connection-local-default-application} is used. +@end defmac + @defmac connection-local-value symbol &optional application This macro returns the connection-local value of @var{symbol} for @var{application}. If @var{application} is @code{nil}, the value of diff --git a/etc/NEWS b/etc/NEWS index 33afb34b029..1ff2f8a149f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1655,9 +1655,10 @@ dir-locals file to modify. ** Connection local variables +++ -*** New macro 'connection-local-value'. -This macro returns the connection-local value of a variable if any, or -its current value. +*** New macros 'connection-local-p' and 'connection-local-value'. +The former macro returns non-nil if a variable has a connection-local +binding. The latter macro returns the connection-local value of a +variable if any, or its current value. * Changes in Emacs 30.1 on Non-Free Operating Systems diff --git a/lisp/files-x.el b/lisp/files-x.el index 282cc79f26e..41d9cd3bab8 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -926,6 +926,19 @@ earlier in the `setq-connection-local'. The return value of the connection-local-criteria connection-local-profile-name-for-setq))))) +;;;###autoload +(defmacro connection-local-p (variable &optional application) + "Non-nil if VARIABLE has a connection-local binding in `default-directory'. +If APPLICATION is nil, the value of +`connection-local-default-application' is used." + (declare (debug (symbolp &optional form))) + (unless (symbolp variable) + (signal 'wrong-type-argument (list 'symbolp variable))) + `(let (connection-local-variables-alist file-local-variables-alist) + (hack-connection-local-variables + (connection-local-criteria-for-default-directory ,application)) + (and (assq ',variable connection-local-variables-alist) t))) + ;;;###autoload (defmacro connection-local-value (variable &optional application) "Return connection-local VARIABLE for APPLICATION in `default-directory'. @@ -933,6 +946,7 @@ If APPLICATION is nil, the value of `connection-local-default-application' is used. If VARIABLE does not have a connection-local binding, the return value is the default binding of the variable." + (declare (debug (symbolp &optional form))) (unless (symbolp variable) (signal 'wrong-type-argument (list 'symbolp variable))) `(let (connection-local-variables-alist file-local-variables-alist) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 22ee5b32717..820d9f07883 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -307,6 +307,18 @@ Also see `ignore'." ?\N{KHMER SIGN CAMNUC PII KUUH}) "List of characters equivalent to trailing colon in \"password\" prompts.")) +;; Macro `connection-local-p' is new in Emacs 30.1. +(if (macrop 'connection-local-p) + (defalias 'tramp-compat-connection-local-p #'connection-local-p) + (defmacro tramp-compat-connection-local-p (variable &optional application) + "Non-nil if VARIABLE has a connection-local binding in `default-directory'. +If APPLICATION is nil, the value of +`connection-local-default-application' is used." + `(let (connection-local-variables-alist file-local-variables-alist) + (hack-connection-local-variables + (connection-local-criteria-for-default-directory ,application)) + (and (assq ',variable connection-local-variables-alist) t)))) + (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (function-put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 0d79f88f10c..0680fcbe8c9 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -859,7 +859,8 @@ WILDCARD is not supported." "Cleanup crypt resources determined by VEC." (let ((tramp-cleanup-connection-hook (remove - #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook))) + #'tramp-crypt-cleanup-connection tramp-cleanup-connection-hook)) + (tramp-crypt-enabled t)) (dolist (dir tramp-crypt-directories) (when (tramp-file-name-equal-p vec (tramp-dissect-file-name dir)) (tramp-cleanup-connection (tramp-crypt-dissect-file-name dir)))))) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 795d03a071d..c7a56611497 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -39,6 +39,7 @@ (defconst files-x-test--variables5 '((remote-lazy-var . nil) (remote-null-device . "/dev/null"))) +(defvar remote-shell-file-name) (defvar remote-null-device) (defvar remote-lazy-var nil) (put 'remote-shell-file-name 'safe-local-variable #'identity) @@ -497,8 +498,10 @@ If it's not initialized yet, initialize it." (connection-local-set-profiles nil 'remote-ksh 'remote-nullfile) + (connection-local-set-profile-variables + 'remote-lazy files-x-test--variables5) (connection-local-set-profiles - files-x-test--application 'remote-bash) + files-x-test--application 'remote-lazy 'remote-bash) (with-temp-buffer ;; We need a remote `default-directory'. @@ -512,24 +515,36 @@ If it's not initialized yet, initialize it." (should (string-equal (symbol-value 'remote-null-device) "null")) ;; The proper variable values are set. + (should (connection-local-p remote-shell-file-name)) (should (string-equal (connection-local-value remote-shell-file-name) "/bin/ksh")) + (should (connection-local-p remote-null-device)) (should (string-equal (connection-local-value remote-null-device) "/dev/null")) + (should-not (connection-local-p remote-lazy-var)) ;; Run with a different application. + (should + (connection-local-p + remote-shell-file-name (cadr files-x-test--application))) (should (string-equal (connection-local-value remote-shell-file-name (cadr files-x-test--application)) "/bin/bash")) + (should + (connection-local-p + remote-null-device (cadr files-x-test--application))) (should (string-equal (connection-local-value remote-null-device (cadr files-x-test--application)) "/dev/null")) + (should + (connection-local-p + remote-lazy-var (cadr files-x-test--application))) ;; The previous bindings haven't changed. (should-not connection-local-variables-alist) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d8932a28e4d..68bf928eb62 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3811,7 +3811,7 @@ This tests also `access-file', `file-readable-p', (should (eq (file-attribute-type attr) t))) ;; Cleanup. - (ignore-errors (delete-directory tmp-name1)) + (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name2)))))) @@ -6360,6 +6360,8 @@ INPUT, if non-nil, is a string sent to the process." (tramp-remote-path tramp-remote-path) (orig-tramp-remote-path tramp-remote-path) path) + ;; The "flatpak" method modifies `tramp-remote-path'. + (skip-unless (not (tramp-compat-connection-local-p tramp-remote-path))) (unwind-protect (progn ;; Non existing directories are removed. -- 2.39.2