diff options
| author | Stefan Monnier | 2012-04-28 17:59:08 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-04-28 17:59:08 -0400 |
| commit | 8b6c19f4c23e69f2133a8432d614abdc03bdadc6 (patch) | |
| tree | 50b1ab560ca298e2cf06898ee11b1ed1df1bb000 /lisp/gnus | |
| parent | 461ef3c5186ce4df67039615b30b84b0c86d7da4 (diff) | |
| download | emacs-8b6c19f4c23e69f2133a8432d614abdc03bdadc6.tar.gz emacs-8b6c19f4c23e69f2133a8432d614abdc03bdadc6.zip | |
Avoid the obsolete `assoc' package.
* lisp/speedbar.el (speedbar-refresh): Avoid adelete.
(speedbar-file-lists): Simplify and avoid aput.
* lisp/man.el (Man--sections, Man--refpages): New vars, replacing
Man-sections-alist and Man-refpages-alist.
(Man-build-section-alist, Man-build-references-alist):
Use them; avoid aput.
(Man--last-section, Man--last-refpage): New vars.
(Man-follow-manual-reference): Use them.
Use the `default' arg of completing-read.
(Man-goto-section): Idem. Move prompt to the `interactive' spec.
* lisp/gnus/auth-source.el (auth-source--aput-1, auth-source--aput)
(auth-source--aget): New functions and macros.
Use them instead of aput/aget.
Diffstat (limited to 'lisp/gnus')
| -rw-r--r-- | lisp/gnus/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/gnus/auth-source.el | 98 |
2 files changed, 64 insertions, 40 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 556094ca614..cacd20ce99d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2012-04-28 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * auth-source.el (auth-source--aput-1, auth-source--aput) | ||
| 4 | (auth-source--aget): New functions and macros. | ||
| 5 | Use them instead of aput/aget. | ||
| 6 | |||
| 1 | 2012-04-27 Andreas Schwab <schwab@linux-m68k.org> | 7 | 2012-04-27 Andreas Schwab <schwab@linux-m68k.org> |
| 2 | 8 | ||
| 3 | * gnus.el (debbugs-gnu): Don't override existing autoload definition. | 9 | * gnus.el (debbugs-gnu): Don't override existing autoload definition. |
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 34fe5afe7af..d3d213a753b 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -42,7 +42,6 @@ | |||
| 42 | (require 'password-cache) | 42 | (require 'password-cache) |
| 43 | (require 'mm-util) | 43 | (require 'mm-util) |
| 44 | (require 'gnus-util) | 44 | (require 'gnus-util) |
| 45 | (require 'assoc) | ||
| 46 | 45 | ||
| 47 | (eval-when-compile (require 'cl)) | 46 | (eval-when-compile (require 'cl)) |
| 48 | (require 'eieio) | 47 | (require 'eieio) |
| @@ -853,6 +852,21 @@ while \(:host t) would find all host entries." | |||
| 853 | 852 | ||
| 854 | ;;; Backend specific parsing: netrc/authinfo backend | 853 | ;;; Backend specific parsing: netrc/authinfo backend |
| 855 | 854 | ||
| 855 | (defun auth-source--aput-1 (alist key val) | ||
| 856 | (let ((seen ()) | ||
| 857 | (rest alist)) | ||
| 858 | (while (and (consp rest) (not (equal key (caar rest)))) | ||
| 859 | (push (pop rest) seen)) | ||
| 860 | (cons (cons key val) | ||
| 861 | (if (null rest) alist | ||
| 862 | (nconc (nreverse seen) | ||
| 863 | (if (equal key (caar rest)) (cdr rest) rest)))))) | ||
| 864 | (defmacro auth-source--aput (var key val) | ||
| 865 | `(setq ,var (auth-source--aput-1 ,var ,key ,val))) | ||
| 866 | |||
| 867 | (defun auth-source--aget (alist key) | ||
| 868 | (cdr (assoc key alist))) | ||
| 869 | |||
| 856 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") | 870 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") |
| 857 | (defun* auth-source-netrc-parse (&rest | 871 | (defun* auth-source-netrc-parse (&rest |
| 858 | spec | 872 | spec |
| @@ -888,10 +902,11 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 888 | ;; cache all netrc files (used to be just .gpg files) | 902 | ;; cache all netrc files (used to be just .gpg files) |
| 889 | ;; Store the contents of the file heavily encrypted in memory. | 903 | ;; Store the contents of the file heavily encrypted in memory. |
| 890 | ;; (note for the irony-impaired: they are just obfuscated) | 904 | ;; (note for the irony-impaired: they are just obfuscated) |
| 891 | (aput 'auth-source-netrc-cache file | 905 | (auth-source--aput |
| 892 | (list :mtime (nth 5 (file-attributes file)) | 906 | auth-source-netrc-cache file |
| 893 | :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) | 907 | (list :mtime (nth 5 (file-attributes file)) |
| 894 | (lambda () (apply 'string (mapcar '1- v))))))) | 908 | :secret (lexical-let ((v (mapcar '1+ (buffer-string)))) |
| 909 | (lambda () (apply 'string (mapcar '1- v))))))) | ||
| 895 | (goto-char (point-min)) | 910 | (goto-char (point-min)) |
| 896 | ;; Go through the file, line by line. | 911 | ;; Go through the file, line by line. |
| 897 | (while (and (not (eobp)) | 912 | (while (and (not (eobp)) |
| @@ -937,21 +952,21 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 937 | (auth-source-search-collection | 952 | (auth-source-search-collection |
| 938 | host | 953 | host |
| 939 | (or | 954 | (or |
| 940 | (aget alist "machine") | 955 | (auth-source--aget alist "machine") |
| 941 | (aget alist "host") | 956 | (auth-source--aget alist "host") |
| 942 | t)) | 957 | t)) |
| 943 | (auth-source-search-collection | 958 | (auth-source-search-collection |
| 944 | user | 959 | user |
| 945 | (or | 960 | (or |
| 946 | (aget alist "login") | 961 | (auth-source--aget alist "login") |
| 947 | (aget alist "account") | 962 | (auth-source--aget alist "account") |
| 948 | (aget alist "user") | 963 | (auth-source--aget alist "user") |
| 949 | t)) | 964 | t)) |
| 950 | (auth-source-search-collection | 965 | (auth-source-search-collection |
| 951 | port | 966 | port |
| 952 | (or | 967 | (or |
| 953 | (aget alist "port") | 968 | (auth-source--aget alist "port") |
| 954 | (aget alist "protocol") | 969 | (auth-source--aget alist "protocol") |
| 955 | t)) | 970 | t)) |
| 956 | (or | 971 | (or |
| 957 | ;; the required list of keys is nil, or | 972 | ;; the required list of keys is nil, or |
| @@ -1166,7 +1181,7 @@ See `auth-source-search' for details on SPEC." | |||
| 1166 | ;; just the value otherwise | 1181 | ;; just the value otherwise |
| 1167 | (t (symbol-value br))))) | 1182 | (t (symbol-value br))))) |
| 1168 | (when br-choice | 1183 | (when br-choice |
| 1169 | (aput 'valist br br-choice))))) | 1184 | (auth-source--aput valist br br-choice))))) |
| 1170 | 1185 | ||
| 1171 | ;; for extra required elements, see if the spec includes a value for them | 1186 | ;; for extra required elements, see if the spec includes a value for them |
| 1172 | (dolist (er create-extra) | 1187 | (dolist (er create-extra) |
| @@ -1175,17 +1190,18 @@ See `auth-source-search' for details on SPEC." | |||
| 1175 | collect (nth i spec)))) | 1190 | collect (nth i spec)))) |
| 1176 | (dolist (k keys) | 1191 | (dolist (k keys) |
| 1177 | (when (equal (symbol-name k) name) | 1192 | (when (equal (symbol-name k) name) |
| 1178 | (aput 'valist er (plist-get spec k)))))) | 1193 | (auth-source--aput valist er (plist-get spec k)))))) |
| 1179 | 1194 | ||
| 1180 | ;; for each required element | 1195 | ;; for each required element |
| 1181 | (dolist (r required) | 1196 | (dolist (r required) |
| 1182 | (let* ((data (aget valist r)) | 1197 | (let* ((data (auth-source--aget valist r)) |
| 1183 | ;; take the first element if the data is a list | 1198 | ;; take the first element if the data is a list |
| 1184 | (data (or (auth-source-netrc-element-or-first data) | 1199 | (data (or (auth-source-netrc-element-or-first data) |
| 1185 | (plist-get current-data | 1200 | (plist-get current-data |
| 1186 | (intern (format ":%s" r) obarray)))) | 1201 | (intern (format ":%s" r) obarray)))) |
| 1187 | ;; this is the default to be offered | 1202 | ;; this is the default to be offered |
| 1188 | (given-default (aget auth-source-creation-defaults r)) | 1203 | (given-default (auth-source--aget |
| 1204 | auth-source-creation-defaults r)) | ||
| 1189 | ;; the default supplementals are simple: | 1205 | ;; the default supplementals are simple: |
| 1190 | ;; for the user, try `given-default' and then (user-login-name); | 1206 | ;; for the user, try `given-default' and then (user-login-name); |
| 1191 | ;; otherwise take `given-default' | 1207 | ;; otherwise take `given-default' |
| @@ -1197,22 +1213,22 @@ See `auth-source-search' for details on SPEC." | |||
| 1197 | (cons 'user | 1213 | (cons 'user |
| 1198 | (or | 1214 | (or |
| 1199 | (auth-source-netrc-element-or-first | 1215 | (auth-source-netrc-element-or-first |
| 1200 | (aget valist 'user)) | 1216 | (auth-source--aget valist 'user)) |
| 1201 | (plist-get artificial :user) | 1217 | (plist-get artificial :user) |
| 1202 | "[any user]")) | 1218 | "[any user]")) |
| 1203 | (cons 'host | 1219 | (cons 'host |
| 1204 | (or | 1220 | (or |
| 1205 | (auth-source-netrc-element-or-first | 1221 | (auth-source-netrc-element-or-first |
| 1206 | (aget valist 'host)) | 1222 | (auth-source--aget valist 'host)) |
| 1207 | (plist-get artificial :host) | 1223 | (plist-get artificial :host) |
| 1208 | "[any host]")) | 1224 | "[any host]")) |
| 1209 | (cons 'port | 1225 | (cons 'port |
| 1210 | (or | 1226 | (or |
| 1211 | (auth-source-netrc-element-or-first | 1227 | (auth-source-netrc-element-or-first |
| 1212 | (aget valist 'port)) | 1228 | (auth-source--aget valist 'port)) |
| 1213 | (plist-get artificial :port) | 1229 | (plist-get artificial :port) |
| 1214 | "[any port]")))) | 1230 | "[any port]")))) |
| 1215 | (prompt (or (aget auth-source-creation-prompts r) | 1231 | (prompt (or (auth-source--aget auth-source-creation-prompts r) |
| 1216 | (case r | 1232 | (case r |
| 1217 | (secret "%p password for %u@%h: ") | 1233 | (secret "%p password for %u@%h: ") |
| 1218 | (user "%p user name for %h: ") | 1234 | (user "%p user name for %h: ") |
| @@ -1221,9 +1237,9 @@ See `auth-source-search' for details on SPEC." | |||
| 1221 | (format "Enter %s (%%u@%%h:%%p): " r))) | 1237 | (format "Enter %s (%%u@%%h:%%p): " r))) |
| 1222 | (prompt (auth-source-format-prompt | 1238 | (prompt (auth-source-format-prompt |
| 1223 | prompt | 1239 | prompt |
| 1224 | `((?u ,(aget printable-defaults 'user)) | 1240 | `((?u ,(auth-source--aget printable-defaults 'user)) |
| 1225 | (?h ,(aget printable-defaults 'host)) | 1241 | (?h ,(auth-source--aget printable-defaults 'host)) |
| 1226 | (?p ,(aget printable-defaults 'port)))))) | 1242 | (?p ,(auth-source--aget printable-defaults 'port)))))) |
| 1227 | 1243 | ||
| 1228 | ;; Store the data, prompting for the password if needed. | 1244 | ;; Store the data, prompting for the password if needed. |
| 1229 | (setq data (or data | 1245 | (setq data (or data |
| @@ -1384,7 +1400,7 @@ Respects `auth-source-save-behavior'. Uses | |||
| 1384 | file) | 1400 | file) |
| 1385 | (message "Saved new authentication information to %s" file) | 1401 | (message "Saved new authentication information to %s" file) |
| 1386 | nil)))) | 1402 | nil)))) |
| 1387 | (aput 'auth-source-netrc-cache key "ran")))) | 1403 | (auth-source--aput auth-source-netrc-cache key "ran")))) |
| 1388 | 1404 | ||
| 1389 | ;;; Backend specific parsing: Secrets API backend | 1405 | ;;; Backend specific parsing: Secrets API backend |
| 1390 | 1406 | ||
| @@ -1609,7 +1625,7 @@ authentication tokens: | |||
| 1609 | ;; just the value otherwise | 1625 | ;; just the value otherwise |
| 1610 | (t (symbol-value br))))) | 1626 | (t (symbol-value br))))) |
| 1611 | (when br-choice | 1627 | (when br-choice |
| 1612 | (aput 'valist br br-choice))))) | 1628 | (auth-source--aput valist br br-choice))))) |
| 1613 | 1629 | ||
| 1614 | ;; for extra required elements, see if the spec includes a value for them | 1630 | ;; for extra required elements, see if the spec includes a value for them |
| 1615 | (dolist (er create-extra) | 1631 | (dolist (er create-extra) |
| @@ -1618,17 +1634,18 @@ authentication tokens: | |||
| 1618 | collect (nth i spec)))) | 1634 | collect (nth i spec)))) |
| 1619 | (dolist (k keys) | 1635 | (dolist (k keys) |
| 1620 | (when (equal (symbol-name k) name) | 1636 | (when (equal (symbol-name k) name) |
| 1621 | (aput 'valist er (plist-get spec k)))))) | 1637 | (auth-source--aput valist er (plist-get spec k)))))) |
| 1622 | 1638 | ||
| 1623 | ;; for each required element | 1639 | ;; for each required element |
| 1624 | (dolist (r required) | 1640 | (dolist (r required) |
| 1625 | (let* ((data (aget valist r)) | 1641 | (let* ((data (auth-source--aget valist r)) |
| 1626 | ;; take the first element if the data is a list | 1642 | ;; take the first element if the data is a list |
| 1627 | (data (or (auth-source-netrc-element-or-first data) | 1643 | (data (or (auth-source-netrc-element-or-first data) |
| 1628 | (plist-get current-data | 1644 | (plist-get current-data |
| 1629 | (intern (format ":%s" r) obarray)))) | 1645 | (intern (format ":%s" r) obarray)))) |
| 1630 | ;; this is the default to be offered | 1646 | ;; this is the default to be offered |
| 1631 | (given-default (aget auth-source-creation-defaults r)) | 1647 | (given-default (auth-source--aget |
| 1648 | auth-source-creation-defaults r)) | ||
| 1632 | ;; the default supplementals are simple: | 1649 | ;; the default supplementals are simple: |
| 1633 | ;; for the user, try `given-default' and then (user-login-name); | 1650 | ;; for the user, try `given-default' and then (user-login-name); |
| 1634 | ;; otherwise take `given-default' | 1651 | ;; otherwise take `given-default' |
| @@ -1640,22 +1657,22 @@ authentication tokens: | |||
| 1640 | (cons 'user | 1657 | (cons 'user |
| 1641 | (or | 1658 | (or |
| 1642 | (auth-source-netrc-element-or-first | 1659 | (auth-source-netrc-element-or-first |
| 1643 | (aget valist 'user)) | 1660 | (auth-source--aget valist 'user)) |
| 1644 | (plist-get artificial :user) | 1661 | (plist-get artificial :user) |
| 1645 | "[any user]")) | 1662 | "[any user]")) |
| 1646 | (cons 'host | 1663 | (cons 'host |
| 1647 | (or | 1664 | (or |
| 1648 | (auth-source-netrc-element-or-first | 1665 | (auth-source-netrc-element-or-first |
| 1649 | (aget valist 'host)) | 1666 | (auth-source--aget valist 'host)) |
| 1650 | (plist-get artificial :host) | 1667 | (plist-get artificial :host) |
| 1651 | "[any host]")) | 1668 | "[any host]")) |
| 1652 | (cons 'port | 1669 | (cons 'port |
| 1653 | (or | 1670 | (or |
| 1654 | (auth-source-netrc-element-or-first | 1671 | (auth-source-netrc-element-or-first |
| 1655 | (aget valist 'port)) | 1672 | (auth-source--aget valist 'port)) |
| 1656 | (plist-get artificial :port) | 1673 | (plist-get artificial :port) |
| 1657 | "[any port]")))) | 1674 | "[any port]")))) |
| 1658 | (prompt (or (aget auth-source-creation-prompts r) | 1675 | (prompt (or (auth-source--aget auth-source-creation-prompts r) |
| 1659 | (case r | 1676 | (case r |
| 1660 | (secret "%p password for %u@%h: ") | 1677 | (secret "%p password for %u@%h: ") |
| 1661 | (user "%p user name for %h: ") | 1678 | (user "%p user name for %h: ") |
| @@ -1664,20 +1681,21 @@ authentication tokens: | |||
| 1664 | (format "Enter %s (%%u@%%h:%%p): " r))) | 1681 | (format "Enter %s (%%u@%%h:%%p): " r))) |
| 1665 | (prompt (auth-source-format-prompt | 1682 | (prompt (auth-source-format-prompt |
| 1666 | prompt | 1683 | prompt |
| 1667 | `((?u ,(aget printable-defaults 'user)) | 1684 | `((?u ,(auth-source--aget printable-defaults 'user)) |
| 1668 | (?h ,(aget printable-defaults 'host)) | 1685 | (?h ,(auth-source--aget printable-defaults 'host)) |
| 1669 | (?p ,(aget printable-defaults 'port)))))) | 1686 | (?p ,(auth-source--aget printable-defaults 'port)))))) |
| 1670 | 1687 | ||
| 1671 | ;; Store the data, prompting for the password if needed. | 1688 | ;; Store the data, prompting for the password if needed. |
| 1672 | (setq data (or data | 1689 | (setq data (or data |
| 1673 | (if (eq r 'secret) | 1690 | (if (eq r 'secret) |
| 1674 | (or (eval default) (read-passwd prompt)) | 1691 | (or (eval default) (read-passwd prompt)) |
| 1675 | (if (stringp default) | 1692 | (if (stringp default) |
| 1676 | (read-string (if (string-match ": *\\'" prompt) | 1693 | (read-string |
| 1677 | (concat (substring prompt 0 (match-beginning 0)) | 1694 | (if (string-match ": *\\'" prompt) |
| 1678 | " (default " default "): ") | 1695 | (concat (substring prompt 0 (match-beginning 0)) |
| 1679 | (concat prompt "(default " default ") ")) | 1696 | " (default " default "): ") |
| 1680 | nil nil default) | 1697 | (concat prompt "(default " default ") ")) |
| 1698 | nil nil default) | ||
| 1681 | (eval default))))) | 1699 | (eval default))))) |
| 1682 | 1700 | ||
| 1683 | (when data | 1701 | (when data |