From 28c5a764fe9b1042ee2af64f710a4c4fdedcae43 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 11 Oct 2022 22:11:04 -0700 Subject: [PATCH 2/7] 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 @@ Connection 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 @@ Connection Local Variables 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 @@ Connection Local Variables @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 @@ Connection Local Variables @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 @@ Connection Local Variables @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 9641587052..72b2331b81 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3214,6 +3214,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 f6d5d6cc27..1ae6586e70 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -618,6 +618,18 @@ connection-local-criteria-alist :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." @@ -694,6 +706,23 @@ connection-local-set-profile-variables (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 @@ -736,6 +765,15 @@ connection-local-criteria-for-default-directory :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'. @@ -743,16 +781,28 @@ with-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. @@ -764,6 +814,49 @@ with-connection-local-variables-1 ;; 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 @@ files-x-test--variables3 '((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 @@ files-x-test-connection-local-set-profile-variables (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 @@ files-x-test-hack-connection-local-variables-apply (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 @@ files-x-test-hack-connection-local-variables-apply (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 @@ files-x-test-with-connection-local-variables (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 @@ files-x-test-with-connection-local-variables (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 @@ files-x-test-with-connection-local-variables (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 @@ files-x-test-with-connection-local-variables (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 -- 2.25.1