master 3cc356abfe 2/7: Add helpers to dynamically assign connection-local values

[Jim Porter]

branch: master
commit 3cc356abfef8294abcb91dc421e3c63a561a11b4
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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'.
---
 doc/lispref/variables.texi |  98 +++++++++++++++++++++++-------
 etc/NEWS                   |   7 +++
 lisp/files-x.el            | 103 +++++++++++++++++++++++++++++--
 test/lisp/files-x-tests.el | 148 ++++++++++++++++++++++++++++++++-------------
 4 files changed, 288 insertions(+), 68 deletions(-)

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