Merge changes made in Gnus trunk.

auth-source.el (auth-source-read-char-choice): New function to read a 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'.
 (auth-source-netrc-saver): Use it.
nnimap.el (nnimap-credentials): Keep the :save-function as the third parameter in the credentials.
 (nnimap-open-connection-1): Use it after a successful login.
 (nnimap-credentials): Add IMAP-specific user and password prompt.
auth-source.el (auth-source-search): Add :require parameter, taking a list.  Document it and the :save-function return token.  Pass :require down.  Change the CREATED message from a warning to a debug statement.
 (auth-source-search-backends): Pass :require down.
 (auth-source-netrc-search): Pass :require down.
 (auth-source-netrc-parse): Use :require, if it's given, as a filter.  Change save prompt to indicate all modifications saved here are deletions.
 (auth-source-netrc-create): Take user login name as default in user prompt.  Move all the save functionality to a lexically bound function under the :save-function token in the returned list.  Set up clearer default prompts for user, host, port, and secret.
 (auth-source-netrc-saver): New function, intended to be wrapped for :save-function.

5 files changed, 277 insertions, 103 deletions

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 75674c7fd17..96a2576355a 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-08  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * auth.texi (Help for developers): Show example of using
+        `auth-source-search' with prompts and :save-function.
+
 2011-03-07  Antoine Levitt  <antoine.levitt@gmail.com>
 
         * message.texi (Message Buffers): Update default value of
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 23ac23dce5b..e16d7b49b63 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -131,11 +131,11 @@ library encourages this confusion by accepting both, as you'll see
 later.
 
 If you have problems with the search, set @code{auth-source-debug} to
-@code{t} and see what host, port, and user the library is checking in
-the @code{*Messages*} buffer.  Ditto for any other problems, your
-first step is always to see what's being checked.  The second step, of
-course, is to write a blog entry about it and wait for the answer in
-the comments.
+@code{'trivia} and see what host, port, and user the library is
+checking in the @code{*Messages*} buffer.  Ditto for any other
+problems, your first step is always to see what's being checked.  The
+second step, of course, is to write a blog entry about it and wait for
+the answer in the comments.
 
 You can customize the variable @code{auth-sources}.  The following may
 be needed if you are using an older version of Emacs or if the
@@ -232,6 +232,14 @@ TODO: how does it work generally, how does secrets.el work, some examples.
 @node Help for developers
 @chapter Help for developers
 
+The auth-source library lets you control logging output easily.
+
+@defvar auth-source-debug
+Set this variable to 'trivia to see lots of output in *Messages*, or
+set it to a function that behaves like @code{message} to do your own
+logging.
+@end defvar
+
 The auth-source library only has a few functions for external use.
 
 @defun auth-source-search SPEC
@@ -240,6 +248,52 @@ TODO: how to include docstring?
 
 @end defun
 
+Let's take a look at an example of using @code{auth-source-search}
+from Gnus' @code{nnimap.el}.
+
+@example
+(defun nnimap-credentials (address ports)
+  (let* ((auth-source-creation-prompts
+          '((user  . "IMAP user at %h: ")
+            (secret . "IMAP password for %u@@%h: ")))
+         (found (nth 0 (auth-source-search :max 1
+                                           :host address
+                                           :port ports
+                                           :require '(:user :secret)
+                                           :create t))))
+    (if found
+        (list (plist-get found :user)
+              (let ((secret (plist-get found :secret)))
+                (if (functionp secret)
+                    (funcall secret)
+                  secret))
+              (plist-get found :save-function))
+      nil)))
+@end example
+
+This call requires the user and password (secret) to be in the
+results.  It also requests that an entry be created if it doesn't
+exist already.  While the created entry is being assembled, the shown
+prompts will be used to interact with the user.  The caller can also
+pass data in @code{auth-source-creation-defaults} to supply defaults
+for any of the prompts.
+
+Note that the password needs to be evaluated if it's a function.  It's
+wrapped in a function to provide some security.
+
+Later, after a successful login, @code{nnimal.el} calls the
+@code{:save-function} like so:
+
+@example
+(when (functionp (nth 2 credentials))
+   (funcall (nth 2 credentials)))
+@end example  
+
+Which will work whether the @code{:save-function} was provided or not.
+@code{:save-function} will be provided only when a new entry was
+created, so this effectively says ``after a successful login, save the
+authentication information we just used, if it was newly created.''
+
 @defun auth-source-delete SPEC
 
 TODO: how to include docstring?
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index b30cfdcfcd3..aa1f013dd35 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,34 @@
+2011-03-09  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * auth-source.el (auth-source-read-char-choice): New function to read a
+        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'.
+        (auth-source-netrc-saver): Use it.
+
+2011-03-08  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * nnimap.el (nnimap-credentials): Keep the :save-function as the third
+        parameter in the credentials.
+        (nnimap-open-connection-1): Use it after a successful login.
+        (nnimap-credentials): Add IMAP-specific user and password prompt.
+
+        * auth-source.el (auth-source-search): Add :require parameter, taking a
+        list.  Document it and the :save-function return token.  Pass :require
+        down.  Change the CREATED message from a warning to a debug statement.
+        (auth-source-search-backends): Pass :require down.
+        (auth-source-netrc-search): Pass :require down.
+        (auth-source-netrc-parse): Use :require, if it's given, as a filter.
+        Change save prompt to indicate all modifications saved here are
+        deletions.
+        (auth-source-netrc-create): Take user login name as default in user
+        prompt.  Move all the save functionality to a lexically bound function
+        under the :save-function token in the returned list.  Set up clearer
+        default prompts for user, host, port, and secret.
+        (auth-source-netrc-saver): New function, intended to be wrapped for
+        :save-function.
+
 2011-03-07  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
         * shr.el (shr-table-horizontal-line): Change the defaults for the table
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 500de10b71c..108871974a0 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -44,7 +44,18 @@
 (require 'gnus-util)
 (require 'assoc)
 (eval-when-compile (require 'cl))
-(require 'eieio)
+(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.")))
 
 (autoload 'secrets-create-item "secrets")
 (autoload 'secrets-delete-item "secrets")
@@ -286,6 +297,34 @@ If the value is not a list, symmetric encryption will be used."
    msg))
 
 
+;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q))
+(defun auth-source-read-char-choice (prompt choices)
+  "Read one of CHOICES by `read-char-choice', or `read-char'.
+`dropdown-list' support is disabled because it doesn't work reliably.
+Only one of CHOICES will be returned.  The PROMPT is augmented
+with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+  (when choices
+    (let* ((prompt-choices
+            (apply 'concat (loop for c in choices
+                                 collect (format "%c/" c))))
+           (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
+           (full-prompt (concat prompt prompt-choices))
+           k)
+
+      (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)
+                    (setq k (read-char))))))
+      k)))
+
 ;; (auth-source-pick nil :host "any" :port 'imap :user "joe")
 ;; (auth-source-pick t :host "any" :port 'imap :user "joe")
 ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
@@ -393,7 +432,7 @@ parameters."
 
 (defun* auth-source-search (&rest spec
                                   &key type max host user port secret
-                                  create delete
+                                  require create delete
                                   &allow-other-keys)
   "Search or modify authentication backends according to SPEC.
 
@@ -487,6 +526,11 @@ should `catch' the backend-specific error as usual.  Some
 backends (netrc, at least) will prompt the user rather than throw
 an error.
 
+:require (A B C) means that only results that contain those
+tokens will be returned.  Thus for instance requiring :secret
+will ensure that any results will actually have a :secret
+property.
+
 :delete t means to delete any found entries.  nil by default.
 Use `auth-source-delete' in ELisp code instead of calling
 `auth-source-search' directly with this parameter.
@@ -516,11 +560,17 @@ is a plist with keys :backend :host :port :user, plus any other
 keys provided by the backend (notably :secret).  But note the
 exception for :max 0, which see above.
 
+The token can hold a :save-function key.  If you call that, the
+user will be prompted to save the data to the backend.  You can't
+request that this should happen right after creation, because
+`auth-source-search' has no way of knowing if the token is
+actually useful.  So the caller must arrange to call this function.
+
 The token's :secret key can hold a function.  In that case you
 must call it to obtain the actual value."
   (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
          (max (or max 1))
-         (ignored-keys '(:create :delete :max))
+         (ignored-keys '(:require :create :delete :max))
          (keys (loop for i below (length spec) by 2
                      unless (memq (nth i spec) ignored-keys)
                      collect (nth i spec)))
@@ -539,6 +589,10 @@ must call it to obtain the actual value."
        (or (eq t create) (listp create)) t
        "Invalid auth-source :create parameter (must be t or a list): %s %s")
 
+      (assert
+       (listp require) t
+       "Invalid auth-source :require parameter (must be a list): %s")
+
       (setq filtered-backends (copy-sequence backends))
       (dolist (backend backends)
         (dolist (key keys)
@@ -562,8 +616,9 @@ must call it to obtain the actual value."
                                                spec
                                                ;; to exit early
                                                max
-                                               ;; create and delete
-                                               nil delete))
+                                               ;; create is always nil here
+                                               nil delete
+                                               require))
 
       (auth-source-do-debug
        "auth-source-search: found %d results (max %d) matching %S"
@@ -577,9 +632,9 @@ must call it to obtain the actual value."
                                                  spec
                                                  ;; to exit early
                                                  max
-                                                 ;; create and delete
-                                                 create delete))
-        (auth-source-do-warn
+                                                 create delete
+                                                 require))
+        (auth-source-do-debug
          "auth-source-search: CREATED %d results (max %d) matching %S"
          (length found) max spec))
 
@@ -589,18 +644,19 @@ must call it to obtain the actual value."
 
       found))
 
-(defun auth-source-search-backends (backends spec max create delete)
+(defun auth-source-search-backends (backends spec max create delete require)
   (let (matches)
     (dolist (backend backends)
       (when (> max (length matches))   ; when we need more matches...
-        (let ((bmatches (apply
-                         (slot-value backend 'search-function)
-                         :backend backend
-                         ;; note we're overriding whatever the spec
-                         ;; has for :create and :delete
-                         :create create
-                         :delete delete
-                         spec)))
+        (let* ((bmatches (apply
+                          (slot-value backend 'search-function)
+                          :backend backend
+                          ;; note we're overriding whatever the spec
+                          ;; has for :require, :create, and :delete
+                          :require require
+                          :create create
+                          :delete delete
+                          spec)))
           (when bmatches
             (auth-source-do-trivia
              "auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
@@ -729,7 +785,7 @@ while \(:host t) would find all host entries."
 ;;; (auth-source-netrc-parse "~/.authinfo.gpg")
 (defun* auth-source-netrc-parse (&rest
                                  spec
-                                 &key file max host user port delete
+                                 &key file max host user port delete require
                                  &allow-other-keys)
   "Parse FILE and return a list of all entries in the file.
 Note that the MAX parameter is used so we can exit the parse early."
@@ -828,7 +884,15 @@ Note that the MAX parameter is used so we can exit the parse early."
                         (or
                          (aget alist "port")
                          (aget alist "protocol")
-                         t)))
+                         t))
+                       (or
+                        ;; the required list of keys is nil, or
+                        (null require)
+                        ;; every element of require is in the normalized list
+                        (let ((normalized (nth 0 (auth-source-netrc-normalize
+                                                 (list alist)))))
+                          (loop for req in require
+                                always (plist-get normalized req)))))
               (decf max)
               (push (nreverse alist) result)
               ;; to delete a line, we just comment it out
@@ -853,7 +917,7 @@ Note that the MAX parameter is used so we can exit the parse early."
                   (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
 
             ;; ask AFTER we've successfully opened the file
-            (when (y-or-n-p (format "Save file %s? (%d modifications)"
+            (when (y-or-n-p (format "Save file %s? (%d deletions)"
                                     file modified))
               (write-region (point-min) (point-max) file nil 'silent)
               (auth-source-do-debug
@@ -893,7 +957,7 @@ Note that the MAX parameter is used so we can exit the parse early."
 
 (defun* auth-source-netrc-search (&rest
                                   spec
-                                  &key backend create delete
+                                  &key backend require create delete
                                   type max host user port
                                   &allow-other-keys)
 "Given a property list SPEC, return search matches from the :backend.
@@ -905,6 +969,7 @@ See `auth-source-search' for details on SPEC."
   (let ((results (auth-source-netrc-normalize
                   (auth-source-netrc-parse
                    :max max
+                   :require require
                    :delete delete
                    :file (oref backend source)
                    :host (or host t)
@@ -992,12 +1057,12 @@ See `auth-source-search' for details on SPEC."
              (data (auth-source-netrc-element-or-first data))
              ;; this is the default to be offered
              (given-default (aget auth-source-creation-defaults r))
-             ;; the default supplementals are simple: for the user,
-             ;; try (user-login-name), otherwise take given-default
+             ;; the default supplementals are simple:
+             ;; for the user, try `given-default' and then (user-login-name);
+             ;; otherwise take `given-default'
              (default (cond
-                       ;; don't default the user name
-                       ;; ((and (not given-default) (eq r 'user))
-                       ;;  (user-login-name))
+                       ((and (not given-default) (eq r 'user))
+                        (user-login-name))
                        (t given-default)))
              (printable-defaults (list
                                   (cons 'user
@@ -1020,10 +1085,10 @@ See `auth-source-search' for details on SPEC."
                                          "[any port]"))))
              (prompt (or (aget auth-source-creation-prompts r)
                          (case r
-                           ('secret "%p password for user %u, host %h: ")
-                           ('user "%p user name: ")
-                           ('host "%p host name for user %u: ")
-                           ('port "%p port for user %u and host %h: "))
+                           (secret "%p password for %u@%h: ")
+                           (user "%p user name for %h: ")
+                           (host "%p host name for user %u: ")
+                           (port "%p port for %u@%h: "))
                          (format "Enter %s (%%u@%%h:%%p): " r)))
              (prompt (auth-source-format-prompt
                       prompt
@@ -1071,70 +1136,79 @@ See `auth-source-search' for details on SPEC."
                                    data))))
             (setq add (concat add (funcall printer)))))))
 
-    (with-temp-buffer
-      (when (file-exists-p file)
-        (insert-file-contents file))
-      (when auth-source-gpg-encrypt-to
-        ;; (see bug#7487) making `epa-file-encrypt-to' local to
-        ;; this buffer lets epa-file skip the key selection query
-        ;; (see the `local-variable-p' check in
-        ;; `epa-file-write-region').
-        (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
-          (make-local-variable 'epa-file-encrypt-to))
-        (if (listp auth-source-gpg-encrypt-to)
-            (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
-      (goto-char (point-max))
-
-      ;; ask AFTER we've successfully opened the file
-      (let ((prompt (format "Save auth info to file %s? %s: "
-                            file
-                            "y/n/N/e/?"))
-            (done (not (eq auth-source-save-behavior 'ask)))
-            (bufname "*auth-source Help*")
-            k)
-        (while (not done)
-          (message "%s" prompt)
-          (setq k (read-char))
-          (case k
-            (?y (setq done t))
-            (?? (save-excursion
-                  (with-output-to-temp-buffer bufname
-                    (princ
-                     (concat "(y)es, save\n"
-                             "(n)o but use the info\n"
-                             "(N)o and don't ask to save again\n"
-                             "(e)dit the line\n"
-                             "(?) for help as you can see.\n"))
+    (plist-put
+     artificial
+     :save-function
+     (lexical-let ((file file)
+                   (add add))
+       (lambda () (auth-source-netrc-saver file add))))
+
+    (list artificial)))
+
+;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch") :user "tzz" :port "imap" :create t :max 1)) :save-function))
+(defun auth-source-netrc-saver (file add)
+  "Save a line ADD in FILE, prompting along the way.
+Respects `auth-source-save-behavior'."
+  (with-temp-buffer
+    (when (file-exists-p file)
+      (insert-file-contents file))
+    (when auth-source-gpg-encrypt-to
+      ;; (see bug#7487) making `epa-file-encrypt-to' local to
+      ;; this buffer lets epa-file skip the key selection query
+      ;; (see the `local-variable-p' check in
+      ;; `epa-file-write-region').
+      (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
+        (make-local-variable 'epa-file-encrypt-to))
+      (if (listp auth-source-gpg-encrypt-to)
+          (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
+    ;; we want the new data to be found first, so insert at beginning
+    (goto-char (point-min))
+
+    ;; ask AFTER we've successfully opened the file
+    (let ((prompt (format "Save auth info to file %s? " file))
+          (done (not (eq auth-source-save-behavior 'ask)))
+          (bufname "*auth-source Help*")
+          k)
+      (while (not done)
+        (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??)))
+        (case k
+          (?y (setq done t))
+          (?? (save-excursion
+                (with-output-to-temp-buffer bufname
+                  (princ
+                   (concat "(y)es, save\n"
+                           "(n)o but use the info\n"
+                           "(N)o and don't ask to save again\n"
+                           "(e)dit the line\n"
+                           "(?) for help as you can see.\n"))
                   (set-buffer standard-output)
                   (help-mode))))
-            (?n (setq add ""
-                      done t))
-            (?N (setq add ""
-                      done t
-                      auth-source-save-behavior nil))
-            (?e (setq add (read-string "Line to add: " add)))
-            (t nil)))
-
-        (when (get-buffer-window bufname)
-          (delete-window (get-buffer-window bufname)))
-
-        ;; make sure the info is not saved
-        (when (null auth-source-save-behavior)
-          (setq add ""))
-
-        (when (< 0 (length add))
-          (progn
-            (unless (bolp)
-              (insert "\n"))
-            (insert add "\n")
-            (write-region (point-min) (point-max) file nil 'silent)
-            (auth-source-do-warn
-             "auth-source-netrc-create: wrote 1 new line to %s"
-             file)
-            nil))
-
-        (when (eq done t)
-          (list artificial))))))
+          (?n (setq add ""
+                    done t))
+          (?N (setq add ""
+                    done t
+                    auth-source-save-behavior nil))
+          (?e (setq add (read-string "Line to add: " add)))
+          (t nil)))
+
+      (when (get-buffer-window bufname)
+        (delete-window (get-buffer-window bufname)))
+
+      ;; make sure the info is not saved
+      (when (null auth-source-save-behavior)
+        (setq add ""))
+
+      (when (< 0 (length add))
+        (progn
+          (unless (bolp)
+            (insert "\n"))
+          (insert add "\n")
+          (write-region (point-min) (point-max) file nil 'silent)
+          (auth-source-do-debug
+           "auth-source-netrc-create: wrote 1 new line to %s"
+           file)
+          (message "Saved new authentication information to %s" file)
+          nil)))))
 
 ;;; Backend specific parsing: Secrets API backend
 
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 638097abd7d..e76ead515c5 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -279,16 +279,21 @@ textual parts.")
     (current-buffer)))
 
 (defun nnimap-credentials (address ports)
-  (let ((found (nth 0 (auth-source-search :max 1
-                                          :host address
-                                          :port ports
-                                          :create t))))
+  (let* ((auth-source-creation-prompts
+          '((user  . "IMAP user at %h: ")
+            (secret . "IMAP password for %u@%h: ")))
+         (found (nth 0 (auth-source-search :max 1
+                                           :host address
+                                           :port ports
+                                           :require '(:user :secret)
+                                           :create t))))
     (if found
         (list (plist-get found :user)
               (let ((secret (plist-get found :secret)))
                 (if (functionp secret)
                     (funcall secret)
-                  secret)))
+                  secret))
+              (plist-get found :save-function))
       nil)))
 
 (defun nnimap-keepalive ()
@@ -396,7 +401,12 @@ textual parts.")
                 (let ((nnimap-inhibit-logging t))
                   (setq login-result
                         (nnimap-login (car credentials) (cadr credentials))))
-                (unless (car login-result)
+                (if (car login-result)
+                    ;; save the credentials if a save function exists
+                    ;; (such a function will only be passed if a new
+                    ;; token was created)
+                    (when (functionp (nth 2 credentials))
+                      (funcall (nth 2 credentials)))
                   ;; If the login failed, then forget the credentials
                   ;; that are now possibly cached.
                   (dolist (host (list (nnoo-current-server 'nnimap)