From f3b54b0e1e770038e9842479d88916d95f7bfa51 Mon Sep 17 00:00:00 2001 From: Teodor Zlatanov Date: Thu, 10 Mar 2011 13:32:49 +0000 Subject: [PATCH] auth-source.el (auth-source-read-char-choice): Remove `dropdown-list'. (auth-source-pick-first-password): New convenience function. --- lisp/gnus/ChangeLog | 3 ++- 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 @@ character choice using `dropdown-list', `read-char-choice', or `read-char'. It appends "[a/b/c] " to the prompt if the choices were '(?a ?b ?c). The `dropdown-list' support is disabled for now. Use - `eval-when-compile' to load `dropdown-list'. + `eval-when-compile' to load `dropdown-list'. Remove `dropdown-list'. (auth-source-netrc-saver): Use it. + (auth-source-pick-first-password): New convenience function. 2011-03-08 Teodor Zlatanov 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 @@ (require 'gnus-util) (require 'assoc) (eval-when-compile (require 'cl)) -(eval-when-compile (require 'dropdown-list nil t)) -(eval-and-compile - (or (ignore-errors (require 'eieio)) - ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib - (ignore-errors - (let ((load-path (cons (expand-file-name - "gnus-fallback-lib/eieio" - (file-name-directory (locate-library "gnus"))) - load-path))) - (require 'eieio))) - (error - "eieio not found in `load-path' or gnus-fallback-lib/ directory."))) +(require 'eieio) (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") @@ -313,12 +302,6 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." (while (not (memq k choices)) (setq k (cond - ((and nil (featurep 'dropdown-list)) - (let* ((blank (fill (copy-sequence prompt) ?.)) - (dlc (cons (format "%s %c" prompt (car choices)) - (loop for c in (cdr choices) - collect (format "%s %c" blank c))))) - (nth (dropdown-list dlc) choices))) ((fboundp 'read-char-choice) (read-char-choice full-prompt choices)) (t (message "%s" full-prompt) @@ -769,7 +752,26 @@ while \(:host t) would find all host entries." (return 'no))) 'no)))) -;;; Backend specific parsing: netrc/authinfo backend +;;; (auth-source-pick-first-password :host "z.lifelogs.com") +;;; (auth-source-pick-first-password :port "imap") +(defun auth-source-pick-first-password (&rest spec) + "Pick the first secret found from applying SPEC to `auth-source-search'." + (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1)))) + (secret (plist-get result :secret))) + + (if (functionp secret) + (funcall secret) + secret))) + +;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) +(defun auth-source-format-prompt (prompt alist) + "Format PROMPT using %x (for any character x) specifiers in ALIST." + (dolist (cell alist) + (let ((c (nth 0 cell)) + (v (nth 1 cell))) + (when (and c v) + (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt))))) + prompt) (defun auth-source-ensure-strings (values) (unless (listp values) @@ -780,6 +782,8 @@ while \(:host t) would find all host entries." value)) values)) +;;; Backend specific parsing: netrc/authinfo backend + (defvar auth-source-netrc-cache nil) ;;; (auth-source-netrc-parse "~/.authinfo.gpg") @@ -998,17 +1002,6 @@ See `auth-source-search' for details on SPEC." (nth 0 v) v)) -;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) - -(defun auth-source-format-prompt (prompt alist) - "Format PROMPT using %x (for any character x) specifiers in ALIST." - (dolist (cell alist) - (let ((c (nth 0 cell)) - (v (nth 1 cell))) - (when (and c v) - (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt))))) - prompt) - ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) -- 2.39.5