From: Gnus developers Date: Thu, 30 Sep 2010 08:39:23 +0000 (+0000) Subject: Merge changes made in Gnus trunk. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~46^2~285 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=229b59da361fdfbea696ef7d829453222b78b219;p=emacs.git Merge changes made in Gnus trunk. nndraft.el (nndraft-request-expire-articles): Use the group name instead if "nndraft". gnus.texi (Using IMAP): Remove the @acronyms from the headings. nnregistry.el: Added. nnimap.el (nnimap-insert-partial-structure): Be way more permissive when interpreting the structures. GNUS-NEWS: Minor error in GNUS-NEWS - password-cache.el. nnimap.el (nnimap-request-accept-article): Add \r\n to the lines to make this work with Cyrus. gnus-registry.el: Don't prompt on load, which makes it impossible to build Gnus. gnus-gravatar.el: Add gnus-gravatar-properties. gnus-agent.el, gnus-art.el, gnus-bookmark.el, gnus-dired.el, gnus-group.el,\ gnus-int.el, gnus-msg.el, gnus-registry.el, gnus-score.el, gnus-srvr.el,\ gnus-sum.el, gnus-topic.el, gnus-util.el, gnus.el, mm-decode.el, mm-util.el,\ mm-view.el, mml-smime.el, mml.el, nnmairix.el, nnrss.el, smime.el:\ Introduce gnus-completing-read. gnus-util.el: Make completing-read function configurable. gnus-util.el: Add requires and fix history for iswitchb. webmail.el: Remove netscape/my-deja, since they no longer exist. gnus.el (gnus-local-domain): Declare variable obsolete. nnimap.el (nnimap-insert-partial-structure): Get the type from the correct slot, too. pop3.el (pop3-send-streaming-command, pop3-stream-length): New variable. nnimap.el (nnimap-open-connection): Revert the auto-network->starttls code. nnimap.el (nnimap-request-set-mark): Erase the buffer before issuing commands. nnimap.el (nnimap-split-rule): Mark as obsolete. gnus-sum.el (gnus-valid-move-group-p): Make sure that `group' is a symbol. nnimap.el (nnimap-split-incoming-mail): Allow `default' as nnimap-split-methods value. nnimap.el (nnimap-request-article): Downcase the NILs so that they are nil. nndoc.el (nndoc-retrieve-groups): New function. gnus.texi: Fix Gravatar documentation. --- diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index c1acf7e0d8a..153c54d43b1 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -629,7 +629,7 @@ Select Methods * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. -* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. +* Using IMAP:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. * Other Sources:: Reading directories, files. @@ -10797,7 +10797,7 @@ article is to use Muttprint (@pxref{Saving Articles}). @item A C @vindex gnus-fetch-partial-articles @findex gnus-summary-show-complete-article -If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will +If @code{-fetch-partial-articles} is non-@code{nil}, Gnus will fetch partial articles, if the backend it fetches them from supports it. Currently only @code{nnimap} does. If you're looking at a partial article, and want to see the complete article instead, then @@ -13700,7 +13700,7 @@ The different methods all have their peculiarities, of course. @menu * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. -* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. +* Using IMAP:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. * Other Sources:: Reading directories, files. @@ -14787,8 +14787,8 @@ there. @end table -@node Using @acronym{IMAP} -@section Using @acronym{IMAP} +@node Using IMAP +@section Using IMAP @cindex imap The most popular mail backend is probably @code{nnimap}, which @@ -14798,14 +14798,14 @@ This means that it's a convenient choice when you're reading your mail from different locations, or with different user agents. @menu -* Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}. -* Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection. -* Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box. +* Connecting to an IMAP Server:: Getting started with @acronym{IMAP}. +* Customizing the IMAP Connection:: Variables for @acronym{IMAP} connection. +* Client-Side IMAP Splitting:: Put mail in the correct mail box. @end menu -@node Connecting to an @acronym{IMAP} Server -@subsection Connecting to an @acronym{IMAP} Server +@node Connecting to an IMAP Server +@subsection Connecting to an IMAP Server Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the group buffer, or (if your primary interest is reading email), say @@ -14826,15 +14826,15 @@ machine imap.gmail.com login password port imap That should basically be it for most users. -@node Customizing the @acronym{IMAP} Connection -@subsection Customizing the @acronym{IMAP} Connection +@node Customizing the IMAP Connection +@subsection Customizing the IMAP Connection Here's an example method that's more complex: @example (nnimap "imap.gmail.com" (nnimap-inbox "INBOX") - (nnimap-split-methods ,nnmail-split-methods) + (nnimap-split-methods default) (nnimap-expunge t) (nnimap-stream 'ssl) (nnir-search-engine imap) @@ -14878,11 +14878,17 @@ this should be set to @code{anonymous}. Virtually all @code{IMAP} server support fast streaming of data. If you have problems connecting to the server, try setting this to @code{nil}. +@item nnimap-fetch-partial-articles +If non-@code{nil}, fetch partial articles from the server. If set to +a string, then it's interpreted as a regexp, and parts that have +matching types will be fetched. For instance, @samp{"text/"} will +fetch all textual parts, while leaving the rest on the server. + @end table -@node Client-Side @acronym{IMAP} Splitting -@subsection Client-Side @acronym{IMAP} Splitting +@node Client-Side IMAP Splitting +@subsection Client-Side IMAP Splitting Many people prefer to do the sorting/splitting of mail into their mail boxes on the @acronym{IMAP} server. That way they don't have to @@ -14897,7 +14903,8 @@ This is the @acronym{IMAP} mail box that will be scanned for new mail. @item nnimap-split-methods Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting -Mail}). +Mail}), except the symbol @code{default}, which means that it should +use the value of the @code{nnmail-split-methods} variable. @end table @@ -15460,7 +15467,7 @@ Get mail from a @acronym{IMAP} server. If you don't want to use @acronym{IMAP} as intended, as a network mail reading protocol (ie with nnimap), for some reason or other, Gnus let you treat it similar to a @acronym{POP} server and fetches articles from a given -@acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information. +@acronym{IMAP} mailbox. @xref{Using IMAP}, for more information. Keywords: @@ -15929,7 +15936,7 @@ after @code{save-excursion} and @code{save-restriction} in the example above. Also note that with the nnimap backend, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Client-Side @acronym{IMAP} Splitting}). +(@pxref{Client-Side IMAP Splitting}). @item (! @var{func} @var{split}) If the split is a list, and the first element is @code{!}, then @@ -23263,12 +23270,9 @@ The following variables offer control over how things are displayed. The size in pixels of gravatars. Gravatars are always square, so one number for the size is enough. -@item gnus-gravatar-relief -@vindex gnus-gravatar-relief -If non-nil, adds a shadow rectangle around the image. The value, -relief, specifies the width of the shadow lines, in pixels. If relief -is negative, shadows are drawn so that the image appears as a pressed -button; otherwise, it appears as an unpressed button. +@item gnus-gravatar-properties +@vindex gnus-gravatar-properties +List of image properties applied to Gravatar images. @end table @@ -23618,7 +23622,7 @@ call the external tools during splitting. Example fancy split method: Note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Client-Side @acronym{IMAP} Splitting}). +(@pxref{Client-Side IMAP Splitting}). That is about it. As some spam is likely to get through anyway, you might want to have a nifty function to call when you happen to read @@ -23907,7 +23911,7 @@ the message headers; @code{nnimap-split-download-body} tells it to retrieve the message bodies as well. We don't set this by default because it will slow @acronym{IMAP} down, and that is not an appropriate decision to make on behalf of the user. @xref{Client-Side -@acronym{IMAP} Splitting}. +IMAP Splitting}. You have to specify one or more spam back ends for @code{spam-split} to use, by setting the @code{spam-use-*} variables. @xref{Spam Back diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS index de5318d45cb..ca2f2309b99 100644 --- a/etc/GNUS-NEWS +++ b/etc/GNUS-NEWS @@ -50,7 +50,7 @@ support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top. The primary change this brings is support for DIGEST-MD5 and NTLM, when the server supports it. -** Gnus includes a password cache mechanism in password.el. +** Gnus includes a password cache mechanism in password-cache.el. It is enabled by default (see `password-cache'), with a short timeout of 16 seconds (see `password-cache-expiry'). If PGG is used as the PGP diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 4788deba5da..8043620c6b7 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -459,10 +459,7 @@ manipulated as follows: (let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) (when def (setq def (gnus-group-decoded-name def))) - (gnus-group-completing-read (if def - (concat "Group Name (" def "): ") - "Group Name: ") - nil nil t nil nil def))) + (gnus-group-completing-read nil nil t nil nil def))) ;;; Fetching setup functions. @@ -816,9 +813,9 @@ be a select method." (interactive (list (intern - (completing-read - "Add to category: " - (mapcar (lambda (cat) (list (symbol-name (car cat)))) + (gnus-completing-read + "Add to category" + (mapcar (lambda (cat) (symbol-name (car cat))) gnus-category-alist) nil t)) current-prefix-arg)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6e5cd4d8d13..4e2d43cc65d 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5131,11 +5131,10 @@ available media-types." (unless mime-type (setq mime-type (let ((default (gnus-mime-view-part-as-type-internal))) - (completing-read - (format "View as MIME type (default %s): " - (car default)) - (mapcar #'list (mailcap-mime-types)) - pred nil nil nil + (gnus-completing-read + "View as MIME type" + (remove-if-not pred (mailcap-mime-types)) + nil nil nil (car default))))) (gnus-article-check-buffer) (let ((handle (get-text-property (point) 'gnus-data))) @@ -5404,7 +5403,7 @@ If no internal viewer is available, use an external viewer." (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at \(point\)." (interactive - (list (completing-read "Action: " gnus-mime-action-alist nil t))) + (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t))) (gnus-article-check-buffer) (let ((action-pair (assoc action gnus-mime-action-alist))) (if action-pair @@ -8370,9 +8369,9 @@ For example: (interactive (list (or gnus-article-encrypt-protocol - (completing-read "Encrypt protocol: " - gnus-article-encrypt-protocol-alist - nil t)) + (gnus-completing-read "Encrypt protocol" + (mapcar 'car gnus-article-encrypt-protocol-alist) + t)) current-prefix-arg)) ;; User might hit `K E' instead of `K e', so prompt once. (when (and gnus-article-encrypt-protocol diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 137479b4e77..423750893d8 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -289,8 +289,8 @@ So the cdr of each bookmark is an alist too.") (interactive) (gnus-bookmark-maybe-load-default-file) (let* ((bookmark (or bmk-name - (completing-read "Jump to bookmarked article: " - gnus-bookmark-alist))) + (gnus-completing-read "Jump to bookmarked article" + (mapcar 'car gnus-bookmark-alist)))) (bmk-record (cadr (assoc bookmark gnus-bookmark-alist))) (group (cdr (assoc 'group bmk-record))) (message-id (cdr (assoc 'message-id bmk-record)))) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 18130bbb0fb..76d469b66f9 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -368,11 +368,11 @@ If ARG (or prefix) is non-nil, force prompting for all fields." header ": "))) (setq value (if (listp (nth 1 head)) - (completing-read prompt (cons '("*" nil) (nth 1 head)) - nil t value - gnus-diary-header-value-history) + (gnus-completing-read prompt (cons '("*" nil) (nth 1 head)) + t value + 'gnus-diary-header-value-history) (read-string prompt value - gnus-diary-header-value-history)))) + 'gnus-diary-header-value-history)))) (setq ask nil) (setq invalid nil) (condition-case () diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index f9502b43c06..da20c66ddbc 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -152,12 +152,8 @@ filenames." (setq destination (if (= (length bufs) 1) (get-buffer (car bufs)) - (completing-read "Attach to which mail composition buffer: " - (mapcar - (lambda (b) - (cons b (get-buffer b))) - bufs) - nil t))) + (gnus-completing-read "Attach to which mail composition buffer" + bufs t))) ;; setup a new mail composition buffer (let ((mail-user-agent gnus-dired-mail-mode) ;; A workaround to prevent Gnus from displaying the Gnus diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 14e224051bb..2af975b09c7 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -33,14 +33,13 @@ (defcustom gnus-gravatar-size 32 "How big should gravatars be displayed." :type 'integer + :version "24.1" :group 'gnus-gravatar) -(defcustom gnus-gravatar-relief 1 - "If non-nil, adds a shadow rectangle around the image. The -value, relief, specifies the width of the shadow lines, in -pixels. If relief is negative, shadows are drawn so that the -image appears as a pressed button; otherwise, it appears as an -unpressed button." +(defcustom gnus-gravatar-properties '(:ascent center :relief 1) + "List of image properties applied to Gravatar images." + :type 'list + :version "24.1" :group 'gnus-gravatar) (defun gnus-gravatar-transform-address (header category) @@ -88,7 +87,7 @@ Set image category to CATEGORY." (point (point)) (gravatar (append gravatar - `(:ascent center :relief ,gnus-gravatar-relief)))) + gnus-gravatar-properties))) (gnus-put-image gravatar nil category) (put-text-property point (point) 'gnus-gravatar address) (gnus-add-wash-type category) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 7dddb9b6f70..eb594f3e71f 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2164,44 +2164,35 @@ be permanent." group))) (goto-char start))))) -(defun gnus-group-completing-read (prompt &optional collection predicate - require-match initial-input hist def - &rest args) +(defun gnus-group-completing-read (&optional prompt collection + require-match initial-input hist def) "Read a group name with completion. Non-ASCII group names are allowed. The arguments are the same as `completing-read' except that COLLECTION and HIST default to `gnus-active-hashtb' and `gnus-group-history' respectively if they are omitted." - (let ((completion-styles (and (boundp 'completion-styles) - completion-styles)) - group) - (push 'substring completion-styles) - (mapatoms (lambda (symbol) - (setq group (symbol-name symbol)) - (set (intern (if (string-match "[^\000-\177]" group) - (gnus-group-decoded-name group) - group) - collection) - group)) - (prog1 - (or collection - (setq collection (or gnus-active-hashtb [0]))) - (setq collection (gnus-make-hashtable (length collection))))) - (setq group (apply 'completing-read prompt collection predicate - require-match initial-input - (or hist 'gnus-group-history) - def args)) - (or (prog1 - (symbol-value (intern-soft group collection)) - (setq collection nil)) - (mm-encode-coding-string group (gnus-group-name-charset nil group))))) + (let* ((choices (mapcar (lambda (symbol) + (let ((group (symbol-name symbol))) + (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group))) + (remove-if-not + 'symbolp + (or collection (or gnus-active-hashtb [0]))))) + (group + (gnus-completing-read (or prompt "Group") choices + require-match initial-input + (or hist 'gnus-group-history) + def))) + (or (symbol-value (intern-soft group collection)) + (mm-encode-coding-string group (gnus-group-name-charset nil group))))) ;;;###autoload (defun gnus-fetch-group (group &optional articles) "Start Gnus if necessary and enter GROUP. If ARTICLES, display those articles. Returns whether the fetching was successful or not." - (interactive (list (gnus-group-completing-read "Group name: " - nil nil nil + (interactive (list (gnus-group-completing-read nil + nil nil (gnus-group-name-at-point)))) (unless (gnus-alive-p) (gnus-no-server)) @@ -2261,7 +2252,7 @@ Return the name of the group if selection was successful." (interactive (list ;; (gnus-read-group "Group name: ") - (gnus-group-completing-read "Group: ") + (gnus-group-completing-read) (gnus-read-method "From method: "))) ;; Transform the select method into a unique server. (when (stringp method) @@ -2328,7 +2319,7 @@ specified by `gnus-gmane-group-download-format'." ;; See for more information. (interactive (list - (gnus-group-completing-read "Gmane group: ") + (gnus-group-completing-read "Gmane group") (read-number "Start article number: ") (read-number "How many articles: "))) (unless range (setq range 500)) @@ -2362,7 +2353,7 @@ Valid input formats include: ;; prompt the user to decide: "View via `browse-url' or in Gnus? " ;; (`gnus-read-ephemeral-gmane-group-url') (interactive - (list (gnus-group-completing-read "Gmane URL: "))) + (list (gnus-group-completing-read "Gmane URL"))) (let (group start range) (cond ;; URLs providing `group', `start' and `range': @@ -2456,13 +2447,13 @@ If PROMPT (the prefix) is a number, use the prompt specified in `gnus-group-jump-to-group-prompt'." (interactive (list (gnus-group-completing-read - "Group: " nil nil (gnus-read-active-file-p) - (if current-prefix-arg - (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) - (or (and (stringp gnus-group-jump-to-group-prompt) - gnus-group-jump-to-group-prompt) - (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) - (and (stringp p) p))))))) + nil nil (gnus-read-active-file-p) + (if current-prefix-arg + (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) + (or (and (stringp gnus-group-jump-to-group-prompt) + gnus-group-jump-to-group-prompt) + (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) + (and (stringp p) p))))))) (when (equal group "") (error "Empty group name")) @@ -2653,7 +2644,7 @@ If EXCLUDE-GROUP, do not go to that group." (defun gnus-group-make-group-simple (&optional group) "Add a new newsgroup. The user will be prompted for GROUP." - (interactive (list (gnus-group-completing-read "Group: "))) + (interactive (list (gnus-group-completing-read))) (gnus-group-make-group (gnus-group-real-name group) (gnus-group-server group) nil nil t)) @@ -2912,8 +2903,9 @@ and NEW-NAME will be prompted for." (defun gnus-group-make-useful-group (group method) "Create one of the groups described in `gnus-useful-groups'." (interactive - (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups - nil t) + (let ((entry (assoc (gnus-completing-read "Create group" + (mapcar 'car gnus-useful-groups) + t) gnus-useful-groups))) (list (cadr entry) ;; Don't use `caddr' here since macros within the `interactive' @@ -3005,11 +2997,11 @@ If SOLID (the prefix), create a solid group." (symbol-name (caar nnweb-type-definition)))) (type (gnus-string-or - (completing-read - (format "Search engine type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) + (gnus-completing-read + "Search engine type" + (mapcar (lambda (elem) (symbol-name (car elem))) nnweb-type-definition) - nil t nil 'gnus-group-web-type-history) + t nil 'gnus-group-web-type-history) default-type)) (search (read-string @@ -3100,8 +3092,8 @@ mail messages or news articles in files that have numeric names." "Add the current group to a virtual group." (interactive (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) + (gnus-group-completing-read "Add to virtual group" + nil t "nnvirtual:"))) (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) (error "%s is not an nnvirtual group" vgroup)) (gnus-close-group vgroup) @@ -3672,7 +3664,7 @@ If given numerical prefix, toggle the N next groups." Killed newsgroups are subscribed. If SILENT, don't try to update the group line." (interactive (list (gnus-group-completing-read - "Group: " nil nil (gnus-read-active-file-p)))) + nil (gnus-read-active-file-p)))) (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) @@ -4013,7 +4005,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." If given a prefix argument, prompt for a group." (interactive (list (or (when current-prefix-arg - (gnus-group-completing-read "Group: ")) + (gnus-group-completing-read)) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -4314,18 +4306,18 @@ If called interactively, this function will ask for a select method If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive - (list (let ((how (completing-read - "Which back end: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) + (list (let ((how (gnus-completing-read + "Which back end" + (mapcar 'car (append gnus-valid-select-methods gnus-server-alist)) + t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a back end name or a virtual server name. ;; If the first, we also need an address. (if (assoc how gnus-valid-select-methods) (list (intern how) ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar 'list gnus-secondary-servers))) + (gnus-completing-read + "Address" + gnus-secondary-servers)) ;; We got a server name. how)))) (gnus-browse-foreign-server method)) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 3245b16997b..33d020f2a1a 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -94,11 +94,10 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server." (when confirm ;; Read server name with completion. (setq gnus-nntp-server - (completing-read "NNTP server: " - (mapcar 'list - (cons (list gnus-nntp-server) - gnus-secondary-servers)) - nil nil gnus-nntp-server))) + (gnus-completing-read "NNTP server" + (cons gnus-nntp-server + gnus-secondary-servers) + nil gnus-nntp-server))) (when (and gnus-nntp-server (stringp gnus-nntp-server) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index a2a2652b082..a3794f28a93 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -578,8 +578,8 @@ If ARG is 1, prompt for a group name to find the posting style." (if arg (if (= 1 (prefix-numeric-value arg)) (gnus-group-completing-read - "Use posting style of group: " - nil nil (gnus-read-active-file-p)) + "Use posting style of group" + nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -607,8 +607,8 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group: " - nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) @@ -628,7 +628,7 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-group-completing-read "Newsgroup" nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) @@ -654,8 +654,8 @@ posting style." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group: " - nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -684,8 +684,8 @@ network. The corresponding back end must have a 'request-post method." (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group: " - nil nil + (gnus-group-completing-read "Use group" + nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -710,7 +710,7 @@ a news." (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-group-completing-read "Newsgroup" nil (gnus-read-active-file-p)) "") gnus-newsgroup-name)) @@ -1028,8 +1028,8 @@ If SILENT, don't prompt the user." gnus-last-posting-server) ;; Just use the last value. gnus-last-posting-server - (completing-read - "Posting method: " method-alist nil t + (gnus-completing-read + "Posting method" (mapcar 'car method-alist) t (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. @@ -1487,7 +1487,7 @@ If YANK is non-nil, include the original article." (defun gnus-summary-yank-message (buffer n) "Yank the current article into a composed message." (interactive - (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) + (list (gnus-completing-read "Buffer" (message-buffers) t) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-inhibit-treatment t)) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index a30847b0e2b..c7dd012d533 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -857,12 +857,11 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (defun gnus-registry-read-mark () "Read a mark name from the user with completion." - (let ((mark (gnus-completing-read-with-default - (symbol-name gnus-registry-default-mark) - "Label" - (mapcar (lambda (x) ; completion list - (cons (symbol-name (car-safe x)) (car-safe x))) - gnus-registry-marks)))) + (let ((mark (gnus-completing-read + "Label" + (mapcar 'symbol-name (mapcar 'car gnus-registry-marks)) + nil nil nil + (symbol-name gnus-registry-default-mark)))) (when (stringp mark) (intern mark)))) @@ -1173,10 +1172,6 @@ Returns the first place where the trail finds a group name." ;;; we could call it here: (customize-variable 'gnus-registry-install) gnus-registry-install) -(when (or (eq gnus-registry-install t) - (gnus-registry-install-p)) - (gnus-registry-initialize)) - ;; TODO: a few things (provide 'gnus-registry) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 03ff30d2b4b..26c3ca34e7b 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -680,14 +680,14 @@ file for the command instead of the current score file." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol - (gnus-completing-read-with-default - (symbol-name (car gnus-extra-headers)) ; default response - "Score extra header" ; prompt - (mapcar (lambda (x) ; completion list - (cons (symbol-name x) x)) - gnus-extra-headers) - nil ; no completion limit - t)))) ; require match + (let ((collection (mapcar 'symbol-name gnus-extra-headers))) + (gnus-completing-read + "Score extra header" ; prompt + collection ; completion list + t ; require match + nil ; no history + nil ; no initial-input + (car collection)))))) ; default value ;; extra is now nil or a symbol. ;; We have all the data, so we enter this score. @@ -913,10 +913,13 @@ MATCH is the string we are looking for. TYPE is the score type. SCORE is the score to add. EXTRA is the possible non-standard header." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) + (interactive (list (gnus-completing-read "Header" + (mapcar + 'car + (remove-if-not + (lambda (x) (fboundp (nth 2 x))) + gnus-header-index)) + t) (read-string "Match: ") (if (y-or-n-p "Use regexp match? ") 'r 's) (string-to-number (read-string "Score: ")))) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 11164a8df6c..2b13f39ddb0 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -571,8 +571,9 @@ The following commands are available: (defun gnus-server-add-server (how where) (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) + (list (intern (gnus-completing-read "Server method" + (mapcar 'car gnus-valid-select-methods) + t)) (read-string "Server name: "))) (when (assq where gnus-server-alist) (error "Server with that name already defined")) @@ -582,7 +583,7 @@ The following commands are available: (defun gnus-server-goto-server (server) "Jump to a server line." (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) + (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist) t))) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b8b17b39918..4cd716803b6 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7999,10 +7999,9 @@ If FORCE, go to the article even if it isn't displayed. If FORCE is a number, it is the line the article is to be displayed on." (interactive (list - (completing-read - "Article number or Message-ID: " - (mapcar (lambda (number) (list (int-to-string number))) - gnus-newsgroup-limit)) + (gnus-completing-read + "Article number or Message-ID" + (mapcar 'int-to-string gnus-newsgroup-limit)) current-prefix-arg t)) (prog1 @@ -8256,16 +8255,13 @@ articles that are younger than AGE days." (interactive (let ((header (intern - (gnus-completing-read-with-default - (symbol-name (car gnus-extra-headers)) + (gnus-completing-read (if current-prefix-arg "Exclude extra header" "Limit extra header") - (mapcar (lambda (x) - (cons (symbol-name x) x)) - gnus-extra-headers) - nil - t)))) + (mapcar 'symbol-name gnus-extra-headers) + t nil nil + (symbol-name (car gnus-extra-headers)))))) (list header (read-string (format "%s header %s (regexp): " (if current-prefix-arg "Exclude" "Limit to") @@ -9234,14 +9230,14 @@ If HEADER is an empty string (or nil), the match is done on the entire article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) - (completing-read - "Header name: " - (mapcar (lambda (header) (list (format "%s" header))) + (gnus-completing-read + "Header name" + (mapcar 'symbol-name (append - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body") + '(Number Subject From Lines Date + Message-ID Xref References Body) gnus-extra-headers)) - nil 'require-match)) + 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) @@ -9937,9 +9933,9 @@ latter case, they will be copied into the relevant groups." (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method - (gnus-completing-read-with-default - methname "Backend to use when respooling" - methods nil t nil 'gnus-mail-method-history)) + (gnus-completing-read + "Backend to use when respooling" + methods t nil 'gnus-mail-method-history methname)) ms) (cond ((zerop (length (setq ms (gnus-servers-using-backend @@ -9949,7 +9945,7 @@ latter case, they will be copied into the relevant groups." (car ms)) (t (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) - (cdr (assoc (completing-read "Server name: " ms-alist nil t) + (cdr (assoc (gnus-completing-read "Server name" ms-alist t) ms-alist)))))))) (unless method (error "No method given for respooling")) @@ -11904,7 +11900,8 @@ save those articles instead." (nreverse split-name))) (defun gnus-valid-move-group-p (group) - (and (boundp group) + (and (symbolp group) + (boundp group) (symbol-name group) (symbol-value group) (gnus-get-function (gnus-find-method-for-group @@ -11921,29 +11918,20 @@ save those articles instead." (format "these %d articles" (length articles)) "this article"))) (to-newsgroup - (let (active group) - (when (or (null split-name) (= 1 (length split-name))) - (setq active (gnus-make-hashtable (length gnus-active-hashtb))) - (mapatoms (lambda (symbol) - (setq group (symbol-name symbol)) - (when (string-match "[^\000-\177]" group) - (setq group (gnus-group-decoded-name group))) - (set (intern group active) group)) - gnus-active-hashtb)) - (cond - ((null split-name) - (gnus-completing-read-with-default - default prom active 'gnus-valid-move-group-p nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read-with-default - (car split-name) prom active 'gnus-valid-move-group-p nil nil - 'gnus-group-history)) - (t - (gnus-completing-read-with-default - nil prom (mapcar 'list (nreverse split-name)) nil nil nil - 'gnus-group-history))))) - (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) + (cond + ((null split-name) + (gnus-group-completing-read + prom + (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb) + nil prefix nil default)) + ((= 1 (length split-name)) + (gnus-group-completing-read + prom (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb) + nil prefix 'gnus-group-history (car split-name))) + (t + (gnus-completing-read + prom (nreverse split-name) nil nil 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) encoded) (when to-newsgroup (if (or (string= to-newsgroup "") diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 7c710357b9d..b600fac3533 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -161,9 +161,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." (interactive - (list (completing-read "Go to topic: " - (mapcar 'list (gnus-topic-list)) - nil t))) + (list (gnus-completing-read "Go to topic" (gnus-topic-list) t))) (let ((buffer-read-only nil)) (dolist (topic (gnus-current-topics topic)) (unless (gnus-topic-goto-topic topic) @@ -1303,7 +1301,7 @@ When used interactively, PARENT will be the topic under point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg - (gnus-completing-read "Move to topic" gnus-topic-alist nil t + (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t 'gnus-topic-history))) (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) @@ -1350,7 +1348,7 @@ If COPYP, copy the groups instead." "Copy the current group to a topic." (interactive (list current-prefix-arg - (completing-read "Copy to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Copy to topic" (mapcar 'car gnus-topic-alist) t))) (gnus-topic-move-group n topic t)) (defun gnus-topic-kill-group (&optional n discard) @@ -1443,7 +1441,8 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (gnus-topic-remove-topic t nil) (let ((topic (gnus-topic-find-topology - (completing-read "Show topic: " gnus-topic-alist nil t)))) + (gnus-completing-read "Show topic" + (mapcar 'car gnus-topic-alist) t)))) (setcar (cddr (cadr topic)) nil) (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) @@ -1491,7 +1490,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (let (topic) (nreverse (list - (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) + (setq topic (gnus-completing-read "Move to topic" + (mapcar 'car gnus-topic-alist) t)) (read-string (format "Move to %s (regexp): " topic)))))) (gnus-group-mark-regexp regexp) (gnus-topic-move-group nil topic copyp)) @@ -1502,7 +1502,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (let (topic) (nreverse (list - (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) + (setq topic (gnus-completing-read "Copy to topic" + (mapcar 'car gnus-topic-alist) t)) (read-string (format "Copy to %s (regexp): " topic)))))) (gnus-topic-move-matching regexp topic t)) @@ -1723,8 +1724,9 @@ If REVERSE, sort in reverse order." "Sort topics in TOPIC alphabetically by topic name. If REVERSE, reverse the sorting order." (interactive - (list (completing-read "Sort topics in : " gnus-topic-alist nil t - (gnus-current-topic)) + (list (gnus-completing-read "Sort topics in" + (mapcar 'car gnus-topic-alist) t + (gnus-current-topic)) current-prefix-arg)) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) gnus-topic-topology))) @@ -1738,7 +1740,7 @@ If REVERSE, reverse the sorting order." (interactive (list (gnus-group-topic-name) - (completing-read "Move to topic: " gnus-topic-alist nil t))) + (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t))) (unless (and current to) (error "Can't find topic")) (let ((current-top (cdr (gnus-topic-find-topology current))) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 5ebccc03f0f..2f9bdd62e6e 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -44,6 +44,32 @@ (defmacro with-no-warnings (&rest body) `(progn ,@body)))) +(defcustom gnus-completing-read-function + #'gnus-std-completing-read + "Function to do a completing read." + :group 'gnus-meta + :type '(radio (function-item + :doc "Use Emacs' standard `completing-read' function." + gnus-std-completing-read) + (function-item :doc "Use iswitchb's completing-read function." + gnus-icompleting-read) + (function-item :doc "Use ido's completing-read function." + gnus-ido-completing-read) + (function))) + +(defcustom gnus-completion-styles + (if (and (boundp 'completion-styles-alist) + (boundp 'completion-styles)) + (append (when (and (assq 'substring completion-styles-alist) + (not (memq 'substring completion-styles))) + (list 'substring)) + completion-styles) + nil) + "Value of `completion-styles' to use when completing." + :version "24.1" + :group 'gnus-meta + :type 'list) + ;; Fixme: this should be a gnus variable, not nnmail-. (defvar nnmail-pathname-coding-system) (defvar nnmail-active-file-coding-system) @@ -344,16 +370,6 @@ TIME defaults to the current time." (define-key keymap key (pop plist)) (pop plist))))) -(defun gnus-completing-read-with-default (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default "): ") - (concat prompt ": "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - ;; Two silly functions to ensure that all `y-or-n-p' questions clear ;; the echo area. ;; @@ -1574,21 +1590,50 @@ SPEC is a predicate specifier that contains stuff like `or', `and', `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) -(defun gnus-completing-read (prompt table &optional predicate require-match - history) - (when (and history - (not (boundp history))) - (set history nil)) - (completing-read - (if (symbol-value history) - (concat prompt " (" (car (symbol-value history)) "): ") - (concat prompt ": ")) - table - predicate - require-match - nil - history - (car (symbol-value history)))) +(defun gnus-std-completing-read (prompt collection &optional require-match + initial-input history def) + (completing-read prompt collection nil require-match + initial-input history def)) + +(defun gnus-icompleting-read (prompt collection &optional require-match + initial-input history def) + (require 'iswitchb) + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist + (let ((choices (append (list) + (when initial-input (list initial-input)) + (symbol-value history) collection)) + filtered-choices) + (while choices + (when (and (car choices) (not (member (car choices) filtered-choices))) + (setq filtered-choices (cons (car choices) filtered-choices))) + (setq choices (cdr choices))) + (nreverse filtered-choices)))))) + (unwind-protect + (progn + (when (not iswitchb-mode) + (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (iswitchb-read-buffer prompt def require-match)) + (when (not iswitchb-mode) + (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) + +(defun gnus-ido-completing-read (prompt collection &optional require-match + initial-input history def) + (require 'ido) + (ido-completing-read prompt collection nil require-match + initial-input history def)) + +(defun gnus-completing-read (prompt collection &optional require-match + initial-input history def) + "Do a completing read with the configured `gnus-completing-read-function'." + (let ((completion-styles gnus-completion-styles)) + (funcall + gnus-completing-read-function + (concat prompt (when def + (concat " (default " def ")")) + ": ") + collection require-match initial-input history def))) (defun gnus-graphic-display-p () (if (featurep 'xemacs) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 2024721ab0a..53a30efd22e 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1427,6 +1427,7 @@ no need to set this variable." :group 'gnus-message :type '(choice (const :tag "default" nil) string)) +(make-obsolete-variable 'gnus-local-domain nil "24.1") (defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. @@ -4241,9 +4242,9 @@ Allow completion over sensible values." gnus-predefined-server-alist gnus-server-alist)) (method - (completing-read - prompt servers - nil t nil 'gnus-method-history))) + (gnus-completing-read + prompt (mapcar 'car servers) + t nil 'gnus-method-history))) (cond ((equal method "") (setq method gnus-select-method)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 9b756edae40..7562e57ca8f 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1323,11 +1323,11 @@ Use CMD as the process." "Display HANDLE using METHOD." (let* ((type (mm-handle-media-type handle)) (methods - (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) + (mapcar (lambda (i) (cdr (assoc 'viewer i))) (mailcap-mime-info type 'all))) (method (let ((minibuffer-local-completion-map mm-viewer-completion-map)) - (completing-read "Viewer: " methods)))) + (gnus-completing-read "Viewer" methods)))) (when (string= method "") (error "No method given")) (if (string-match "^[^% \t]+$" method) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index c997a36a1bd..65543d11bb5 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -68,11 +68,11 @@ . ,(lambda (prompt) "Return a charset." (intern - (completing-read + (gnus-completing-read prompt - (mapcar (lambda (e) (list (symbol-name (car e)))) + (mapcar (lambda (e) (symbol-name (car e))) mm-mime-mule-charset-alist) - nil t)))) + t)))) ;; `subst-char-in-string' is not available in XEmacs 21.4. (subst-char-in-string . ,(lambda (from to string &optional inplace) @@ -281,8 +281,8 @@ to the contents of the accessible portion of the buffer." 'read-coding-system)) (t (lambda (prompt &optional default-coding-system) "Prompt the user for a coding system." - (completing-read - prompt (mapcar (lambda (s) (list (symbol-name (car s)))) + (gnus-completing-read + prompt (mapcar (lambda (s) (symbol-name (car s))) mm-mime-mule-charset-alist))))))) (defvar mm-coding-system-list nil) @@ -316,8 +316,8 @@ the alias. Else windows-NUMBER is used." (cp-supported-codepages) ;; Removed in Emacs 23 (unicode), so signal an error: (error "`codepage-setup' not present in this Emacs version")))) - (list (completing-read "Setup DOS Codepage: (default 437) " candidates - nil t nil nil "437")))) + (list (gnus-completing-read "Setup DOS Codepage" candidates + t nil nil "437")))) (when alias (setq alias (if (stringp alias) (intern alias) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 1a2d940e2e5..566908ce1cb 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -31,6 +31,7 @@ (require 'mm-decode) (require 'smime) +(autoload 'gnus-completing-read "gnus-util") (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") @@ -676,11 +677,9 @@ (if (= (length smime-keys) 1) (cadar smime-keys) (smime-get-key-by-email - (completing-read - (concat "Decipher using key" - (if smime-keys (concat "(default " (caar smime-keys) "): ") - ": ")) - smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) + (gnus-completing-read + "Decipher using key" + smime-keys nil nil nil (car-safe (car-safe smime-keys)))))) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index a99538be0af..62e742f93a1 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -161,10 +161,10 @@ Whether the passphrase is cached at all is controlled by ""))))) (and from (smime-get-key-by-email from))) (smime-get-key-by-email - (completing-read "Sign this part with what signature? " - smime-keys nil nil - (and (listp (car-safe smime-keys)) - (caar smime-keys)))))))) + (gnus-completing-read "Sign this part with what signature" + smime-keys nil nil + (and (listp (car-safe smime-keys)) + (caar smime-keys)))))))) (defun mml-smime-get-file-cert () (ignore-errors @@ -213,15 +213,16 @@ Whether the passphrase is cached at all is controlled by (quit)) result)) -(autoload 'gnus-completing-read-with-default "gnus-util") +(autoload 'gnus-completing-read "gnus-util") (defun mml-smime-openssl-encrypt-query () ;; todo: try dns/ldap automatically first, before prompting user (let (certs done) (while (not done) - (ecase (read (gnus-completing-read-with-default - "ldap" "Fetch certificate from" - '(("dns") ("ldap") ("file")) nil t)) + (ecase (read (gnus-completing-read + "Fetch certificate from" + '(("dns") ("ldap") ("file")) t nil nil + "ldap")) (dns (setq certs (append certs (mml-smime-get-dns-cert)))) (ldap (setq certs (append certs diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 15b1bb7096b..3cf0f3701fd 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -40,6 +40,7 @@ (autoload 'message-make-message-id "message") (declare-function gnus-setup-posting-charset "gnus-msg" (group)) (autoload 'gnus-make-local-hook "gnus-util") +(autoload 'gnus-completing-read "gnus-util") (autoload 'message-fetch-field "message") (autoload 'message-mark-active-p "message") (autoload 'message-info "message") @@ -1188,9 +1189,10 @@ If not set, `default-directory' will be used." ;; looks like, and offer text/plain if it looks ;; like text/plain. "application/octet-stream")) - (string (completing-read - (format "Content type (default %s): " default) - (mapcar 'list (mailcap-mime-types))))) + (string (gnus-completing-read + "Content type" + (mailcap-mime-types) + nil nil nil default))) (if (not (equal string "")) string default))) @@ -1204,10 +1206,10 @@ If not set, `default-directory' will be used." (defun mml-minibuffer-read-disposition (type &optional default filename) (unless default (setq default (mml-content-disposition type filename))) - (let ((disposition (completing-read - (format "Disposition (default %s): " default) - '(("attachment") ("inline") ("")) - nil t nil nil default))) + (let ((disposition (gnus-completing-read + "Disposition" + '("attachment" "inline") + t nil nil default))) (if (not (equal disposition "")) disposition default))) @@ -1395,11 +1397,11 @@ TYPE is the MIME type to use." (defun mml-insert-multipart (&optional type) (interactive (if (message-in-body-p) - (list (completing-read "Multipart type (default mixed): " - '(("mixed") ("alternative") - ("digest") ("parallel") - ("signed") ("encrypted")) - nil nil "mixed")) + (list (gnus-completing-read "Multipart type" + '("mixed" "alternative" + "digest" "parallel" + "signed" "encrypted") + nil "mixed")) (error "Use this command in the message body"))) (or type (setq type "mixed")) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 15e5e82c6f9..588eeb11680 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -280,6 +280,11 @@ from the document.") (t (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) +(deffoo nndoc-retrieve-groups (groups &optional server) + (dolist (group groups) + (nndoc-request-group group server)) + t) + (deffoo nndoc-request-type (group &optional article) (cond ((not article) 'unknown) (nndoc-post-type nndoc-post-type) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 5dc51f321c5..98c14d4cab2 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -224,7 +224,7 @@ are generated if and only if they are also in `message-draft-headers'.") (let* ((nnmh-allow-delete-final t) (nnmail-expiry-target (or (gnus-group-find-parameter - (gnus-group-prefixed-name "nndraft" (list 'nndraft server)) + (gnus-group-prefixed-name group (list 'nndraft server)) 'expiry-target t) nnmail-expiry-target)) (res (nnoo-parent-function 'nndraft diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index a61a02899cc..1dd561ab6ac 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -70,6 +70,9 @@ Values are `ssl', `network', `starttls' or `shell'.") "How mail is split. Uses the same syntax as nnmail-split-methods") +(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'" + "Gnus 5.13") + (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods) or `anonymous'.") @@ -342,15 +345,6 @@ textual parts.") (when (eq nnimap-stream 'starttls) (nnimap-command "STARTTLS") (starttls-negotiate (nnimap-process nnimap-object))) - ;; If this is a STARTTLS-capable server, then sever the - ;; connection and start a STARTTLS connection instead. - (when (and (eq nnimap-stream 'network) - (member "STARTTLS" (nnimap-capabilities nnimap-object))) - (let ((nnimap-stream 'starttls)) - (delete-process (nnimap-process nnimap-object)) - (kill-buffer (current-buffer)) - (return - (nnimap-open-connection buffer)))) (when nnimap-server-port (push (format "%s" nnimap-server-port) ports)) (unless (equal connection-result "PREAUTH") @@ -428,7 +422,12 @@ textual parts.") (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) (goto-char (point-min)) (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) - (setq structure (ignore-errors (read (current-buffer))) + (setq structure (ignore-errors + (let ((start (point))) + (forward-sexp 1) + (downcase-region start (point)) + (goto-char (point)) + (read (current-buffer)))) parts (nnimap-find-wanted-parts structure)))) (when (if parts (nnimap-get-partial-article article parts structure) @@ -509,8 +508,15 @@ textual parts.") t)) (defun nnimap-insert-partial-structure (structure parts &optional subp) - (let ((type (car (last structure 4))) - (boundary (cadr (member "BOUNDARY" (car (last structure 3)))))) + (let (type boundary) + (let ((bstruc structure)) + (while (consp (car bstruc)) + (pop bstruc)) + (setq type (car bstruc)) + (setq bstruc (car (cdr bstruc))) + (when (and (stringp (car bstruc)) + (string= (downcase (car bstruc)) "boundary")) + (setq boundary (cadr bstruc)))) (when subp (insert (format "Content-type: multipart/%s; boundary=%S\n\n" (downcase type) boundary))) @@ -768,6 +774,7 @@ textual parts.") (when (nnimap-possibly-change-group group server) (let (sequence) (with-current-buffer (nnimap-buffer) + (erase-buffer) ;; Just send all the STORE commands without waiting for ;; response. If they're successful, they're successful. (dolist (action actions) @@ -789,6 +796,7 @@ textual parts.") (deffoo nnimap-request-accept-article (group &optional server last) (when (nnimap-possibly-change-group nil server) (nnmail-check-syntax) + (nnimap-add-cr) (let ((message (buffer-string)) (message-id (message-field-value "message-id")) sequence) @@ -1288,7 +1296,9 @@ textual parts.") (defun nnimap-split-incoming-mail () (with-current-buffer (nnimap-buffer) (let ((nnimap-incoming-split-list nil) - (nnmail-split-methods nnimap-split-methods) + (nnmail-split-methods (if (eq nnimap-split-methods 'default) + nnmail-split-methods + nnimap-split-methods)) (nnmail-inhibit-default-split-group t) (groups (nnimap-get-groups)) new-articles) @@ -1339,6 +1349,7 @@ textual parts.") (defun nnimap-mark-and-expunge-incoming (range) (when range (setq range (nnimap-article-ranges range)) + (erase-buffer) (let ((sequence (nnimap-send-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" range))) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index db8b3971787..455a0fdaa6e 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1588,7 +1588,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) - (let* ((result (apply 'completing-read prompt)) + (let* ((result (gnus-completing-read prompt nil)) (mapping (or (assoc result nnir-imap-search-arguments) (assoc nil nnir-imap-search-arguments)))) (cons sym (format (cdr mapping) result))) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index bca549a6832..9672c04b494 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -848,8 +848,8 @@ called interactively, user will be asked for parameters." All necessary information will be queried from the user." (interactive) (let* ((name (read-string "Name of the mairix server: ")) - (server (completing-read "Back end server (TAB for completion): " - (nnmairix-get-valid-servers) nil 1)) + (server (gnus-completing-read "Back end server" + (nnmairix-get-valid-servers) t)) (mairix (read-string "Command to call mairix: " "mairix")) (defaultgroup (read-string "Default search group: ")) (backend (symbol-name (car (gnus-server-to-method server)))) @@ -1165,7 +1165,7 @@ nnmairix server. Only marks from current session will be set." If SKIPDEFAULT is t, the default search group will not be updated. If UPDATEDB is t, database for SERVERNAME will be updated first." - (interactive (list (completing-read "Update groups on server: " + (interactive (list (gnus-completing-read "Update groups on server" (nnmairix-get-nnmairix-servers)))) (save-excursion (when (string-match ".*:\\(.*\\)" servername) @@ -1302,7 +1302,7 @@ Otherwise, ask user for server." (while (equal '("") (setq nnmairix-last-server - (list (completing-read "Server: " openedserver nil 1 + (list (gnus-completing-read "Server" openedserver t (or nnmairix-last-server "nnmairix:")))))) nnmairix-last-server) @@ -1492,10 +1492,10 @@ group." (when (not found) (setq mairixserver (gnus-server-to-method - (completing-read - (format "Cannot determine which nnmairix server indexes %s. Please specify: " + (gnus-completing-read + (format "Cannot determine which nnmairix server indexes %s. Please specify" (gnus-method-to-server server)) - (nnmairix-get-nnmairix-servers) nil nil "nnmairix:"))) + (nnmairix-get-nnmairix-servers) nil "nnmairix:"))) ;; Save result in parameter of default search group so that ;; we don't have to ask again (setq defaultgroup (gnus-group-prefixed-name @@ -1643,9 +1643,9 @@ search in raw mode." (gnus-registry-add-group mid cur))))) (if (> (length allgroups) 1) (setq group - (completing-read - "Message exists in more than one group. Choose: " - allgroups nil t)) + (gnus-completing-read + "Message exists in more than one group. Choose" + allgroups t)) (setq group (car allgroups)))) (if group ;; show article in summary buffer @@ -1748,9 +1748,9 @@ SERVER." (gnus-group-prefixed-name group (car cur)) allgroups)))) (if (> (length allgroups) 1) - (setq group (completing-read - "Group %s exists on more than one IMAP server. Choose: " - allgroups nil t)) + (setq group (gnus-completing-read + "Group %s exists on more than one IMAP server. Choose" + allgroups t)) (setq group (car allgroups)))) group)) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index aa3b79a1022..94fd55ebbfb 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -1048,9 +1048,9 @@ whether they are `offsite' or `onsite'." (cdr (assoc "feedid" listinfo))))) feedinfo))) (cdr (assoc - (completing-read - "Multiple feeds found. Select one: " - selection nil t) urllist))))))))) + (gnus-completing-read + "Multiple feeds found. Select one" + selection t) urllist))))))))) (defun nnrss-rss-p (data) "Test if DATA is an RSS feed. diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index d2953dcffc9..20fe5609150 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -82,6 +82,15 @@ valid value is 'apop'." :version "22.1" ;; Oort Gnus :group 'pop3) +(defcustom pop3-stream-length 100 + "How many messages should be requested at one time. +The lower the number, the more latency-sensitive the fetching +will be. If your pop3 server doesn't support streaming at all, +set this to 1." + :type 'number + :version "24.1" + :group 'pop3) + (defcustom pop3-leave-mail-on-server nil "*Non-nil if the mail is to be left on the POP server after fetching. @@ -156,7 +165,7 @@ Use streaming commands." (while (>= count i) (process-send-string process (format "%s %d\r\n" command i)) ;; Only do 100 messages at a time to avoid pipe stalls. - (when (zerop (% i 100)) + (when (zerop (% i pop3-stream-length)) (pop3-wait-for-messages process i total-size)) (incf i))) (pop3-wait-for-messages process count total-size)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index a2668199469..2492007f583 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -371,12 +371,9 @@ KEYFILE should contain a PEM encoded key and certificate." (if keyfile keyfile (smime-get-key-with-certs-by-email - (completing-read - (concat "Sign using key" - (if smime-keys - (concat " (default " (caar smime-keys) "): ") - ": ")) - smime-keys nil nil (car-safe (car-safe smime-keys)))))) + (gnus-completing-read + "Sign using key" + smime-keys nil (car-safe (car-safe smime-keys)))))) (error "Signing failed")))) (defun smime-encrypt-buffer (&optional certfiles buffer) @@ -502,11 +499,9 @@ in the buffer specified by `smime-details-buffer'." (expand-file-name (or keyfile (smime-get-key-by-email - (completing-read - (concat "Decipher using key" - (if smime-keys (concat " (default " (caar smime-keys) "): ") - ": ")) - smime-keys nil nil (car-safe (car-safe smime-keys))))))))) + (gnus-completing-read + "Decipher using key" + smime-keys nil (car-safe (car-safe smime-keys))))))))) ;; Various operations @@ -660,6 +655,7 @@ A string or a list of strings is returned." (define-key smime-mode-map "f" 'smime-certificate-info)) (autoload 'gnus-run-mode-hooks "gnus-util") +(autoload 'gnus-completing-read "gnus-util") (defun smime-mode () "Major mode for browsing, viewing and fetching certificates. diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el index 86d443aa90c..f3b88490855 100644 --- a/lisp/gnus/webmail.el +++ b/lisp/gnus/webmail.el @@ -4,7 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu -;; Keywords: hotmail netaddress my-deja netscape +;; Keywords: hotmail netaddress ;; This file is part of GNU Emacs. @@ -115,39 +115,7 @@ (article-snarf . webmail-netaddress-article) (trash-url "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" - webmail-session id)) - (netscape - (paranoid cookie post agent) - (address . "webmail.netscape.com") - (open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail") - (open-snarf . webmail-netscape-open) - (login-url - content - ("http://ureg.netscape.com/iiop/UReg2/login/loginform") - "U2_USERNAME=%s&U2_PASSWORD=%s%s" - user password webmail-aux) - (login-snarf . webmail-netaddress-login) - (list-url - "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True" - webmail-session) - (list-snarf . webmail-netaddress-list) - (article-url "http://webmail.netscape.com/") - (article-snarf . webmail-netscape-article) - (trash-url - "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" - webmail-session id)) - (my-deja - (paranoid cookie post) - (address . "www.my-deja.com") - ;;(open-snarf . webmail-my-deja-open) - (login-url - content - ("http://mydeja.google.com/cgi-bin/deja/maillogin.py") - "userid=%s&password=%s" - user password) - (list-snarf . webmail-my-deja-list) - (article-snarf . webmail-my-deja-article) - (trash-url webmail-aux id)))) + webmail-session id)))) (defvar webmail-variables '(address article-snarf article-url list-snarf list-url @@ -683,15 +651,6 @@ ;;; netaddress -(defun webmail-netscape-open () - (goto-char (point-min)) - (setq webmail-aux "") - (while (re-search-forward - "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)" - nil t) - (setq webmail-aux (concat webmail-aux "&" (match-string 1) "=" - (match-string 2))))) - (defun webmail-netaddress-open () (goto-char (point-min)) (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t) @@ -872,280 +831,6 @@ (insert ">")))) (mm-append-to-file (point-min) (point-max) file))) -(defun webmail-netscape-article (file id) - (let (p p1 attachment count mime type) - (save-restriction - (webmail-encode-8bit) - (goto-char (point-min)) - (if (not (search-forward "Trash" nil t)) - (webmail-error "article@1")) - (if (not (search-forward "
" nil t)) - (webmail-error "article@2")) - (delete-region (point-min) (match-beginning 0)) - (if (not (search-forward "
" nil t)) - (webmail-error "article@3")) - (narrow-to-region (point-min) (match-end 0)) - (goto-char (point-min)) - (while (re-search-forward "[\040\t\r\n]+" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "]*>[^<]*" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (search-forward "" nil t) - (replace-match "\n")) - (mm-url-remove-markup) - (mm-url-decode-entities-nbsp) - (goto-char (point-min)) - (delete-blank-lines) - (goto-char (point-min)) - (while (re-search-forward "^\040+\\|\040+$" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (re-search-forward "\040+" nil t) - (replace-match " ")) - (goto-char (point-max)) - (widen) - (insert "\n\n") - (setq p (point)) - (unless (search-forward "" nil t) - (webmail-error "article@4")) - (forward-line 14) - (delete-region p (point)) - (goto-char (point-max)) - (unless (re-search-backward - "
" - nil t 2) - (setq mime t) - (unless (search-forward "" nil t) - (webmail-error "article@6")) - (setq p1 (point)) - (if (search-backward "" nil t) - (webmail-error "article@8")) - (delete-region p (point)) - (let (bufname);; Attachment - (save-excursion - (set-buffer (generate-new-buffer " *webmail-att*")) - (mm-url-insert (concat (car webmail-open-url) attachment)) - (push (current-buffer) webmail-buffer-list) - (setq bufname (buffer-name))) - (insert "<#part type=" type) - (insert " buffer=\"" bufname "\"") - (insert " disposition=\"inline\"") - (insert "><#/part>\n") - (setq p (point)))) - (delete-region p p1) - (narrow-to-region - p - (if (search-forward - "" - nil t) - (match-beginning 0) - (point-max))) - (webmail-netaddress-single-part) - (goto-char (point-max)) - (setq p (point)) - (widen))) - (unless mime - (narrow-to-region p (point-max)) - (setq mime (webmail-netaddress-single-part)) - (widen)) - (goto-char (point-min)) - ;; Some blank line to separate mails. - (insert "\n\nFrom nobody " (current-time-string) "\n") - (insert "X-Gnus-Webmail: " (symbol-value 'user) - "@" (symbol-name webmail-type) "\n") - (if id - (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address))) - (unless (looking-at "$") - (if (search-forward "\n\n" nil t) - (forward-line -1) - (webmail-error "article@2"))) - (when mime - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "MIME-Version\\|Content-Type") - (delete-region (point) - (progn - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max)))) - (forward-line 1))) - (goto-char (point-max)) - (widen) - (narrow-to-region (point) (point-max)) - (insert "MIME-Version: 1.0\n" - (prog1 - (mml-generate-mime) - (delete-region (point-min) (point-max)))) - (goto-char (point-min)) - (widen)) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">")))) - (mm-append-to-file (point-min) (point-max) file))) - -;;; my-deja - -(defun webmail-my-deja-open () - (webmail-refresh-redirect) - (goto-char (point-min)) - (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\"" - nil t) - (setq webmail-aux (match-string 1)) - (webmail-error "open@1"))) - -(defun webmail-my-deja-list () - (let (item id newp base) - (goto-char (point-min)) - (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\"" - nil t) - (let ((url (match-string 1))) - (setq base (match-string 2)) - (erase-buffer) - (mm-url-insert url))) - (goto-char (point-min)) - (when (re-search-forward - "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New" - nil t) - (message "Found %s mail(s), %s unread" - (match-string 1) (match-string 2))) - (goto-char (point-min)) - (while (re-search-forward - "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\"" - nil t) - (if (setq id (match-string 2)) - (when (and (or newp (not webmail-newmail-only)) - (not (assoc id webmail-articles))) - (push (cons id (setq webmail-aux - (concat base "/" (match-string 1)))) - webmail-articles) - (setq newp nil)) - (setq newp t))) - (setq webmail-articles (nreverse webmail-articles)))) - -(defun webmail-my-deja-article-part (base) - (let (p) - (cond - ((looking-at "[\t\040\r\n]*