diff options
| author | Teodor Zlatanov | 2011-03-10 13:32:49 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2011-03-10 13:32:49 +0000 |
| commit | f3b54b0e1e770038e9842479d88916d95f7bfa51 (patch) | |
| tree | 4bd527e4fd8cc2ada2795f6cfbe3a9b159b3d5d5 | |
| parent | f346fd6b406b8c2db3f747a23b49ba1221c2aeaf (diff) | |
| download | emacs-f3b54b0e1e770038e9842479d88916d95f7bfa51.tar.gz emacs-f3b54b0e1e770038e9842479d88916d95f7bfa51.zip | |
auth-source.el (auth-source-read-char-choice): Remove `dropdown-list'.
(auth-source-pick-first-password): New convenience function.
| -rw-r--r-- | lisp/gnus/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/gnus/auth-source.el | 53 |
2 files changed, 25 insertions, 31 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index aa1f013dd35..dbd52c5fece 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -4,8 +4,9 @@ | |||
| 4 | character choice using `dropdown-list', `read-char-choice', or | 4 | character choice using `dropdown-list', `read-char-choice', or |
| 5 | `read-char'. It appends "[a/b/c] " to the prompt if the choices were | 5 | `read-char'. It appends "[a/b/c] " to the prompt if the choices were |
| 6 | '(?a ?b ?c). The `dropdown-list' support is disabled for now. Use | 6 | '(?a ?b ?c). The `dropdown-list' support is disabled for now. Use |
| 7 | `eval-when-compile' to load `dropdown-list'. | 7 | `eval-when-compile' to load `dropdown-list'. Remove `dropdown-list'. |
| 8 | (auth-source-netrc-saver): Use it. | 8 | (auth-source-netrc-saver): Use it. |
| 9 | (auth-source-pick-first-password): New convenience function. | ||
| 9 | 10 | ||
| 10 | 2011-03-08 Teodor Zlatanov <tzz@lifelogs.com> | 11 | 2011-03-08 Teodor Zlatanov <tzz@lifelogs.com> |
| 11 | 12 | ||
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 108871974a0..b7e0c97ce50 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -44,18 +44,7 @@ | |||
| 44 | (require 'gnus-util) | 44 | (require 'gnus-util) |
| 45 | (require 'assoc) | 45 | (require 'assoc) |
| 46 | (eval-when-compile (require 'cl)) | 46 | (eval-when-compile (require 'cl)) |
| 47 | (eval-when-compile (require 'dropdown-list nil t)) | 47 | (require 'eieio) |
| 48 | (eval-and-compile | ||
| 49 | (or (ignore-errors (require 'eieio)) | ||
| 50 | ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib | ||
| 51 | (ignore-errors | ||
| 52 | (let ((load-path (cons (expand-file-name | ||
| 53 | "gnus-fallback-lib/eieio" | ||
| 54 | (file-name-directory (locate-library "gnus"))) | ||
| 55 | load-path))) | ||
| 56 | (require 'eieio))) | ||
| 57 | (error | ||
| 58 | "eieio not found in `load-path' or gnus-fallback-lib/ directory."))) | ||
| 59 | 48 | ||
| 60 | (autoload 'secrets-create-item "secrets") | 49 | (autoload 'secrets-create-item "secrets") |
| 61 | (autoload 'secrets-delete-item "secrets") | 50 | (autoload 'secrets-delete-item "secrets") |
| @@ -313,12 +302,6 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." | |||
| 313 | 302 | ||
| 314 | (while (not (memq k choices)) | 303 | (while (not (memq k choices)) |
| 315 | (setq k (cond | 304 | (setq k (cond |
| 316 | ((and nil (featurep 'dropdown-list)) | ||
| 317 | (let* ((blank (fill (copy-sequence prompt) ?.)) | ||
| 318 | (dlc (cons (format "%s %c" prompt (car choices)) | ||
| 319 | (loop for c in (cdr choices) | ||
| 320 | collect (format "%s %c" blank c))))) | ||
| 321 | (nth (dropdown-list dlc) choices))) | ||
| 322 | ((fboundp 'read-char-choice) | 305 | ((fboundp 'read-char-choice) |
| 323 | (read-char-choice full-prompt choices)) | 306 | (read-char-choice full-prompt choices)) |
| 324 | (t (message "%s" full-prompt) | 307 | (t (message "%s" full-prompt) |
| @@ -769,7 +752,26 @@ while \(:host t) would find all host entries." | |||
| 769 | (return 'no))) | 752 | (return 'no))) |
| 770 | 'no)))) | 753 | 'no)))) |
| 771 | 754 | ||
| 772 | ;;; Backend specific parsing: netrc/authinfo backend | 755 | ;;; (auth-source-pick-first-password :host "z.lifelogs.com") |
| 756 | ;;; (auth-source-pick-first-password :port "imap") | ||
| 757 | (defun auth-source-pick-first-password (&rest spec) | ||
| 758 | "Pick the first secret found from applying SPEC to `auth-source-search'." | ||
| 759 | (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1)))) | ||
| 760 | (secret (plist-get result :secret))) | ||
| 761 | |||
| 762 | (if (functionp secret) | ||
| 763 | (funcall secret) | ||
| 764 | secret))) | ||
| 765 | |||
| 766 | ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) | ||
| 767 | (defun auth-source-format-prompt (prompt alist) | ||
| 768 | "Format PROMPT using %x (for any character x) specifiers in ALIST." | ||
| 769 | (dolist (cell alist) | ||
| 770 | (let ((c (nth 0 cell)) | ||
| 771 | (v (nth 1 cell))) | ||
| 772 | (when (and c v) | ||
| 773 | (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt))))) | ||
| 774 | prompt) | ||
| 773 | 775 | ||
| 774 | (defun auth-source-ensure-strings (values) | 776 | (defun auth-source-ensure-strings (values) |
| 775 | (unless (listp values) | 777 | (unless (listp values) |
| @@ -780,6 +782,8 @@ while \(:host t) would find all host entries." | |||
| 780 | value)) | 782 | value)) |
| 781 | values)) | 783 | values)) |
| 782 | 784 | ||
| 785 | ;;; Backend specific parsing: netrc/authinfo backend | ||
| 786 | |||
| 783 | (defvar auth-source-netrc-cache nil) | 787 | (defvar auth-source-netrc-cache nil) |
| 784 | 788 | ||
| 785 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") | 789 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") |
| @@ -998,17 +1002,6 @@ See `auth-source-search' for details on SPEC." | |||
| 998 | (nth 0 v) | 1002 | (nth 0 v) |
| 999 | v)) | 1003 | v)) |
| 1000 | 1004 | ||
| 1001 | ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) | ||
| 1002 | |||
| 1003 | (defun auth-source-format-prompt (prompt alist) | ||
| 1004 | "Format PROMPT using %x (for any character x) specifiers in ALIST." | ||
| 1005 | (dolist (cell alist) | ||
| 1006 | (let ((c (nth 0 cell)) | ||
| 1007 | (v (nth 1 cell))) | ||
| 1008 | (when (and c v) | ||
| 1009 | (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt))))) | ||
| 1010 | prompt) | ||
| 1011 | |||
| 1012 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) | 1005 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) |
| 1013 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) | 1006 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) |
| 1014 | 1007 | ||