mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-23 10:34:07 +00:00
Fix Bug#32090
* lisp/files-x.el (connection-local-normalize-criteria): Do not use PROPERTIES anymore. (connection-local-get-profiles): Rewrite, in order to accept any property as optional. (Bug#32090) (connection-local-set-profiles): Adapt ´connection-local-normalize-criteria' call. * test/lisp/files-x-tests.el (files-x-test-connection-local-set-profiles) (files-x-test-hack-connection-local-variables-apply): Extend tests.
This commit is contained in:
parent
848f0f73e9
commit
917158f8c9
@ -578,31 +578,33 @@ strings. All properties are optional; if CRITERIA is nil, it
|
||||
always applies.
|
||||
PROFILES is a list of connection profiles (symbols).")
|
||||
|
||||
(defsubst connection-local-normalize-criteria (criteria &rest properties)
|
||||
"Normalize plist CRITERIA according to PROPERTIES.
|
||||
Return a new ordered plist list containing only property names from PROPERTIES."
|
||||
(delq
|
||||
nil
|
||||
(defsubst connection-local-normalize-criteria (criteria)
|
||||
"Normalize plist CRITERIA according to properties.
|
||||
Return a reordered plist."
|
||||
(apply
|
||||
'append
|
||||
(mapcar
|
||||
(lambda (property)
|
||||
(when (and (plist-member criteria property) (plist-get criteria property))
|
||||
(list property (plist-get criteria property))))
|
||||
properties)))
|
||||
'(:application :protocol :user :machine))))
|
||||
|
||||
(defsubst connection-local-get-profiles (criteria)
|
||||
"Return the connection profiles list for CRITERIA.
|
||||
CRITERIA is a plist identifying a connection and the application
|
||||
using this connection, see `connection-local-criteria-alist'."
|
||||
(or (cdr
|
||||
(assoc
|
||||
(connection-local-normalize-criteria
|
||||
criteria :application :protocol :user :machine)
|
||||
connection-local-criteria-alist))
|
||||
;; Try it without :application.
|
||||
(cdr
|
||||
(assoc
|
||||
(connection-local-normalize-criteria criteria :protocol :user :machine)
|
||||
connection-local-criteria-alist))))
|
||||
(let (profiles)
|
||||
(dolist (crit-alist connection-local-criteria-alist)
|
||||
(let ((crit criteria)
|
||||
(match t))
|
||||
(while (and crit match)
|
||||
(when (plist-member (car crit-alist) (car crit))
|
||||
(setq match (equal (plist-get (car crit-alist) (car crit))
|
||||
(plist-get criteria (car crit)))))
|
||||
(setq crit (cddr crit)))
|
||||
(when match
|
||||
(setq profiles (append profiles (cdr crit-alist))))))
|
||||
(delete-dups profiles)))
|
||||
|
||||
;;;###autoload
|
||||
(defun connection-local-set-profiles (criteria &rest profiles)
|
||||
@ -621,8 +623,7 @@ variables for a connection profile are defined using
|
||||
(dolist (profile profiles)
|
||||
(unless (assq profile connection-local-profile-alist)
|
||||
(error "No such connection profile `%s'" (symbol-name profile))))
|
||||
(let* ((criteria (connection-local-normalize-criteria
|
||||
criteria :application :protocol :user :machine))
|
||||
(let* ((criteria (connection-local-normalize-criteria criteria))
|
||||
(slot (assoc criteria connection-local-criteria-alist)))
|
||||
(if slot
|
||||
(setcdr slot (delete-dups (append (cdr slot) profiles)))
|
||||
|
@ -101,15 +101,19 @@
|
||||
(setq files-x-test--criteria
|
||||
(append files-x-test--application files-x-test--protocol
|
||||
files-x-test--user files-x-test--machine))
|
||||
|
||||
;; An empty variable list is accepted (but makes no sense).
|
||||
(connection-local-set-profiles files-x-test--criteria)
|
||||
(should-not (connection-local-get-profiles files-x-test--criteria))
|
||||
|
||||
;; First test, all declared properties.
|
||||
(connection-local-set-profiles
|
||||
files-x-test--criteria 'remote-bash 'remote-ksh)
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-bash remote-ksh)))
|
||||
|
||||
;; Changing the order of properties doesn't matter.
|
||||
(setq files-x-test--criteria
|
||||
(append files-x-test--protocol files-x-test--application
|
||||
@ -118,12 +122,14 @@
|
||||
(equal
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-bash remote-ksh)))
|
||||
;; A further call adds profiles.
|
||||
|
||||
;; A further call adds profiles.
|
||||
(connection-local-set-profiles files-x-test--criteria 'remote-nullfile)
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-bash remote-ksh remote-nullfile)))
|
||||
|
||||
;; Adding existing profiles doesn't matter.
|
||||
(connection-local-set-profiles
|
||||
files-x-test--criteria 'remote-bash 'remote-nullfile)
|
||||
@ -132,31 +138,38 @@
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-bash remote-ksh remote-nullfile)))
|
||||
|
||||
;; Use a criteria without application.
|
||||
(setq files-x-test--criteria
|
||||
(append files-x-test--protocol
|
||||
files-x-test--user files-x-test--machine))
|
||||
(connection-local-set-profiles files-x-test--criteria 'remote-ksh)
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-ksh)))
|
||||
;; An application not used in any registered criteria matches also this.
|
||||
(setq files-x-test--criteria
|
||||
(append files-x-test--another-application files-x-test--protocol
|
||||
files-x-test--user files-x-test--machine))
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles files-x-test--criteria)
|
||||
'(remote-ksh)))
|
||||
;; Use different properties.
|
||||
(dolist (criteria
|
||||
`(;; All properties.
|
||||
,(append files-x-test--application files-x-test--protocol
|
||||
files-x-test--user files-x-test--machine)
|
||||
;; Without :application.
|
||||
,(append files-x-test--protocol
|
||||
files-x-test--user files-x-test--machine)
|
||||
;; Without :protocol.
|
||||
,(append files-x-test--application
|
||||
files-x-test--user files-x-test--machine)
|
||||
;; Without :user.
|
||||
,(append files-x-test--application files-x-test--protocol
|
||||
files-x-test--machine)
|
||||
;; Without :machine.
|
||||
,(append files-x-test--application files-x-test--protocol
|
||||
files-x-test--user)
|
||||
;; No property at all.
|
||||
nil))
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles criteria)
|
||||
'(remote-bash remote-ksh remote-nullfile))))
|
||||
|
||||
;; Using a nil criteria also works. Duplicate profiles are trashed.
|
||||
(connection-local-set-profiles
|
||||
nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash)
|
||||
;; This matches also the existing profiles from other criteria.
|
||||
(should
|
||||
(equal
|
||||
(connection-local-get-profiles nil)
|
||||
'(remote-bash remote-ksh)))
|
||||
'(remote-bash remote-ksh remote-nullfile)))
|
||||
|
||||
;; A criteria other than plist is wrong.
|
||||
(should-error (connection-local-set-profiles 'dummy))))
|
||||
@ -235,7 +248,9 @@
|
||||
;; declare same variables as in `remote-bash'.
|
||||
(should
|
||||
(equal connection-local-variables-alist
|
||||
(nreverse (copy-tree files-x-test--variables1))))
|
||||
(append
|
||||
(nreverse (copy-tree files-x-test--variables3))
|
||||
(nreverse (copy-tree files-x-test--variables1)))))
|
||||
;; The variables exist also as local variables.
|
||||
(should (local-variable-p 'remote-shell-file-name))
|
||||
;; The proper variable value is set.
|
||||
|
Loading…
Reference in New Issue
Block a user