[gnus git] branch master updated: m0-3-160-g89f1c88 =1= auth-source.el (auth-source--aput-1, auth-source--aput, auth-source--aget): New functions and macros; Use them instead of aput/aget
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 89f1c883734b81265e2d653a4c0e051ea946cdfa (commit)
from 15f52af8442c9844de0c382fcd3281f551d8733b (commit)
- Log -----------------------------------------------------------------
commit 89f1c883734b81265e2d653a4c0e051ea946cdfa
Author: Stefan Monnier <[email protected]>
Date: Sat Apr 28 23:41:56 2012 +0000
auth-source.el (auth-source--aput-1, auth-source--aput, auth-source--aget): New functions and macros; Use them instead of aput/aget
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cdfb291..608fb4b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2012-04-28 Stefan Monnier <[email protected]>
+
+ * auth-source.el (auth-source--aput-1, auth-source--aput)
+ (auth-source--aget): New functions and macros.
+ Use them instead of aput/aget.
+
2012-04-27 Andreas Schwab <[email protected]>
* gnus.el (debbugs-gnu): Don't override existing autoload definition.
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index f4aa1db..a59d58e 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -42,7 +42,6 @@
(require 'password-cache)
(require 'mm-util)
(require 'gnus-util)
-(require 'assoc)
(eval-when-compile (require 'cl))
(eval-and-compile
@@ -863,6 +862,21 @@ while \(:host t) would find all host entries."
;;; Backend specific parsing: netrc/authinfo backend
+(defun auth-source--aput-1 (alist key val)
+ (let ((seen ())
+ (rest alist))
+ (while (and (consp rest) (not (equal key (caar rest))))
+ (push (pop rest) seen))
+ (cons (cons key val)
+ (if (null rest) alist
+ (nconc (nreverse seen)
+ (if (equal key (caar rest)) (cdr rest) rest))))))
+(defmacro auth-source--aput (var key val)
+ `(setq ,var (auth-source--aput-1 ,var ,key ,val)))
+
+(defun auth-source--aget (alist key)
+ (cdr (assoc key alist)))
+
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
(defun* auth-source-netrc-parse (&rest
spec
@@ -898,7 +912,8 @@ Note that the MAX parameter is used so we can exit the parse early."
;; cache all netrc files (used to be just .gpg files)
;; Store the contents of the file heavily encrypted in memory.
;; (note for the irony-impaired: they are just obfuscated)
- (aput 'auth-source-netrc-cache file
+ (auth-source--aput
+ auth-source-netrc-cache file
(list :mtime (nth 5 (file-attributes file))
:secret (lexical-let ((v (mapcar '1+ (buffer-string))))
(lambda () (apply 'string (mapcar '1- v)))))))
@@ -947,21 +962,21 @@ Note that the MAX parameter is used so we can exit the parse early."
(auth-source-search-collection
host
(or
- (aget alist "machine")
- (aget alist "host")
+ (auth-source--aget alist "machine")
+ (auth-source--aget alist "host")
t))
(auth-source-search-collection
user
(or
- (aget alist "login")
- (aget alist "account")
- (aget alist "user")
+ (auth-source--aget alist "login")
+ (auth-source--aget alist "account")
+ (auth-source--aget alist "user")
t))
(auth-source-search-collection
port
(or
- (aget alist "port")
- (aget alist "protocol")
+ (auth-source--aget alist "port")
+ (auth-source--aget alist "protocol")
t))
(or
;; the required list of keys is nil, or
@@ -1176,7 +1191,7 @@ See `auth-source-search' for details on SPEC."
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
@@ -1185,17 +1200,18 @@ See `auth-source-search' for details on SPEC."
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
@@ -1207,22 +1223,22 @@ See `auth-source-search' for details on SPEC."
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
@@ -1231,9 +1247,9 @@ See `auth-source-search' for details on SPEC."
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
@@ -1394,7 +1410,7 @@ Respects `auth-source-save-behavior'. Uses
file)
(message "Saved new authentication information to %s" file)
nil))))
- (aput 'auth-source-netrc-cache key "ran"))))
+ (auth-source--aput auth-source-netrc-cache key "ran"))))
;;; Backend specific parsing: Secrets API backend
@@ -1619,7 +1635,7 @@ authentication tokens:
;; just the value otherwise
(t (symbol-value br)))))
(when br-choice
- (aput 'valist br br-choice)))))
+ (auth-source--aput valist br br-choice)))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
@@ -1628,17 +1644,18 @@ authentication tokens:
collect (nth i spec))))
(dolist (k keys)
(when (equal (symbol-name k) name)
- (aput 'valist er (plist-get spec k))))))
+ (auth-source--aput valist er (plist-get spec k))))))
;; for each required element
(dolist (r required)
- (let* ((data (aget valist r))
+ (let* ((data (auth-source--aget valist r))
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
(intern (format ":%s" r) obarray))))
;; this is the default to be offered
- (given-default (aget auth-source-creation-defaults r))
+ (given-default (auth-source--aget
+ auth-source-creation-defaults r))
;; the default supplementals are simple:
;; for the user, try `given-default' and then (user-login-name);
;; otherwise take `given-default'
@@ -1650,22 +1667,22 @@ authentication tokens:
(cons 'user
(or
(auth-source-netrc-element-or-first
- (aget valist 'user))
+ (auth-source--aget valist 'user))
(plist-get artificial :user)
"[any user]"))
(cons 'host
(or
(auth-source-netrc-element-or-first
- (aget valist 'host))
+ (auth-source--aget valist 'host))
(plist-get artificial :host)
"[any host]"))
(cons 'port
(or
(auth-source-netrc-element-or-first
- (aget valist 'port))
+ (auth-source--aget valist 'port))
(plist-get artificial :port)
"[any port]"))))
- (prompt (or (aget auth-source-creation-prompts r)
+ (prompt (or (auth-source--aget auth-source-creation-prompts r)
(case r
(secret "%p password for %u@%h: ")
(user "%p user name for %h: ")
@@ -1674,16 +1691,17 @@ authentication tokens:
(format "Enter %s (%%u@%%h:%%p): " r)))
(prompt (auth-source-format-prompt
prompt
- `((?u ,(aget printable-defaults 'user))
- (?h ,(aget printable-defaults 'host))
- (?p ,(aget printable-defaults 'port))))))
+ `((?u ,(auth-source--aget printable-defaults 'user))
+ (?h ,(auth-source--aget printable-defaults 'host))
+ (?p ,(auth-source--aget printable-defaults 'port))))))
;; Store the data, prompting for the password if needed.
(setq data (or data
(if (eq r 'secret)
(or (eval default) (read-passwd prompt))
(if (stringp default)
- (read-string (if (string-match ": *\\'" prompt)
+ (read-string
+ (if (string-match ": *\\'" prompt)
(concat (substring prompt 0 (match-beginning 0))
" (default " default "): ")
(concat prompt "(default " default ") "))
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 6 +++
lisp/auth-source.el | 98 ++++++++++++++++++++++++++++++---------------------
2 files changed, 64 insertions(+), 40 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project