summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorGnus developers <ding@gnus.org>2011-02-25 12:53:00 +0000
committerKatsumi Yamaoka <yamaoka@jpl.org>2011-02-25 12:53:00 +0000
commit0444b0a5ebdebcf64e3824c080a12e08fbbae956 (patch)
tree25477a91e0270bc33cdf02839022ff77035f59c8 /lisp
parentcd4970c0529108c0506aefa94642cb839ef9e685 (diff)
downloademacs-0444b0a5ebdebcf64e3824c080a12e08fbbae956.tar.gz
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/gnus/ChangeLog33
-rw-r--r--lisp/gnus/auth-source.el134
-rw-r--r--lisp/gnus/gnus-demon.el2
-rw-r--r--lisp/gnus/gnus-start.el19
-rw-r--r--lisp/gnus/nnimap.el13
5 files changed, 152 insertions, 49 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index db20fc0b03e..d93dfe63cc8 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,36 @@
+2011-02-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <tzz@lifelogs.com>
+
+ * 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 <yamaoka@jpl.org>
* auth-source.el (auth-source-netrc-create): Use `read-char' with no
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 63ec93dd760..e4d4fd4c83b 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -137,8 +137,21 @@ let-binding."
(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 @@ parameter, that parameter will be required in the resulting
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 @@ which says:
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 @@ 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)))
@@ -954,31 +983,50 @@ See `auth-source-search' for details on SPEC."
;; 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 (%%u@%%h:%%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 %s@%s:%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 @@ See `auth-source-search' for details on SPEC."
(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)
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 2a45b9363f4..419346b7191 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -140,7 +140,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's."
;; (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)))))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index dea6aabc75b..d1ed23f79b3 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1690,6 +1690,16 @@ If SCAN, request a scan of that group as well."
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 @@ If SCAN, request a scan of that group as well."
(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
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index b2733407836..c579261e356 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -62,8 +62,9 @@ it will default to `imap'.")
(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 @@ textual parts.")
(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 @@ textual parts.")
((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"