master 1908d2aefb2 2/4: New macro connection-local-value

[Michael Albinus]

branch: master
commit 1908d2aefb2175875b837bafa1a4f1299a4bdb52
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    New macro connection-local-value
    
    * doc/lispref/variables.texi (Applying Connection Local Variables):
    Add macro 'connection-local-value'.
    
    * etc/NEWS: Add macro 'connection-local-value'.
    
    * lisp/files-x.el (connection-local-value): New macro.
    (path-separator, null-device): Use it.
    
    * test/lisp/files-x-tests.el
    (files-x-test-connection-local-value): New test.
---
 doc/lispref/variables.texi |  6 +++++
 etc/NEWS                   |  7 ++++++
 lisp/files-x.el            | 19 ++++++++++++---
 test/lisp/files-x-tests.el | 61 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 90 insertions(+), 3 deletions(-)

diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index f575b188fc6..bf5fbe84407 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -2545,6 +2545,12 @@ profile.
 This variable must not be changed globally.
 @end defvar
 
+@defmac connection-local-value symbol &optional application
+This macro returns the connection-local value of @var{symbol} for
+@var{application}.  If @var{symbol} does not have a connection-local
+binding, the value is the default binding of the variable.
+@end defmac
+
 @defvar enable-connection-local-variables
 If @code{nil}, connection-local variables are ignored.  This variable
 shall be changed temporarily only in special modes.
diff --git a/etc/NEWS b/etc/NEWS
index 6e6ada42e46..8f3d8dea2a9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1641,6 +1641,13 @@ A 5th argument, optional, has been added to
 'modify-dir-local-variable'.  It can be used to specify which
 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.
+
 
 * Changes in Emacs 30.1 on Non-Free Operating Systems
 
diff --git a/lisp/files-x.el b/lisp/files-x.el
index a8d525ec5ff..b2a9cf9bc5e 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -925,18 +925,31 @@ earlier in the `setq-connection-local'.  The return value 
of the
           connection-local-criteria
           connection-local-profile-name-for-setq)))))
 
+;;;###autoload
+(defmacro connection-local-value (variable &optional application)
+  "Return connection-local VARIABLE for APPLICATION in `default-directory'.
+If VARIABLE does not have a connection-local binding, the value
+is the default binding of the variable."
+  (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))
+     (if-let ((result (assq ',variable connection-local-variables-alist)))
+         (cdr result)
+       ,variable)))
+
 ;;;###autoload
 (defun path-separator ()
   "The connection-local value of `path-separator'."
-  (with-connection-local-variables path-separator))
+  (connection-local-value path-separator))
 
 ;;;###autoload
 (defun null-device ()
   "The connection-local value of `null-device'."
-  (with-connection-local-variables null-device))
+  (connection-local-value null-device))
 
 
-
 (provide 'files-x)
 
 ;;; files-x.el ends here
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index 4e14ae68fb8..795d03a071d 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -482,5 +482,66 @@ If it's not initialized yet, initialize it."
      `(connection-local-profile-alist ',clpa now)
      `(connection-local-criteria-alist ',clca now))))
 
+(ert-deftest files-x-test-connection-local-value ()
+  "Test getting connection-local values."
+
+  (let ((clpa connection-local-profile-alist)
+       (clca connection-local-criteria-alist))
+    (connection-local-set-profile-variables
+     'remote-bash files-x-test--variables1)
+    (connection-local-set-profile-variables
+     'remote-ksh files-x-test--variables2)
+    (connection-local-set-profile-variables
+     'remote-nullfile files-x-test--variables3)
+
+    (connection-local-set-profiles
+     nil 'remote-ksh 'remote-nullfile)
+
+    (connection-local-set-profiles
+     files-x-test--application 'remote-bash)
+
+    (with-temp-buffer
+      ;; We need a remote `default-directory'.
+      (let ((enable-connection-local-variables t)
+           (default-directory "/method:host:")
+           (remote-null-device "null"))
+        (should-not connection-local-variables-alist)
+        (should-not (local-variable-p 'remote-shell-file-name))
+        (should-not (local-variable-p 'remote-null-device))
+        (should-not (boundp 'remote-shell-file-name))
+        (should (string-equal (symbol-value 'remote-null-device) "null"))
+
+        ;; The proper variable values are set.
+        (should
+         (string-equal
+          (connection-local-value remote-shell-file-name) "/bin/ksh"))
+        (should
+         (string-equal
+          (connection-local-value remote-null-device) "/dev/null"))
+
+        ;; Run with a different application.
+        (should
+         (string-equal
+          (connection-local-value
+           remote-shell-file-name (cadr files-x-test--application))
+          "/bin/bash"))
+        (should
+         (string-equal
+          (connection-local-value
+           remote-null-device (cadr files-x-test--application))
+          "/dev/null"))
+
+        ;; The previous bindings haven't changed.
+        (should-not connection-local-variables-alist)
+        (should-not (local-variable-p 'remote-shell-file-name))
+        (should-not (local-variable-p 'remote-null-device))
+        (should-not (boundp 'remote-shell-file-name))
+        (should (string-equal (symbol-value 'remote-null-device) "null"))))
+
+    ;; Cleanup.
+    (custom-set-variables
+     `(connection-local-profile-alist ',clpa now)
+     `(connection-local-criteria-alist ',clca now))))
+
 (provide 'files-x-tests)
 ;;; files-x-tests.el ends here