[Emacs-diffs] /srv/bzr/emacs/trunk r103420: Merge changes made in Gnus trunk.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 103420
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Fri 2011-02-25 12:53:00 +0000
message:
  Merge changes made in Gnus trunk.
  
  auth-source.el (auth-source-save-behavior): New variable to replace 
`auth-source-never-create'.
   (auth-source-netrc-create): Use it.
   (auth-source-never-save): Remove.
  nnimap.el (nnimap-stream): Doc fix.
   (nnimap-open-connection-1): Reverse the order of the ports to that the 
prompted-for port is first.
  gnus-start.el (gnus-get-unread-articles): Don't clobber the async retrieval 
by the no-group selection.
  gnus-demon.el (gnus-demon-init): run-with-timer should be called with 
numerical parameters.
  auth-source.el (auth-source-creation-prompts): New variable to manage 
creation-time prompts.
   (auth-source-search): Document it.
   (auth-source-format-prompt): Add utility function.
   (auth-source-netrc-create): Don't default the user name to user-login-name.  
Use `auth-source-creation-prompts' and some default prompts for user, host, 
port, and password (the default generic prompt remains ugly).
   (auth-source-never-save): Add customizable option to never save info.
   (auth-source-netrc-create): Use it and improve save prompts.  Fix help mode 
excursion.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/auth-source.el
  lisp/gnus/gnus-demon.el
  lisp/gnus/gnus-start.el
  lisp/gnus/nnimap.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-02-24 06:32:33 +0000
+++ b/lisp/gnus/ChangeLog       2011-02-25 12:53:00 +0000
@@ -1,3 +1,36 @@
+2011-02-25  Teodor Zlatanov  <address@hidden>
+
+       * auth-source.el (auth-source-save-behavior): New variable to replace
+       `auth-source-never-create'.
+       (auth-source-netrc-create): Use it.
+       (auth-source-never-save): Remove.
+
+2011-02-25  Lars Ingebrigtsen  <address@hidden>
+
+       * nnimap.el (nnimap-stream): Doc fix.
+       (nnimap-open-connection-1): Reverse the order of the ports to that the
+       prompted-for port is first.
+
+       * gnus-start.el (gnus-get-unread-articles): Don't clobber the async
+       retrieval by the no-group selection.
+
+       * gnus-demon.el (gnus-demon-init): run-with-timer should be called with
+       numerical parameters.
+
+2011-02-24  Teodor Zlatanov  <address@hidden>
+
+       * auth-source.el (auth-source-creation-prompts): New variable to manage
+       creation-time prompts.
+       (auth-source-search): Document it.
+       (auth-source-format-prompt): Add utility function.
+       (auth-source-netrc-create): Don't default the user name to
+       user-login-name.  Use `auth-source-creation-prompts' and some default
+       prompts for user, host, port, and password (the default generic prompt
+       remains ugly).
+       (auth-source-never-save): Add customizable option to never save info.
+       (auth-source-netrc-create): Use it and improve save prompts.  Fix help
+       mode excursion.
+
 2011-02-24  Katsumi Yamaoka  <address@hidden>
 
        * auth-source.el (auth-source-netrc-create): Use `read-char' with no

=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el  2011-02-24 06:32:33 +0000
+++ b/lisp/gnus/auth-source.el  2011-02-25 12:53:00 +0000
@@ -137,8 +137,21 @@
 (defvar auth-source-creation-defaults nil
   "Defaults for creating token values.  Usually let-bound.")
 
+(defvar auth-source-creation-prompts nil
+  "Default prompts for token values.  Usually let-bound.")
+
 (make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
 
+(defcustom auth-source-save-behavior 'ask
+  "If set, auth-source will respect it for save behavior."
+  :group 'auth-source
+  :version "23.2" ;; No Gnus
+  :type `(choice
+          :tag "auth-source new token save behavior"
+          (const :tag "Always save" t)
+          (const :tag "Never save" nil)
+          (const :tag "Ask" ask)))
+
 (defvar auth-source-magic "auth-source-magic ")
 
 (defcustom auth-source-do-cache t
@@ -435,12 +448,18 @@
 token.  The value for that parameter will be obtained from the
 search parameters or from user input.  If any queries are needed,
 the alist `auth-source-creation-defaults' will be checked for the
-default prompt.
+default value.  If the user, host, or port are missing, the alist
+`auth-source-creation-prompts' will be used to look up the
+prompts IN THAT ORDER (so the 'user prompt will be queried first,
+then 'host, then 'port, and finally 'secret).  Each prompt string
+can use %u, %h, and %p to show the user, host, and port.
 
 Here's an example:
 
 \(let ((auth-source-creation-defaults '((user . \"defaultUser\")
-                                        (A    . \"default A\"))))
+                                        (A    . \"default A\")))
+       (auth-source-creation-prompts
+        '((password . \"Enter IMAP password for %h:%p: \"))))
   (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
                       :P \"pppp\" :Q \"qqqq\"
                       :create '(A B Q)))
@@ -452,12 +471,11 @@
 
  Create a new entry if you found none.  The netrc backend will
  automatically require host, user, and port.  The host will be
- 'nonesuch' and Q will be 'qqqq'.  We prompt for A with default
- 'default A', for B and port with default nil, and for the
- user with default 'defaultUser'.  We will not prompt for Q.  The
- resulting token will have keys user, host, port, A, B, and Q.
- It will not have P with any value, even though P is used in the
- search to find only entries that have P set to 'pppp'.\"
+ 'nonesuch' and Q will be 'qqqq'.  We prompt for the password
+ with the shown prompt.  We will not prompt for Q.  The resulting
+ token will have keys user, host, port, A, B, and Q.  It will not
+ have P with any value, even though P is used in the search to
+ find only entries that have P set to 'pppp'.\"
 
 When multiple values are specified in the search parameter, the
 user is prompted for which one.  So :host (X Y Z) would ask the
@@ -903,6 +921,17 @@
       (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)))
 
@@ -954,31 +983,50 @@
              ;; the default supplementals are simple: for the user,
              ;; try (user-login-name), otherwise take given-default
              (default (cond
-                       ((and (not given-default) (eq r 'user))
-                        (user-login-name))
-                       (t given-default))))
+                       ;; don't default the user name
+                       ;; ((and (not given-default) (eq r 'user))
+                       ;;  (user-login-name))
+                       (t given-default)))
+             (printable-defaults (list
+                                  (cons 'user
+                                        (or
+                                         (auth-source-netrc-element-or-first
+                                          (aget valist 'user))
+                                         (plist-get artificial :user)
+                                         "[any user]"))
+                                  (cons 'host
+                                        (or
+                                         (auth-source-netrc-element-or-first
+                                          (aget valist 'host))
+                                         (plist-get artificial :host)
+                                         "[any host]"))
+                                  (cons 'port
+                                        (or
+                                         (auth-source-netrc-element-or-first
+                                          (aget valist 'port))
+                                         (plist-get artificial :port)
+                                         "[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: "))
+                         (format "Enter %s (address@hidden:%%p): " r)))
+             (prompt (auth-source-format-prompt
+                      prompt
+                      `((?u ,(aget printable-defaults 'user))
+                        (?h ,(aget printable-defaults 'host))
+                        (?p ,(aget printable-defaults 'port))))))
 
         ;; store the data, prompting for the password if needed
         (setq data
               (cond
                ((and (null data) (eq r 'secret))
                 ;; special case prompt for passwords
-                (read-passwd (format "Password for address@hidden:%s: "
-                                     (or
-                                      (auth-source-netrc-element-or-first
-                                       (aget valist 'user))
-                                      (plist-get artificial :user)
-                                      "[any user]")
-                                     (or
-                                      (auth-source-netrc-element-or-first
-                                       (aget valist 'host))
-                                      (plist-get artificial :host)
-                                      "[any host]")
-                                     (or
-                                      (auth-source-netrc-element-or-first
-                                       (aget valist 'port))
-                                      (plist-get artificial :port)
-                                      "[any port]"))))
+                (read-passwd prompt))
+               ((null data)
+                (read-string prompt default))
                (t (or data default))))
 
         (when data
@@ -1026,22 +1074,42 @@
       (goto-char (point-max))
 
       ;; ask AFTER we've successfully opened the file
-      (let ((prompt (format "Add to file %s? %s: "
+      (let ((prompt (format "Save auth info to file %s? %s: "
                             file
-                            "(y)es/(n)o but use it/(e)dit line/(s)kip file"))
-            done k)
+                            "y/n/N/e/?"))
+            (done (not (eq auth-source-save-behavior 'ask)))
+            (bufname "*auth-source Help*")
+            k)
         (while (not done)
-         (message "%s" prompt)
+          (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"))
+                  (set-buffer standard-output)
+                  (help-mode))))
             (?n (setq add ""
                       done t))
-            (?s (setq add ""
-                      done 'skip))
+            (?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)

=== modified file 'lisp/gnus/gnus-demon.el'
--- a/lisp/gnus/gnus-demon.el   2011-01-25 04:08:28 +0000
+++ b/lisp/gnus/gnus-demon.el   2011-02-25 12:53:00 +0000
@@ -140,7 +140,7 @@
              ;; (func number nil)
              ;; Call every `time'
              ((and (numberp time) (null idle))
-              (run-with-timer t time 'gnus-demon-run-callback func)))))
+              (run-with-timer time time 'gnus-demon-run-callback func)))))
       (when timer
         (add-to-list 'gnus-demon-timers timer)))))
 

=== modified file 'lisp/gnus/gnus-start.el'
--- a/lisp/gnus/gnus-start.el   2011-02-23 13:35:35 +0000
+++ b/lisp/gnus/gnus-start.el   2011-02-25 12:53:00 +0000
@@ -1690,6 +1690,16 @@
                            method))
              (setcar elem method))
            (push (list method 'ok) methods)))))
+
+    ;; If we have primary/secondary select methods, but no groups from
+    ;; them, we still want to issue a retrieval request from them.
+    (dolist (method (cons gnus-select-method
+                         gnus-secondary-select-methods))
+      (when (and (not (assoc method type-cache))
+                (gnus-check-backend-function 'request-list (car method)))
+       (with-current-buffer nntp-server-buffer
+         (gnus-read-active-file-1 method nil))))
+
     ;; Start early async retrieval of data.
     (dolist (elem type-cache)
       (destructuring-bind (method method-type infos dummy) elem
@@ -1712,15 +1722,6 @@
              (setcar (nthcdr 3 elem)
                      (gnus-retrieve-group-data-early method infos)))))))
 
-    ;; If we have primary/secondary select methods, but no groups from
-    ;; them, we still want to issue a retrieval request from them.
-    (dolist (method (cons gnus-select-method
-                         gnus-secondary-select-methods))
-      (when (and (not (assoc method type-cache))
-                (gnus-check-backend-function 'request-list (car method)))
-       (with-current-buffer nntp-server-buffer
-         (gnus-read-active-file-1 method nil))))
-
     ;; Do the rest of the retrieval.
     (dolist (elem type-cache)
       (destructuring-bind (method method-type infos early-data) elem

=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el       2011-02-23 13:35:35 +0000
+++ b/lisp/gnus/nnimap.el       2011-02-25 12:53:00 +0000
@@ -62,8 +62,9 @@
 
 (defvoo nnimap-stream 'undecided
   "How nnimap will talk to the IMAP server.
-Values are `ssl', `network', `starttls' or `shell'.
-The default is to try `ssl' first, and then `network'.")
+Values are `ssl', `network', `network-only, `starttls' or
+`shell'.  The default is to try `ssl' first, and then
+`network'.")
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
@@ -337,7 +338,7 @@
                  (eq nnimap-stream 'starttls))
              (nnheader-message 7 "Opening connection to %s..."
                                nnimap-address)
-             '("143" "imap"))
+             '("imap" "143"))
             ((eq nnimap-stream 'shell)
              (nnheader-message 7 "Opening connection to %s via shell..."
                                nnimap-address)
@@ -345,16 +346,16 @@
             ((memq nnimap-stream '(ssl tls))
              (nnheader-message 7 "Opening connection to %s via tls..."
                                nnimap-address)
-             '("143" "993" "imap" "imaps"))
+             '("imaps" "imap" "993" "143"))
             (t
              (error "Unknown stream type: %s" nnimap-stream))))
           (proto-stream-always-use-starttls t)
            login-result credentials)
       (when nnimap-server-port
-       (setq ports (append ports (list nnimap-server-port))))
+       (push nnimap-server-port ports))
       (destructuring-bind (stream greeting capabilities stream-type)
          (open-protocol-stream
-          "*nnimap*" (current-buffer) nnimap-address (car (last ports))
+          "*nnimap*" (current-buffer) nnimap-address (car ports)
           :type nnimap-stream
           :shell-command nnimap-shell-program
           :capability-command "1 CAPABILITY\r\n"