aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGnus developers2010-09-30 08:39:23 +0000
committerKatsumi Yamaoka2010-09-30 08:39:23 +0000
commit229b59da361fdfbea696ef7d829453222b78b219 (patch)
treefde9a1b1de67f3d0522c7701dbb6551a739716df
parent968ef9b4dae78c5badd7f377b26519c8840823e7 (diff)
downloademacs-229b59da361fdfbea696ef7d829453222b78b219.tar.gz
emacs-229b59da361fdfbea696ef7d829453222b78b219.zip
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.
-rw-r--r--doc/misc/gnus.texi56
-rw-r--r--etc/GNUS-NEWS2
-rw-r--r--lisp/gnus/gnus-agent.el11
-rw-r--r--lisp/gnus/gnus-art.el17
-rw-r--r--lisp/gnus/gnus-bookmark.el4
-rw-r--r--lisp/gnus/gnus-diary.el8
-rw-r--r--lisp/gnus/gnus-dired.el8
-rw-r--r--lisp/gnus/gnus-gravatar.el13
-rw-r--r--lisp/gnus/gnus-group.el104
-rw-r--r--lisp/gnus/gnus-int.el9
-rw-r--r--lisp/gnus/gnus-msg.el26
-rw-r--r--lisp/gnus/gnus-registry.el15
-rw-r--r--lisp/gnus/gnus-score.el27
-rw-r--r--lisp/gnus/gnus-srvr.el7
-rw-r--r--lisp/gnus/gnus-sum.el78
-rw-r--r--lisp/gnus/gnus-topic.el24
-rw-r--r--lisp/gnus/gnus-util.el95
-rw-r--r--lisp/gnus/gnus.el7
-rw-r--r--lisp/gnus/mm-decode.el4
-rw-r--r--lisp/gnus/mm-util.el14
-rw-r--r--lisp/gnus/mm-view.el9
-rw-r--r--lisp/gnus/mml-smime.el17
-rw-r--r--lisp/gnus/mml.el26
-rw-r--r--lisp/gnus/nndoc.el5
-rw-r--r--lisp/gnus/nndraft.el2
-rw-r--r--lisp/gnus/nnimap.el37
-rw-r--r--lisp/gnus/nnir.el2
-rw-r--r--lisp/gnus/nnmairix.el26
-rw-r--r--lisp/gnus/nnrss.el6
-rw-r--r--lisp/gnus/pop3.el11
-rw-r--r--lisp/gnus/smime.el18
-rw-r--r--lisp/gnus/webmail.el319
32 files changed, 368 insertions, 639 deletions
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
629 629
630* Server Buffer:: Making and editing virtual servers. 630* Server Buffer:: Making and editing virtual servers.
631* Getting News:: Reading USENET news with Gnus. 631* Getting News:: Reading USENET news with Gnus.
632* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. 632* Using IMAP:: Reading mail from @acronym{IMAP}.
633* Getting Mail:: Reading your personal mail with Gnus. 633* Getting Mail:: Reading your personal mail with Gnus.
634* Browsing the Web:: Getting messages from a plethora of Web sources. 634* Browsing the Web:: Getting messages from a plethora of Web sources.
635* Other Sources:: Reading directories, files. 635* Other Sources:: Reading directories, files.
@@ -10797,7 +10797,7 @@ article is to use Muttprint (@pxref{Saving Articles}).
10797@item A C 10797@item A C
10798@vindex gnus-fetch-partial-articles 10798@vindex gnus-fetch-partial-articles
10799@findex gnus-summary-show-complete-article 10799@findex gnus-summary-show-complete-article
10800If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will 10800If @code{<backend>-fetch-partial-articles} is non-@code{nil}, Gnus will
10801fetch partial articles, if the backend it fetches them from supports 10801fetch partial articles, if the backend it fetches them from supports
10802it. Currently only @code{nnimap} does. If you're looking at a 10802it. Currently only @code{nnimap} does. If you're looking at a
10803partial article, and want to see the complete article instead, then 10803partial article, and want to see the complete article instead, then
@@ -13700,7 +13700,7 @@ The different methods all have their peculiarities, of course.
13700@menu 13700@menu
13701* Server Buffer:: Making and editing virtual servers. 13701* Server Buffer:: Making and editing virtual servers.
13702* Getting News:: Reading USENET news with Gnus. 13702* Getting News:: Reading USENET news with Gnus.
13703* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. 13703* Using IMAP:: Reading mail from @acronym{IMAP}.
13704* Getting Mail:: Reading your personal mail with Gnus. 13704* Getting Mail:: Reading your personal mail with Gnus.
13705* Browsing the Web:: Getting messages from a plethora of Web sources. 13705* Browsing the Web:: Getting messages from a plethora of Web sources.
13706* Other Sources:: Reading directories, files. 13706* Other Sources:: Reading directories, files.
@@ -14787,8 +14787,8 @@ there.
14787@end table 14787@end table
14788 14788
14789 14789
14790@node Using @acronym{IMAP} 14790@node Using IMAP
14791@section Using @acronym{IMAP} 14791@section Using IMAP
14792@cindex imap 14792@cindex imap
14793 14793
14794The most popular mail backend is probably @code{nnimap}, which 14794The 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
14798from different locations, or with different user agents. 14798from different locations, or with different user agents.
14799 14799
14800@menu 14800@menu
14801* Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}. 14801* Connecting to an IMAP Server:: Getting started with @acronym{IMAP}.
14802* Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection. 14802* Customizing the IMAP Connection:: Variables for @acronym{IMAP} connection.
14803* Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box. 14803* Client-Side IMAP Splitting:: Put mail in the correct mail box.
14804@end menu 14804@end menu
14805 14805
14806 14806
14807@node Connecting to an @acronym{IMAP} Server 14807@node Connecting to an IMAP Server
14808@subsection Connecting to an @acronym{IMAP} Server 14808@subsection Connecting to an IMAP Server
14809 14809
14810Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the 14810Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the
14811group buffer, or (if your primary interest is reading email), say 14811group buffer, or (if your primary interest is reading email), say
@@ -14826,15 +14826,15 @@ machine imap.gmail.com login <username> password <password> port imap
14826That should basically be it for most users. 14826That should basically be it for most users.
14827 14827
14828 14828
14829@node Customizing the @acronym{IMAP} Connection 14829@node Customizing the IMAP Connection
14830@subsection Customizing the @acronym{IMAP} Connection 14830@subsection Customizing the IMAP Connection
14831 14831
14832Here's an example method that's more complex: 14832Here's an example method that's more complex:
14833 14833
14834@example 14834@example
14835(nnimap "imap.gmail.com" 14835(nnimap "imap.gmail.com"
14836 (nnimap-inbox "INBOX") 14836 (nnimap-inbox "INBOX")
14837 (nnimap-split-methods ,nnmail-split-methods) 14837 (nnimap-split-methods default)
14838 (nnimap-expunge t) 14838 (nnimap-expunge t)
14839 (nnimap-stream 'ssl) 14839 (nnimap-stream 'ssl)
14840 (nnir-search-engine imap) 14840 (nnir-search-engine imap)
@@ -14878,11 +14878,17 @@ this should be set to @code{anonymous}.
14878Virtually all @code{IMAP} server support fast streaming of data. If 14878Virtually all @code{IMAP} server support fast streaming of data. If
14879you have problems connecting to the server, try setting this to @code{nil}. 14879you have problems connecting to the server, try setting this to @code{nil}.
14880 14880
14881@item nnimap-fetch-partial-articles
14882If non-@code{nil}, fetch partial articles from the server. If set to
14883a string, then it's interpreted as a regexp, and parts that have
14884matching types will be fetched. For instance, @samp{"text/"} will
14885fetch all textual parts, while leaving the rest on the server.
14886
14881@end table 14887@end table
14882 14888
14883 14889
14884@node Client-Side @acronym{IMAP} Splitting 14890@node Client-Side IMAP Splitting
14885@subsection Client-Side @acronym{IMAP} Splitting 14891@subsection Client-Side IMAP Splitting
14886 14892
14887Many people prefer to do the sorting/splitting of mail into their mail 14893Many people prefer to do the sorting/splitting of mail into their mail
14888boxes on the @acronym{IMAP} server. That way they don't have to 14894boxes 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.
14897 14903
14898@item nnimap-split-methods 14904@item nnimap-split-methods
14899Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting 14905Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting
14900Mail}). 14906Mail}), except the symbol @code{default}, which means that it should
14907use the value of the @code{nnmail-split-methods} variable.
14901 14908
14902@end table 14909@end table
14903 14910
@@ -15460,7 +15467,7 @@ Get mail from a @acronym{IMAP} server. If you don't want to use
15460@acronym{IMAP} as intended, as a network mail reading protocol (ie 15467@acronym{IMAP} as intended, as a network mail reading protocol (ie
15461with nnimap), for some reason or other, Gnus let you treat it similar 15468with nnimap), for some reason or other, Gnus let you treat it similar
15462to a @acronym{POP} server and fetches articles from a given 15469to a @acronym{POP} server and fetches articles from a given
15463@acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information. 15470@acronym{IMAP} mailbox. @xref{Using IMAP}, for more information.
15464 15471
15465Keywords: 15472Keywords:
15466 15473
@@ -15929,7 +15936,7 @@ after @code{save-excursion} and @code{save-restriction} in the example
15929above. Also note that with the nnimap backend, message bodies will 15936above. Also note that with the nnimap backend, message bodies will
15930not be downloaded by default. You need to set 15937not be downloaded by default. You need to set
15931@code{nnimap-split-download-body} to @code{t} to do that 15938@code{nnimap-split-download-body} to @code{t} to do that
15932(@pxref{Client-Side @acronym{IMAP} Splitting}). 15939(@pxref{Client-Side IMAP Splitting}).
15933 15940
15934@item (! @var{func} @var{split}) 15941@item (! @var{func} @var{split})
15935If the split is a list, and the first element is @code{!}, then 15942If 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.
23263The size in pixels of gravatars. Gravatars are always square, so one 23270The size in pixels of gravatars. Gravatars are always square, so one
23264number for the size is enough. 23271number for the size is enough.
23265 23272
23266@item gnus-gravatar-relief 23273@item gnus-gravatar-properties
23267@vindex gnus-gravatar-relief 23274@vindex gnus-gravatar-properties
23268If non-nil, adds a shadow rectangle around the image. The value, 23275List of image properties applied to Gravatar images.
23269relief, specifies the width of the shadow lines, in pixels. If relief
23270is negative, shadows are drawn so that the image appears as a pressed
23271button; otherwise, it appears as an unpressed button.
23272 23276
23273@end table 23277@end table
23274 23278
@@ -23618,7 +23622,7 @@ call the external tools during splitting. Example fancy split method:
23618Note that with the nnimap back end, message bodies will not be 23622Note that with the nnimap back end, message bodies will not be
23619downloaded by default. You need to set 23623downloaded by default. You need to set
23620@code{nnimap-split-download-body} to @code{t} to do that 23624@code{nnimap-split-download-body} to @code{t} to do that
23621(@pxref{Client-Side @acronym{IMAP} Splitting}). 23625(@pxref{Client-Side IMAP Splitting}).
23622 23626
23623That is about it. As some spam is likely to get through anyway, you 23627That is about it. As some spam is likely to get through anyway, you
23624might want to have a nifty function to call when you happen to read 23628might 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
23907retrieve the message bodies as well. We don't set this by default 23911retrieve the message bodies as well. We don't set this by default
23908because it will slow @acronym{IMAP} down, and that is not an 23912because it will slow @acronym{IMAP} down, and that is not an
23909appropriate decision to make on behalf of the user. @xref{Client-Side 23913appropriate decision to make on behalf of the user. @xref{Client-Side
23910@acronym{IMAP} Splitting}. 23914IMAP Splitting}.
23911 23915
23912You have to specify one or more spam back ends for @code{spam-split} 23916You have to specify one or more spam back ends for @code{spam-split}
23913to use, by setting the @code{spam-use-*} variables. @xref{Spam Back 23917to 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.
50The primary change this brings is support for DIGEST-MD5 and NTLM, when 50The primary change this brings is support for DIGEST-MD5 and NTLM, when
51the server supports it. 51the server supports it.
52 52
53** Gnus includes a password cache mechanism in password.el. 53** Gnus includes a password cache mechanism in password-cache.el.
54 54
55It is enabled by default (see `password-cache'), with a short timeout of 55It is enabled by default (see `password-cache'), with a short timeout of
5616 seconds (see `password-cache-expiry'). If PGG is used as the PGP 5616 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:
459 (let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) 459 (let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
460 (when def 460 (when def
461 (setq def (gnus-group-decoded-name def))) 461 (setq def (gnus-group-decoded-name def)))
462 (gnus-group-completing-read (if def 462 (gnus-group-completing-read nil nil t nil nil def)))
463 (concat "Group Name (" def "): ")
464 "Group Name: ")
465 nil nil t nil nil def)))
466 463
467;;; Fetching setup functions. 464;;; Fetching setup functions.
468 465
@@ -816,9 +813,9 @@ be a select method."
816 (interactive 813 (interactive
817 (list 814 (list
818 (intern 815 (intern
819 (completing-read 816 (gnus-completing-read
820 "Add to category: " 817 "Add to category"
821 (mapcar (lambda (cat) (list (symbol-name (car cat)))) 818 (mapcar (lambda (cat) (symbol-name (car cat)))
822 gnus-category-alist) 819 gnus-category-alist)
823 nil t)) 820 nil t))
824 current-prefix-arg)) 821 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."
5131 (unless mime-type 5131 (unless mime-type
5132 (setq mime-type 5132 (setq mime-type
5133 (let ((default (gnus-mime-view-part-as-type-internal))) 5133 (let ((default (gnus-mime-view-part-as-type-internal)))
5134 (completing-read 5134 (gnus-completing-read
5135 (format "View as MIME type (default %s): " 5135 "View as MIME type"
5136 (car default)) 5136 (remove-if-not pred (mailcap-mime-types))
5137 (mapcar #'list (mailcap-mime-types)) 5137 nil nil nil
5138 pred nil nil nil
5139 (car default))))) 5138 (car default)))))
5140 (gnus-article-check-buffer) 5139 (gnus-article-check-buffer)
5141 (let ((handle (get-text-property (point) 'gnus-data))) 5140 (let ((handle (get-text-property (point) 'gnus-data)))
@@ -5404,7 +5403,7 @@ If no internal viewer is available, use an external viewer."
5404(defun gnus-mime-action-on-part (&optional action) 5403(defun gnus-mime-action-on-part (&optional action)
5405 "Do something with the MIME attachment at \(point\)." 5404 "Do something with the MIME attachment at \(point\)."
5406 (interactive 5405 (interactive
5407 (list (completing-read "Action: " gnus-mime-action-alist nil t))) 5406 (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
5408 (gnus-article-check-buffer) 5407 (gnus-article-check-buffer)
5409 (let ((action-pair (assoc action gnus-mime-action-alist))) 5408 (let ((action-pair (assoc action gnus-mime-action-alist)))
5410 (if action-pair 5409 (if action-pair
@@ -8370,9 +8369,9 @@ For example:
8370 (interactive 8369 (interactive
8371 (list 8370 (list
8372 (or gnus-article-encrypt-protocol 8371 (or gnus-article-encrypt-protocol
8373 (completing-read "Encrypt protocol: " 8372 (gnus-completing-read "Encrypt protocol"
8374 gnus-article-encrypt-protocol-alist 8373 (mapcar 'car gnus-article-encrypt-protocol-alist)
8375 nil t)) 8374 t))
8376 current-prefix-arg)) 8375 current-prefix-arg))
8377 ;; User might hit `K E' instead of `K e', so prompt once. 8376 ;; User might hit `K E' instead of `K e', so prompt once.
8378 (when (and gnus-article-encrypt-protocol 8377 (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.")
289 (interactive) 289 (interactive)
290 (gnus-bookmark-maybe-load-default-file) 290 (gnus-bookmark-maybe-load-default-file)
291 (let* ((bookmark (or bmk-name 291 (let* ((bookmark (or bmk-name
292 (completing-read "Jump to bookmarked article: " 292 (gnus-completing-read "Jump to bookmarked article"
293 gnus-bookmark-alist))) 293 (mapcar 'car gnus-bookmark-alist))))
294 (bmk-record (cadr (assoc bookmark gnus-bookmark-alist))) 294 (bmk-record (cadr (assoc bookmark gnus-bookmark-alist)))
295 (group (cdr (assoc 'group bmk-record))) 295 (group (cdr (assoc 'group bmk-record)))
296 (message-id (cdr (assoc 'message-id bmk-record)))) 296 (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."
368 header ": "))) 368 header ": ")))
369 (setq value 369 (setq value
370 (if (listp (nth 1 head)) 370 (if (listp (nth 1 head))
371 (completing-read prompt (cons '("*" nil) (nth 1 head)) 371 (gnus-completing-read prompt (cons '("*" nil) (nth 1 head))
372 nil t value 372 t value
373 gnus-diary-header-value-history) 373 'gnus-diary-header-value-history)
374 (read-string prompt value 374 (read-string prompt value
375 gnus-diary-header-value-history)))) 375 'gnus-diary-header-value-history))))
376 (setq ask nil) 376 (setq ask nil)
377 (setq invalid nil) 377 (setq invalid nil)
378 (condition-case () 378 (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."
152 (setq destination 152 (setq destination
153 (if (= (length bufs) 1) 153 (if (= (length bufs) 1)
154 (get-buffer (car bufs)) 154 (get-buffer (car bufs))
155 (completing-read "Attach to which mail composition buffer: " 155 (gnus-completing-read "Attach to which mail composition buffer"
156 (mapcar 156 bufs t)))
157 (lambda (b)
158 (cons b (get-buffer b)))
159 bufs)
160 nil t)))
161 ;; setup a new mail composition buffer 157 ;; setup a new mail composition buffer
162 (let ((mail-user-agent gnus-dired-mail-mode) 158 (let ((mail-user-agent gnus-dired-mail-mode)
163 ;; A workaround to prevent Gnus from displaying the Gnus 159 ;; 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 @@
33(defcustom gnus-gravatar-size 32 33(defcustom gnus-gravatar-size 32
34 "How big should gravatars be displayed." 34 "How big should gravatars be displayed."
35 :type 'integer 35 :type 'integer
36 :version "24.1"
36 :group 'gnus-gravatar) 37 :group 'gnus-gravatar)
37 38
38(defcustom gnus-gravatar-relief 1 39(defcustom gnus-gravatar-properties '(:ascent center :relief 1)
39 "If non-nil, adds a shadow rectangle around the image. The 40 "List of image properties applied to Gravatar images."
40value, relief, specifies the width of the shadow lines, in 41 :type 'list
41pixels. If relief is negative, shadows are drawn so that the 42 :version "24.1"
42image appears as a pressed button; otherwise, it appears as an
43unpressed button."
44 :group 'gnus-gravatar) 43 :group 'gnus-gravatar)
45 44
46(defun gnus-gravatar-transform-address (header category) 45(defun gnus-gravatar-transform-address (header category)
@@ -88,7 +87,7 @@ Set image category to CATEGORY."
88 (point (point)) 87 (point (point))
89 (gravatar (append 88 (gravatar (append
90 gravatar 89 gravatar
91 `(:ascent center :relief ,gnus-gravatar-relief)))) 90 gnus-gravatar-properties)))
92 (gnus-put-image gravatar nil category) 91 (gnus-put-image gravatar nil category)
93 (put-text-property point (point) 'gnus-gravatar address) 92 (put-text-property point (point) 'gnus-gravatar address)
94 (gnus-add-wash-type category) 93 (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."
2164 group))) 2164 group)))
2165 (goto-char start))))) 2165 (goto-char start)))))
2166 2166
2167(defun gnus-group-completing-read (prompt &optional collection predicate 2167(defun gnus-group-completing-read (&optional prompt collection
2168 require-match initial-input hist def 2168 require-match initial-input hist def)
2169 &rest args)
2170 "Read a group name with completion. Non-ASCII group names are allowed. 2169 "Read a group name with completion. Non-ASCII group names are allowed.
2171The arguments are the same as `completing-read' except that COLLECTION 2170The arguments are the same as `completing-read' except that COLLECTION
2172and HIST default to `gnus-active-hashtb' and `gnus-group-history' 2171and HIST default to `gnus-active-hashtb' and `gnus-group-history'
2173respectively if they are omitted." 2172respectively if they are omitted."
2174 (let ((completion-styles (and (boundp 'completion-styles) 2173 (let* ((choices (mapcar (lambda (symbol)
2175 completion-styles)) 2174 (let ((group (symbol-name symbol)))
2176 group) 2175 (if (string-match "[^\000-\177]" group)
2177 (push 'substring completion-styles) 2176 (gnus-group-decoded-name group)
2178 (mapatoms (lambda (symbol) 2177 group)))
2179 (setq group (symbol-name symbol)) 2178 (remove-if-not
2180 (set (intern (if (string-match "[^\000-\177]" group) 2179 'symbolp
2181 (gnus-group-decoded-name group) 2180 (or collection (or gnus-active-hashtb [0])))))
2182 group) 2181 (group
2183 collection) 2182 (gnus-completing-read (or prompt "Group") choices
2184 group)) 2183 require-match initial-input
2185 (prog1 2184 (or hist 'gnus-group-history)
2186 (or collection 2185 def)))
2187 (setq collection (or gnus-active-hashtb [0]))) 2186 (or (symbol-value (intern-soft group collection))
2188 (setq collection (gnus-make-hashtable (length collection))))) 2187 (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
2189 (setq group (apply 'completing-read prompt collection predicate
2190 require-match initial-input
2191 (or hist 'gnus-group-history)
2192 def args))
2193 (or (prog1
2194 (symbol-value (intern-soft group collection))
2195 (setq collection nil))
2196 (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
2197 2188
2198;;;###autoload 2189;;;###autoload
2199(defun gnus-fetch-group (group &optional articles) 2190(defun gnus-fetch-group (group &optional articles)
2200 "Start Gnus if necessary and enter GROUP. 2191 "Start Gnus if necessary and enter GROUP.
2201If ARTICLES, display those articles. 2192If ARTICLES, display those articles.
2202Returns whether the fetching was successful or not." 2193Returns whether the fetching was successful or not."
2203 (interactive (list (gnus-group-completing-read "Group name: " 2194 (interactive (list (gnus-group-completing-read nil
2204 nil nil nil 2195 nil nil
2205 (gnus-group-name-at-point)))) 2196 (gnus-group-name-at-point))))
2206 (unless (gnus-alive-p) 2197 (unless (gnus-alive-p)
2207 (gnus-no-server)) 2198 (gnus-no-server))
@@ -2261,7 +2252,7 @@ Return the name of the group if selection was successful."
2261 (interactive 2252 (interactive
2262 (list 2253 (list
2263 ;; (gnus-read-group "Group name: ") 2254 ;; (gnus-read-group "Group name: ")
2264 (gnus-group-completing-read "Group: ") 2255 (gnus-group-completing-read)
2265 (gnus-read-method "From method: "))) 2256 (gnus-read-method "From method: ")))
2266 ;; Transform the select method into a unique server. 2257 ;; Transform the select method into a unique server.
2267 (when (stringp method) 2258 (when (stringp method)
@@ -2328,7 +2319,7 @@ specified by `gnus-gmane-group-download-format'."
2328 ;; See <http://gmane.org/export.php> for more information. 2319 ;; See <http://gmane.org/export.php> for more information.
2329 (interactive 2320 (interactive
2330 (list 2321 (list
2331 (gnus-group-completing-read "Gmane group: ") 2322 (gnus-group-completing-read "Gmane group")
2332 (read-number "Start article number: ") 2323 (read-number "Start article number: ")
2333 (read-number "How many articles: "))) 2324 (read-number "How many articles: ")))
2334 (unless range (setq range 500)) 2325 (unless range (setq range 500))
@@ -2362,7 +2353,7 @@ Valid input formats include:
2362 ;; prompt the user to decide: "View via `browse-url' or in Gnus? " 2353 ;; prompt the user to decide: "View via `browse-url' or in Gnus? "
2363 ;; (`gnus-read-ephemeral-gmane-group-url') 2354 ;; (`gnus-read-ephemeral-gmane-group-url')
2364 (interactive 2355 (interactive
2365 (list (gnus-group-completing-read "Gmane URL: "))) 2356 (list (gnus-group-completing-read "Gmane URL")))
2366 (let (group start range) 2357 (let (group start range)
2367 (cond 2358 (cond
2368 ;; URLs providing `group', `start' and `range': 2359 ;; URLs providing `group', `start' and `range':
@@ -2456,13 +2447,13 @@ If PROMPT (the prefix) is a number, use the prompt specified in
2456`gnus-group-jump-to-group-prompt'." 2447`gnus-group-jump-to-group-prompt'."
2457 (interactive 2448 (interactive
2458 (list (gnus-group-completing-read 2449 (list (gnus-group-completing-read
2459 "Group: " nil nil (gnus-read-active-file-p) 2450 nil nil (gnus-read-active-file-p)
2460 (if current-prefix-arg 2451 (if current-prefix-arg
2461 (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) 2452 (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
2462 (or (and (stringp gnus-group-jump-to-group-prompt) 2453 (or (and (stringp gnus-group-jump-to-group-prompt)
2463 gnus-group-jump-to-group-prompt) 2454 gnus-group-jump-to-group-prompt)
2464 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) 2455 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
2465 (and (stringp p) p))))))) 2456 (and (stringp p) p)))))))
2466 2457
2467 (when (equal group "") 2458 (when (equal group "")
2468 (error "Empty group name")) 2459 (error "Empty group name"))
@@ -2653,7 +2644,7 @@ If EXCLUDE-GROUP, do not go to that group."
2653(defun gnus-group-make-group-simple (&optional group) 2644(defun gnus-group-make-group-simple (&optional group)
2654 "Add a new newsgroup. 2645 "Add a new newsgroup.
2655The user will be prompted for GROUP." 2646The user will be prompted for GROUP."
2656 (interactive (list (gnus-group-completing-read "Group: "))) 2647 (interactive (list (gnus-group-completing-read)))
2657 (gnus-group-make-group (gnus-group-real-name group) 2648 (gnus-group-make-group (gnus-group-real-name group)
2658 (gnus-group-server group) 2649 (gnus-group-server group)
2659 nil nil t)) 2650 nil nil t))
@@ -2912,8 +2903,9 @@ and NEW-NAME will be prompted for."
2912(defun gnus-group-make-useful-group (group method) 2903(defun gnus-group-make-useful-group (group method)
2913 "Create one of the groups described in `gnus-useful-groups'." 2904 "Create one of the groups described in `gnus-useful-groups'."
2914 (interactive 2905 (interactive
2915 (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups 2906 (let ((entry (assoc (gnus-completing-read "Create group"
2916 nil t) 2907 (mapcar 'car gnus-useful-groups)
2908 t)
2917 gnus-useful-groups))) 2909 gnus-useful-groups)))
2918 (list (cadr entry) 2910 (list (cadr entry)
2919 ;; Don't use `caddr' here since macros within the `interactive' 2911 ;; Don't use `caddr' here since macros within the `interactive'
@@ -3005,11 +2997,11 @@ If SOLID (the prefix), create a solid group."
3005 (symbol-name (caar nnweb-type-definition)))) 2997 (symbol-name (caar nnweb-type-definition))))
3006 (type 2998 (type
3007 (gnus-string-or 2999 (gnus-string-or
3008 (completing-read 3000 (gnus-completing-read
3009 (format "Search engine type (default %s): " default-type) 3001 "Search engine type"
3010 (mapcar (lambda (elem) (list (symbol-name (car elem)))) 3002 (mapcar (lambda (elem) (symbol-name (car elem)))
3011 nnweb-type-definition) 3003 nnweb-type-definition)
3012 nil t nil 'gnus-group-web-type-history) 3004 t nil 'gnus-group-web-type-history)
3013 default-type)) 3005 default-type))
3014 (search 3006 (search
3015 (read-string 3007 (read-string
@@ -3100,8 +3092,8 @@ mail messages or news articles in files that have numeric names."
3100 "Add the current group to a virtual group." 3092 "Add the current group to a virtual group."
3101 (interactive 3093 (interactive
3102 (list current-prefix-arg 3094 (list current-prefix-arg
3103 (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t 3095 (gnus-group-completing-read "Add to virtual group"
3104 "nnvirtual:"))) 3096 nil t "nnvirtual:")))
3105 (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) 3097 (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
3106 (error "%s is not an nnvirtual group" vgroup)) 3098 (error "%s is not an nnvirtual group" vgroup))
3107 (gnus-close-group vgroup) 3099 (gnus-close-group vgroup)
@@ -3672,7 +3664,7 @@ If given numerical prefix, toggle the N next groups."
3672Killed newsgroups are subscribed. If SILENT, don't try to update the 3664Killed newsgroups are subscribed. If SILENT, don't try to update the
3673group line." 3665group line."
3674 (interactive (list (gnus-group-completing-read 3666 (interactive (list (gnus-group-completing-read
3675 "Group: " nil nil (gnus-read-active-file-p)))) 3667 nil (gnus-read-active-file-p))))
3676 (let ((newsrc (gnus-group-entry group))) 3668 (let ((newsrc (gnus-group-entry group)))
3677 (cond 3669 (cond
3678 ((string-match "^[ \t]*$" group) 3670 ((string-match "^[ \t]*$" group)
@@ -4013,7 +4005,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
4013If given a prefix argument, prompt for a group." 4005If given a prefix argument, prompt for a group."
4014 (interactive 4006 (interactive
4015 (list (or (when current-prefix-arg 4007 (list (or (when current-prefix-arg
4016 (gnus-group-completing-read "Group: ")) 4008 (gnus-group-completing-read))
4017 (gnus-group-group-name) 4009 (gnus-group-group-name)
4018 gnus-newsgroup-name))) 4010 gnus-newsgroup-name)))
4019 (unless group 4011 (unless group
@@ -4314,18 +4306,18 @@ If called interactively, this function will ask for a select method
4314If not, METHOD should be a list where the first element is the method 4306If not, METHOD should be a list where the first element is the method
4315and the second element is the address." 4307and the second element is the address."
4316 (interactive 4308 (interactive
4317 (list (let ((how (completing-read 4309 (list (let ((how (gnus-completing-read
4318 "Which back end: " 4310 "Which back end"
4319 (append gnus-valid-select-methods gnus-server-alist) 4311 (mapcar 'car (append gnus-valid-select-methods gnus-server-alist))
4320 nil t (cons "nntp" 0) 'gnus-method-history))) 4312 t (cons "nntp" 0) 'gnus-method-history)))
4321 ;; We either got a back end name or a virtual server name. 4313 ;; We either got a back end name or a virtual server name.
4322 ;; If the first, we also need an address. 4314 ;; If the first, we also need an address.
4323 (if (assoc how gnus-valid-select-methods) 4315 (if (assoc how gnus-valid-select-methods)
4324 (list (intern how) 4316 (list (intern how)
4325 ;; Suggested by mapjph@bath.ac.uk. 4317 ;; Suggested by mapjph@bath.ac.uk.
4326 (completing-read 4318 (gnus-completing-read
4327 "Address: " 4319 "Address"
4328 (mapcar 'list gnus-secondary-servers))) 4320 gnus-secondary-servers))
4329 ;; We got a server name. 4321 ;; We got a server name.
4330 how)))) 4322 how))))
4331 (gnus-browse-foreign-server method)) 4323 (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."
94 (when confirm 94 (when confirm
95 ;; Read server name with completion. 95 ;; Read server name with completion.
96 (setq gnus-nntp-server 96 (setq gnus-nntp-server
97 (completing-read "NNTP server: " 97 (gnus-completing-read "NNTP server"
98 (mapcar 'list 98 (cons gnus-nntp-server
99 (cons (list gnus-nntp-server) 99 gnus-secondary-servers)
100 gnus-secondary-servers)) 100 nil gnus-nntp-server)))
101 nil nil gnus-nntp-server)))
102 101
103 (when (and gnus-nntp-server 102 (when (and gnus-nntp-server
104 (stringp gnus-nntp-server) 103 (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."
578 (if arg 578 (if arg
579 (if (= 1 (prefix-numeric-value arg)) 579 (if (= 1 (prefix-numeric-value arg))
580 (gnus-group-completing-read 580 (gnus-group-completing-read
581 "Use posting style of group: " 581 "Use posting style of group"
582 nil nil (gnus-read-active-file-p)) 582 nil (gnus-read-active-file-p))
583 (gnus-group-group-name)) 583 (gnus-group-group-name))
584 "")) 584 ""))
585 ;; #### see comment in gnus-setup-message -- drv 585 ;; #### see comment in gnus-setup-message -- drv
@@ -607,8 +607,8 @@ network. The corresponding back end must have a 'request-post method."
607 (setq gnus-newsgroup-name 607 (setq gnus-newsgroup-name
608 (if arg 608 (if arg
609 (if (= 1 (prefix-numeric-value arg)) 609 (if (= 1 (prefix-numeric-value arg))
610 (gnus-group-completing-read "Use group: " 610 (gnus-group-completing-read "Use group"
611 nil nil 611 nil
612 (gnus-read-active-file-p)) 612 (gnus-read-active-file-p))
613 (gnus-group-group-name)) 613 (gnus-group-group-name))
614 "")) 614 ""))
@@ -628,7 +628,7 @@ a news."
628 (let ((gnus-newsgroup-name 628 (let ((gnus-newsgroup-name
629 (if arg 629 (if arg
630 (if (= 1 (prefix-numeric-value arg)) 630 (if (= 1 (prefix-numeric-value arg))
631 (gnus-group-completing-read "Newsgroup: " nil nil 631 (gnus-group-completing-read "Newsgroup" nil
632 (gnus-read-active-file-p)) 632 (gnus-read-active-file-p))
633 (gnus-group-group-name)) 633 (gnus-group-group-name))
634 "")) 634 ""))
@@ -654,8 +654,8 @@ posting style."
654 (setq gnus-newsgroup-name 654 (setq gnus-newsgroup-name
655 (if arg 655 (if arg
656 (if (= 1 (prefix-numeric-value arg)) 656 (if (= 1 (prefix-numeric-value arg))
657 (gnus-group-completing-read "Use group: " 657 (gnus-group-completing-read "Use group"
658 nil nil 658 nil
659 (gnus-read-active-file-p)) 659 (gnus-read-active-file-p))
660 "") 660 "")
661 gnus-newsgroup-name)) 661 gnus-newsgroup-name))
@@ -684,8 +684,8 @@ network. The corresponding back end must have a 'request-post method."
684 (setq gnus-newsgroup-name 684 (setq gnus-newsgroup-name
685 (if arg 685 (if arg
686 (if (= 1 (prefix-numeric-value arg)) 686 (if (= 1 (prefix-numeric-value arg))
687 (gnus-group-completing-read "Use group: " 687 (gnus-group-completing-read "Use group"
688 nil nil 688 nil
689 (gnus-read-active-file-p)) 689 (gnus-read-active-file-p))
690 "") 690 "")
691 gnus-newsgroup-name)) 691 gnus-newsgroup-name))
@@ -710,7 +710,7 @@ a news."
710 (let ((gnus-newsgroup-name 710 (let ((gnus-newsgroup-name
711 (if arg 711 (if arg
712 (if (= 1 (prefix-numeric-value arg)) 712 (if (= 1 (prefix-numeric-value arg))
713 (gnus-group-completing-read "Newsgroup: " nil nil 713 (gnus-group-completing-read "Newsgroup" nil
714 (gnus-read-active-file-p)) 714 (gnus-read-active-file-p))
715 "") 715 "")
716 gnus-newsgroup-name)) 716 gnus-newsgroup-name))
@@ -1028,8 +1028,8 @@ If SILENT, don't prompt the user."
1028 gnus-last-posting-server) 1028 gnus-last-posting-server)
1029 ;; Just use the last value. 1029 ;; Just use the last value.
1030 gnus-last-posting-server 1030 gnus-last-posting-server
1031 (completing-read 1031 (gnus-completing-read
1032 "Posting method: " method-alist nil t 1032 "Posting method" (mapcar 'car method-alist) t
1033 (cons (or gnus-last-posting-server "") 0)))) 1033 (cons (or gnus-last-posting-server "") 0))))
1034 method-alist)))) 1034 method-alist))))
1035 ;; Override normal method. 1035 ;; Override normal method.
@@ -1487,7 +1487,7 @@ If YANK is non-nil, include the original article."
1487(defun gnus-summary-yank-message (buffer n) 1487(defun gnus-summary-yank-message (buffer n)
1488 "Yank the current article into a composed message." 1488 "Yank the current article into a composed message."
1489 (interactive 1489 (interactive
1490 (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t) 1490 (list (gnus-completing-read "Buffer" (message-buffers) t)
1491 current-prefix-arg)) 1491 current-prefix-arg))
1492 (gnus-summary-iterate n 1492 (gnus-summary-iterate n
1493 (let ((gnus-inhibit-treatment t)) 1493 (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."
857 857
858(defun gnus-registry-read-mark () 858(defun gnus-registry-read-mark ()
859 "Read a mark name from the user with completion." 859 "Read a mark name from the user with completion."
860 (let ((mark (gnus-completing-read-with-default 860 (let ((mark (gnus-completing-read
861 (symbol-name gnus-registry-default-mark) 861 "Label"
862 "Label" 862 (mapcar 'symbol-name (mapcar 'car gnus-registry-marks))
863 (mapcar (lambda (x) ; completion list 863 nil nil nil
864 (cons (symbol-name (car-safe x)) (car-safe x))) 864 (symbol-name gnus-registry-default-mark))))
865 gnus-registry-marks))))
866 (when (stringp mark) 865 (when (stringp mark)
867 (intern mark)))) 866 (intern mark))))
868 867
@@ -1173,10 +1172,6 @@ Returns the first place where the trail finds a group name."
1173;;; we could call it here: (customize-variable 'gnus-registry-install) 1172;;; we could call it here: (customize-variable 'gnus-registry-install)
1174 gnus-registry-install) 1173 gnus-registry-install)
1175 1174
1176(when (or (eq gnus-registry-install t)
1177 (gnus-registry-install-p))
1178 (gnus-registry-initialize))
1179
1180;; TODO: a few things 1175;; TODO: a few things
1181 1176
1182(provide 'gnus-registry) 1177(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."
680 (and gnus-extra-headers 680 (and gnus-extra-headers
681 (equal (nth 1 entry) "extra") 681 (equal (nth 1 entry) "extra")
682 (intern ; need symbol 682 (intern ; need symbol
683 (gnus-completing-read-with-default 683 (let ((collection (mapcar 'symbol-name gnus-extra-headers)))
684 (symbol-name (car gnus-extra-headers)) ; default response 684 (gnus-completing-read
685 "Score extra header" ; prompt 685 "Score extra header" ; prompt
686 (mapcar (lambda (x) ; completion list 686 collection ; completion list
687 (cons (symbol-name x) x)) 687 t ; require match
688 gnus-extra-headers) 688 nil ; no history
689 nil ; no completion limit 689 nil ; no initial-input
690 t)))) ; require match 690 (car collection)))))) ; default value
691 ;; extra is now nil or a symbol. 691 ;; extra is now nil or a symbol.
692 692
693 ;; We have all the data, so we enter this score. 693 ;; We have all the data, so we enter this score.
@@ -913,10 +913,13 @@ MATCH is the string we are looking for.
913TYPE is the score type. 913TYPE is the score type.
914SCORE is the score to add. 914SCORE is the score to add.
915EXTRA is the possible non-standard header." 915EXTRA is the possible non-standard header."
916 (interactive (list (completing-read "Header: " 916 (interactive (list (gnus-completing-read "Header"
917 gnus-header-index 917 (mapcar
918 (lambda (x) (fboundp (nth 2 x))) 918 'car
919 t) 919 (remove-if-not
920 (lambda (x) (fboundp (nth 2 x)))
921 gnus-header-index))
922 t)
920 (read-string "Match: ") 923 (read-string "Match: ")
921 (if (y-or-n-p "Use regexp match? ") 'r 's) 924 (if (y-or-n-p "Use regexp match? ") 'r 's)
922 (string-to-number (read-string "Score: ")))) 925 (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:
571 571
572(defun gnus-server-add-server (how where) 572(defun gnus-server-add-server (how where)
573 (interactive 573 (interactive
574 (list (intern (completing-read "Server method: " 574 (list (intern (gnus-completing-read "Server method"
575 gnus-valid-select-methods nil t)) 575 (mapcar 'car gnus-valid-select-methods)
576 t))
576 (read-string "Server name: "))) 577 (read-string "Server name: ")))
577 (when (assq where gnus-server-alist) 578 (when (assq where gnus-server-alist)
578 (error "Server with that name already defined")) 579 (error "Server with that name already defined"))
@@ -582,7 +583,7 @@ The following commands are available:
582(defun gnus-server-goto-server (server) 583(defun gnus-server-goto-server (server)
583 "Jump to a server line." 584 "Jump to a server line."
584 (interactive 585 (interactive
585 (list (completing-read "Goto server: " gnus-server-alist nil t))) 586 (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist) t)))
586 (let ((to (text-property-any (point-min) (point-max) 587 (let ((to (text-property-any (point-min) (point-max)
587 'gnus-server (intern server)))) 588 'gnus-server (intern server))))
588 (when to 589 (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
7999is a number, it is the line the article is to be displayed on." 7999is a number, it is the line the article is to be displayed on."
8000 (interactive 8000 (interactive
8001 (list 8001 (list
8002 (completing-read 8002 (gnus-completing-read
8003 "Article number or Message-ID: " 8003 "Article number or Message-ID"
8004 (mapcar (lambda (number) (list (int-to-string number))) 8004 (mapcar 'int-to-string gnus-newsgroup-limit))
8005 gnus-newsgroup-limit))
8006 current-prefix-arg 8005 current-prefix-arg
8007 t)) 8006 t))
8008 (prog1 8007 (prog1
@@ -8256,16 +8255,13 @@ articles that are younger than AGE days."
8256 (interactive 8255 (interactive
8257 (let ((header 8256 (let ((header
8258 (intern 8257 (intern
8259 (gnus-completing-read-with-default 8258 (gnus-completing-read
8260 (symbol-name (car gnus-extra-headers))
8261 (if current-prefix-arg 8259 (if current-prefix-arg
8262 "Exclude extra header" 8260 "Exclude extra header"
8263 "Limit extra header") 8261 "Limit extra header")
8264 (mapcar (lambda (x) 8262 (mapcar 'symbol-name gnus-extra-headers)
8265 (cons (symbol-name x) x)) 8263 t nil nil
8266 gnus-extra-headers) 8264 (symbol-name (car gnus-extra-headers))))))
8267 nil
8268 t))))
8269 (list header 8265 (list header
8270 (read-string (format "%s header %s (regexp): " 8266 (read-string (format "%s header %s (regexp): "
8271 (if current-prefix-arg "Exclude" "Limit to") 8267 (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
9234article. If BACKWARD (the prefix) is non-nil, search backward instead." 9230article. If BACKWARD (the prefix) is non-nil, search backward instead."
9235 (interactive 9231 (interactive
9236 (list (let ((completion-ignore-case t)) 9232 (list (let ((completion-ignore-case t))
9237 (completing-read 9233 (gnus-completing-read
9238 "Header name: " 9234 "Header name"
9239 (mapcar (lambda (header) (list (format "%s" header))) 9235 (mapcar 'symbol-name
9240 (append 9236 (append
9241 '("Number" "Subject" "From" "Lines" "Date" 9237 '(Number Subject From Lines Date
9242 "Message-ID" "Xref" "References" "Body") 9238 Message-ID Xref References Body)
9243 gnus-extra-headers)) 9239 gnus-extra-headers))
9244 nil 'require-match)) 9240 'require-match))
9245 (read-string "Regexp: ") 9241 (read-string "Regexp: ")
9246 (read-key-sequence "Command: ") 9242 (read-key-sequence "Command: ")
9247 current-prefix-arg)) 9243 current-prefix-arg))
@@ -9937,9 +9933,9 @@ latter case, they will be copied into the relevant groups."
9937 (car (gnus-find-method-for-group 9933 (car (gnus-find-method-for-group
9938 gnus-newsgroup-name))))) 9934 gnus-newsgroup-name)))))
9939 (method 9935 (method
9940 (gnus-completing-read-with-default 9936 (gnus-completing-read
9941 methname "Backend to use when respooling" 9937 "Backend to use when respooling"
9942 methods nil t nil 'gnus-mail-method-history)) 9938 methods t nil 'gnus-mail-method-history methname))
9943 ms) 9939 ms)
9944 (cond 9940 (cond
9945 ((zerop (length (setq ms (gnus-servers-using-backend 9941 ((zerop (length (setq ms (gnus-servers-using-backend
@@ -9949,7 +9945,7 @@ latter case, they will be copied into the relevant groups."
9949 (car ms)) 9945 (car ms))
9950 (t 9946 (t
9951 (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) 9947 (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
9952 (cdr (assoc (completing-read "Server name: " ms-alist nil t) 9948 (cdr (assoc (gnus-completing-read "Server name" ms-alist t)
9953 ms-alist)))))))) 9949 ms-alist))))))))
9954 (unless method 9950 (unless method
9955 (error "No method given for respooling")) 9951 (error "No method given for respooling"))
@@ -11904,7 +11900,8 @@ save those articles instead."
11904 (nreverse split-name))) 11900 (nreverse split-name)))
11905 11901
11906(defun gnus-valid-move-group-p (group) 11902(defun gnus-valid-move-group-p (group)
11907 (and (boundp group) 11903 (and (symbolp group)
11904 (boundp group)
11908 (symbol-name group) 11905 (symbol-name group)
11909 (symbol-value group) 11906 (symbol-value group)
11910 (gnus-get-function (gnus-find-method-for-group 11907 (gnus-get-function (gnus-find-method-for-group
@@ -11921,29 +11918,20 @@ save those articles instead."
11921 (format "these %d articles" (length articles)) 11918 (format "these %d articles" (length articles))
11922 "this article"))) 11919 "this article")))
11923 (to-newsgroup 11920 (to-newsgroup
11924 (let (active group) 11921 (cond
11925 (when (or (null split-name) (= 1 (length split-name))) 11922 ((null split-name)
11926 (setq active (gnus-make-hashtable (length gnus-active-hashtb))) 11923 (gnus-group-completing-read
11927 (mapatoms (lambda (symbol) 11924 prom
11928 (setq group (symbol-name symbol)) 11925 (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
11929 (when (string-match "[^\000-\177]" group) 11926 nil prefix nil default))
11930 (setq group (gnus-group-decoded-name group))) 11927 ((= 1 (length split-name))
11931 (set (intern group active) group)) 11928 (gnus-group-completing-read
11932 gnus-active-hashtb)) 11929 prom (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
11933 (cond 11930 nil prefix 'gnus-group-history (car split-name)))
11934 ((null split-name) 11931 (t
11935 (gnus-completing-read-with-default 11932 (gnus-completing-read
11936 default prom active 'gnus-valid-move-group-p nil prefix 11933 prom (nreverse split-name) nil nil 'gnus-group-history))))
11937 'gnus-group-history)) 11934 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
11938 ((= 1 (length split-name))
11939 (gnus-completing-read-with-default
11940 (car split-name) prom active 'gnus-valid-move-group-p nil nil
11941 'gnus-group-history))
11942 (t
11943 (gnus-completing-read-with-default
11944 nil prom (mapcar 'list (nreverse split-name)) nil nil nil
11945 'gnus-group-history)))))
11946 (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
11947 encoded) 11935 encoded)
11948 (when to-newsgroup 11936 (when to-newsgroup
11949 (if (or (string= to-newsgroup "") 11937 (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'."
161(defun gnus-topic-jump-to-topic (topic) 161(defun gnus-topic-jump-to-topic (topic)
162 "Go to TOPIC." 162 "Go to TOPIC."
163 (interactive 163 (interactive
164 (list (completing-read "Go to topic: " 164 (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
165 (mapcar 'list (gnus-topic-list))
166 nil t)))
167 (let ((buffer-read-only nil)) 165 (let ((buffer-read-only nil))
168 (dolist (topic (gnus-current-topics topic)) 166 (dolist (topic (gnus-current-topics topic))
169 (unless (gnus-topic-goto-topic topic) 167 (unless (gnus-topic-goto-topic topic)
@@ -1303,7 +1301,7 @@ When used interactively, PARENT will be the topic under point."
1303If COPYP, copy the groups instead." 1301If COPYP, copy the groups instead."
1304 (interactive 1302 (interactive
1305 (list current-prefix-arg 1303 (list current-prefix-arg
1306 (gnus-completing-read "Move to topic" gnus-topic-alist nil t 1304 (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t
1307 'gnus-topic-history))) 1305 'gnus-topic-history)))
1308 (let ((use-marked (and (not n) (not (gnus-region-active-p)) 1306 (let ((use-marked (and (not n) (not (gnus-region-active-p))
1309 gnus-group-marked t)) 1307 gnus-group-marked t))
@@ -1350,7 +1348,7 @@ If COPYP, copy the groups instead."
1350 "Copy the current group to a topic." 1348 "Copy the current group to a topic."
1351 (interactive 1349 (interactive
1352 (list current-prefix-arg 1350 (list current-prefix-arg
1353 (completing-read "Copy to topic: " gnus-topic-alist nil t))) 1351 (gnus-completing-read "Copy to topic" (mapcar 'car gnus-topic-alist) t)))
1354 (gnus-topic-move-group n topic t)) 1352 (gnus-topic-move-group n topic t))
1355 1353
1356(defun gnus-topic-kill-group (&optional n discard) 1354(defun gnus-topic-kill-group (&optional n discard)
@@ -1443,7 +1441,8 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
1443 (gnus-topic-remove-topic t nil) 1441 (gnus-topic-remove-topic t nil)
1444 (let ((topic 1442 (let ((topic
1445 (gnus-topic-find-topology 1443 (gnus-topic-find-topology
1446 (completing-read "Show topic: " gnus-topic-alist nil t)))) 1444 (gnus-completing-read "Show topic"
1445 (mapcar 'car gnus-topic-alist) t))))
1447 (setcar (cddr (cadr topic)) nil) 1446 (setcar (cddr (cadr topic)) nil)
1448 (setcar (cdr (cadr topic)) 'visible) 1447 (setcar (cdr (cadr topic)) 'visible)
1449 (gnus-group-list-groups))))) 1448 (gnus-group-list-groups)))))
@@ -1491,7 +1490,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
1491 (let (topic) 1490 (let (topic)
1492 (nreverse 1491 (nreverse
1493 (list 1492 (list
1494 (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) 1493 (setq topic (gnus-completing-read "Move to topic"
1494 (mapcar 'car gnus-topic-alist) t))
1495 (read-string (format "Move to %s (regexp): " topic)))))) 1495 (read-string (format "Move to %s (regexp): " topic))))))
1496 (gnus-group-mark-regexp regexp) 1496 (gnus-group-mark-regexp regexp)
1497 (gnus-topic-move-group nil topic copyp)) 1497 (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."
1502 (let (topic) 1502 (let (topic)
1503 (nreverse 1503 (nreverse
1504 (list 1504 (list
1505 (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) 1505 (setq topic (gnus-completing-read "Copy to topic"
1506 (mapcar 'car gnus-topic-alist) t))
1506 (read-string (format "Copy to %s (regexp): " topic)))))) 1507 (read-string (format "Copy to %s (regexp): " topic))))))
1507 (gnus-topic-move-matching regexp topic t)) 1508 (gnus-topic-move-matching regexp topic t))
1508 1509
@@ -1723,8 +1724,9 @@ If REVERSE, sort in reverse order."
1723 "Sort topics in TOPIC alphabetically by topic name. 1724 "Sort topics in TOPIC alphabetically by topic name.
1724If REVERSE, reverse the sorting order." 1725If REVERSE, reverse the sorting order."
1725 (interactive 1726 (interactive
1726 (list (completing-read "Sort topics in : " gnus-topic-alist nil t 1727 (list (gnus-completing-read "Sort topics in"
1727 (gnus-current-topic)) 1728 (mapcar 'car gnus-topic-alist) t
1729 (gnus-current-topic))
1728 current-prefix-arg)) 1730 current-prefix-arg))
1729 (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) 1731 (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
1730 gnus-topic-topology))) 1732 gnus-topic-topology)))
@@ -1738,7 +1740,7 @@ If REVERSE, reverse the sorting order."
1738 (interactive 1740 (interactive
1739 (list 1741 (list
1740 (gnus-group-topic-name) 1742 (gnus-group-topic-name)
1741 (completing-read "Move to topic: " gnus-topic-alist nil t))) 1743 (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t)))
1742 (unless (and current to) 1744 (unless (and current to)
1743 (error "Can't find topic")) 1745 (error "Can't find topic"))
1744 (let ((current-top (cdr (gnus-topic-find-topology current))) 1746 (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 @@
44 (defmacro with-no-warnings (&rest body) 44 (defmacro with-no-warnings (&rest body)
45 `(progn ,@body)))) 45 `(progn ,@body))))
46 46
47(defcustom gnus-completing-read-function
48 #'gnus-std-completing-read
49 "Function to do a completing read."
50 :group 'gnus-meta
51 :type '(radio (function-item
52 :doc "Use Emacs' standard `completing-read' function."
53 gnus-std-completing-read)
54 (function-item :doc "Use iswitchb's completing-read function."
55 gnus-icompleting-read)
56 (function-item :doc "Use ido's completing-read function."
57 gnus-ido-completing-read)
58 (function)))
59
60(defcustom gnus-completion-styles
61 (if (and (boundp 'completion-styles-alist)
62 (boundp 'completion-styles))
63 (append (when (and (assq 'substring completion-styles-alist)
64 (not (memq 'substring completion-styles)))
65 (list 'substring))
66 completion-styles)
67 nil)
68 "Value of `completion-styles' to use when completing."
69 :version "24.1"
70 :group 'gnus-meta
71 :type 'list)
72
47;; Fixme: this should be a gnus variable, not nnmail-. 73;; Fixme: this should be a gnus variable, not nnmail-.
48(defvar nnmail-pathname-coding-system) 74(defvar nnmail-pathname-coding-system)
49(defvar nnmail-active-file-coding-system) 75(defvar nnmail-active-file-coding-system)
@@ -344,16 +370,6 @@ TIME defaults to the current time."
344 (define-key keymap key (pop plist)) 370 (define-key keymap key (pop plist))
345 (pop plist))))) 371 (pop plist)))))
346 372
347(defun gnus-completing-read-with-default (default prompt &rest args)
348 ;; Like `completing-read', except that DEFAULT is the default argument.
349 (let* ((prompt (if default
350 (concat prompt " (default " default "): ")
351 (concat prompt ": ")))
352 (answer (apply 'completing-read prompt args)))
353 (if (or (null answer) (zerop (length answer)))
354 default
355 answer)))
356
357;; Two silly functions to ensure that all `y-or-n-p' questions clear 373;; Two silly functions to ensure that all `y-or-n-p' questions clear
358;; the echo area. 374;; the echo area.
359;; 375;;
@@ -1574,21 +1590,50 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1574 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) 1590 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
1575 (error "Invalid predicate specifier: %s" spec))))) 1591 (error "Invalid predicate specifier: %s" spec)))))
1576 1592
1577(defun gnus-completing-read (prompt table &optional predicate require-match 1593(defun gnus-std-completing-read (prompt collection &optional require-match
1578 history) 1594 initial-input history def)
1579 (when (and history 1595 (completing-read prompt collection nil require-match
1580 (not (boundp history))) 1596 initial-input history def))
1581 (set history nil)) 1597
1582 (completing-read 1598(defun gnus-icompleting-read (prompt collection &optional require-match
1583 (if (symbol-value history) 1599 initial-input history def)
1584 (concat prompt " (" (car (symbol-value history)) "): ") 1600 (require 'iswitchb)
1585 (concat prompt ": ")) 1601 (let ((iswitchb-make-buflist-hook
1586 table 1602 (lambda ()
1587 predicate 1603 (setq iswitchb-temp-buflist
1588 require-match 1604 (let ((choices (append (list)
1589 nil 1605 (when initial-input (list initial-input))
1590 history 1606 (symbol-value history) collection))
1591 (car (symbol-value history)))) 1607 filtered-choices)
1608 (while choices
1609 (when (and (car choices) (not (member (car choices) filtered-choices)))
1610 (setq filtered-choices (cons (car choices) filtered-choices)))
1611 (setq choices (cdr choices)))
1612 (nreverse filtered-choices))))))
1613 (unwind-protect
1614 (progn
1615 (when (not iswitchb-mode)
1616 (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
1617 (iswitchb-read-buffer prompt def require-match))
1618 (when (not iswitchb-mode)
1619 (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
1620
1621(defun gnus-ido-completing-read (prompt collection &optional require-match
1622 initial-input history def)
1623 (require 'ido)
1624 (ido-completing-read prompt collection nil require-match
1625 initial-input history def))
1626
1627(defun gnus-completing-read (prompt collection &optional require-match
1628 initial-input history def)
1629 "Do a completing read with the configured `gnus-completing-read-function'."
1630 (let ((completion-styles gnus-completion-styles))
1631 (funcall
1632 gnus-completing-read-function
1633 (concat prompt (when def
1634 (concat " (default " def ")"))
1635 ": ")
1636 collection require-match initial-input history def)))
1592 1637
1593(defun gnus-graphic-display-p () 1638(defun gnus-graphic-display-p ()
1594 (if (featurep 'xemacs) 1639 (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."
1427 :group 'gnus-message 1427 :group 'gnus-message
1428 :type '(choice (const :tag "default" nil) 1428 :type '(choice (const :tag "default" nil)
1429 string)) 1429 string))
1430(make-obsolete-variable 'gnus-local-domain nil "24.1")
1430 1431
1431(defvar gnus-local-organization nil 1432(defvar gnus-local-organization nil
1432 "String with a description of what organization (if any) the user belongs to. 1433 "String with a description of what organization (if any) the user belongs to.
@@ -4241,9 +4242,9 @@ Allow completion over sensible values."
4241 gnus-predefined-server-alist 4242 gnus-predefined-server-alist
4242 gnus-server-alist)) 4243 gnus-server-alist))
4243 (method 4244 (method
4244 (completing-read 4245 (gnus-completing-read
4245 prompt servers 4246 prompt (mapcar 'car servers)
4246 nil t nil 'gnus-method-history))) 4247 t nil 'gnus-method-history)))
4247 (cond 4248 (cond
4248 ((equal method "") 4249 ((equal method "")
4249 (setq method gnus-select-method)) 4250 (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."
1323 "Display HANDLE using METHOD." 1323 "Display HANDLE using METHOD."
1324 (let* ((type (mm-handle-media-type handle)) 1324 (let* ((type (mm-handle-media-type handle))
1325 (methods 1325 (methods
1326 (mapcar (lambda (i) (list (cdr (assoc 'viewer i)))) 1326 (mapcar (lambda (i) (cdr (assoc 'viewer i)))
1327 (mailcap-mime-info type 'all))) 1327 (mailcap-mime-info type 'all)))
1328 (method (let ((minibuffer-local-completion-map 1328 (method (let ((minibuffer-local-completion-map
1329 mm-viewer-completion-map)) 1329 mm-viewer-completion-map))
1330 (completing-read "Viewer: " methods)))) 1330 (gnus-completing-read "Viewer" methods))))
1331 (when (string= method "") 1331 (when (string= method "")
1332 (error "No method given")) 1332 (error "No method given"))
1333 (if (string-match "^[^% \t]+$" method) 1333 (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 @@
68 . ,(lambda (prompt) 68 . ,(lambda (prompt)
69 "Return a charset." 69 "Return a charset."
70 (intern 70 (intern
71 (completing-read 71 (gnus-completing-read
72 prompt 72 prompt
73 (mapcar (lambda (e) (list (symbol-name (car e)))) 73 (mapcar (lambda (e) (symbol-name (car e)))
74 mm-mime-mule-charset-alist) 74 mm-mime-mule-charset-alist)
75 nil t)))) 75 t))))
76 ;; `subst-char-in-string' is not available in XEmacs 21.4. 76 ;; `subst-char-in-string' is not available in XEmacs 21.4.
77 (subst-char-in-string 77 (subst-char-in-string
78 . ,(lambda (from to string &optional inplace) 78 . ,(lambda (from to string &optional inplace)
@@ -281,8 +281,8 @@ to the contents of the accessible portion of the buffer."
281 'read-coding-system)) 281 'read-coding-system))
282 (t (lambda (prompt &optional default-coding-system) 282 (t (lambda (prompt &optional default-coding-system)
283 "Prompt the user for a coding system." 283 "Prompt the user for a coding system."
284 (completing-read 284 (gnus-completing-read
285 prompt (mapcar (lambda (s) (list (symbol-name (car s)))) 285 prompt (mapcar (lambda (s) (symbol-name (car s)))
286 mm-mime-mule-charset-alist))))))) 286 mm-mime-mule-charset-alist)))))))
287 287
288(defvar mm-coding-system-list nil) 288(defvar mm-coding-system-list nil)
@@ -316,8 +316,8 @@ the alias. Else windows-NUMBER is used."
316 (cp-supported-codepages) 316 (cp-supported-codepages)
317 ;; Removed in Emacs 23 (unicode), so signal an error: 317 ;; Removed in Emacs 23 (unicode), so signal an error:
318 (error "`codepage-setup' not present in this Emacs version")))) 318 (error "`codepage-setup' not present in this Emacs version"))))
319 (list (completing-read "Setup DOS Codepage: (default 437) " candidates 319 (list (gnus-completing-read "Setup DOS Codepage" candidates
320 nil t nil nil "437")))) 320 t nil nil "437"))))
321 (when alias 321 (when alias
322 (setq alias (if (stringp alias) 322 (setq alias (if (stringp alias)
323 (intern alias) 323 (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 @@
31(require 'mm-decode) 31(require 'mm-decode)
32(require 'smime) 32(require 'smime)
33 33
34(autoload 'gnus-completing-read "gnus-util")
34(autoload 'gnus-article-prepare-display "gnus-art") 35(autoload 'gnus-article-prepare-display "gnus-art")
35(autoload 'vcard-parse-string "vcard") 36(autoload 'vcard-parse-string "vcard")
36(autoload 'vcard-format-string "vcard") 37(autoload 'vcard-format-string "vcard")
@@ -676,11 +677,9 @@
676 (if (= (length smime-keys) 1) 677 (if (= (length smime-keys) 1)
677 (cadar smime-keys) 678 (cadar smime-keys)
678 (smime-get-key-by-email 679 (smime-get-key-by-email
679 (completing-read 680 (gnus-completing-read
680 (concat "Decipher using key" 681 "Decipher using key"
681 (if smime-keys (concat "(default " (caar smime-keys) "): ") 682 smime-keys nil nil nil (car-safe (car-safe smime-keys))))))
682 ": "))
683 smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
684 (goto-char (point-min)) 683 (goto-char (point-min))
685 (while (search-forward "\r\n" nil t) 684 (while (search-forward "\r\n" nil t)
686 (replace-match "\n")) 685 (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
161 ""))))) 161 "")))))
162 (and from (smime-get-key-by-email from))) 162 (and from (smime-get-key-by-email from)))
163 (smime-get-key-by-email 163 (smime-get-key-by-email
164 (completing-read "Sign this part with what signature? " 164 (gnus-completing-read "Sign this part with what signature"
165 smime-keys nil nil 165 smime-keys nil nil
166 (and (listp (car-safe smime-keys)) 166 (and (listp (car-safe smime-keys))
167 (caar smime-keys)))))))) 167 (caar smime-keys))))))))
168 168
169(defun mml-smime-get-file-cert () 169(defun mml-smime-get-file-cert ()
170 (ignore-errors 170 (ignore-errors
@@ -213,15 +213,16 @@ Whether the passphrase is cached at all is controlled by
213 (quit)) 213 (quit))
214 result)) 214 result))
215 215
216(autoload 'gnus-completing-read-with-default "gnus-util") 216(autoload 'gnus-completing-read "gnus-util")
217 217
218(defun mml-smime-openssl-encrypt-query () 218(defun mml-smime-openssl-encrypt-query ()
219 ;; todo: try dns/ldap automatically first, before prompting user 219 ;; todo: try dns/ldap automatically first, before prompting user
220 (let (certs done) 220 (let (certs done)
221 (while (not done) 221 (while (not done)
222 (ecase (read (gnus-completing-read-with-default 222 (ecase (read (gnus-completing-read
223 "ldap" "Fetch certificate from" 223 "Fetch certificate from"
224 '(("dns") ("ldap") ("file")) nil t)) 224 '(("dns") ("ldap") ("file")) t nil nil
225 "ldap"))
225 (dns (setq certs (append certs 226 (dns (setq certs (append certs
226 (mml-smime-get-dns-cert)))) 227 (mml-smime-get-dns-cert))))
227 (ldap (setq certs (append certs 228 (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 @@
40(autoload 'message-make-message-id "message") 40(autoload 'message-make-message-id "message")
41(declare-function gnus-setup-posting-charset "gnus-msg" (group)) 41(declare-function gnus-setup-posting-charset "gnus-msg" (group))
42(autoload 'gnus-make-local-hook "gnus-util") 42(autoload 'gnus-make-local-hook "gnus-util")
43(autoload 'gnus-completing-read "gnus-util")
43(autoload 'message-fetch-field "message") 44(autoload 'message-fetch-field "message")
44(autoload 'message-mark-active-p "message") 45(autoload 'message-mark-active-p "message")
45(autoload 'message-info "message") 46(autoload 'message-info "message")
@@ -1188,9 +1189,10 @@ If not set, `default-directory' will be used."
1188 ;; looks like, and offer text/plain if it looks 1189 ;; looks like, and offer text/plain if it looks
1189 ;; like text/plain. 1190 ;; like text/plain.
1190 "application/octet-stream")) 1191 "application/octet-stream"))
1191 (string (completing-read 1192 (string (gnus-completing-read
1192 (format "Content type (default %s): " default) 1193 "Content type"
1193 (mapcar 'list (mailcap-mime-types))))) 1194 (mailcap-mime-types)
1195 nil nil nil default)))
1194 (if (not (equal string "")) 1196 (if (not (equal string ""))
1195 string 1197 string
1196 default))) 1198 default)))
@@ -1204,10 +1206,10 @@ If not set, `default-directory' will be used."
1204(defun mml-minibuffer-read-disposition (type &optional default filename) 1206(defun mml-minibuffer-read-disposition (type &optional default filename)
1205 (unless default 1207 (unless default
1206 (setq default (mml-content-disposition type filename))) 1208 (setq default (mml-content-disposition type filename)))
1207 (let ((disposition (completing-read 1209 (let ((disposition (gnus-completing-read
1208 (format "Disposition (default %s): " default) 1210 "Disposition"
1209 '(("attachment") ("inline") ("")) 1211 '("attachment" "inline")
1210 nil t nil nil default))) 1212 t nil nil default)))
1211 (if (not (equal disposition "")) 1213 (if (not (equal disposition ""))
1212 disposition 1214 disposition
1213 default))) 1215 default)))
@@ -1395,11 +1397,11 @@ TYPE is the MIME type to use."
1395 1397
1396(defun mml-insert-multipart (&optional type) 1398(defun mml-insert-multipart (&optional type)
1397 (interactive (if (message-in-body-p) 1399 (interactive (if (message-in-body-p)
1398 (list (completing-read "Multipart type (default mixed): " 1400 (list (gnus-completing-read "Multipart type"
1399 '(("mixed") ("alternative") 1401 '("mixed" "alternative"
1400 ("digest") ("parallel") 1402 "digest" "parallel"
1401 ("signed") ("encrypted")) 1403 "signed" "encrypted")
1402 nil nil "mixed")) 1404 nil "mixed"))
1403 (error "Use this command in the message body"))) 1405 (error "Use this command in the message body")))
1404 (or type 1406 (or type
1405 (setq type "mixed")) 1407 (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.")
280 (t 280 (t
281 (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) 281 (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
282 282
283(deffoo nndoc-retrieve-groups (groups &optional server)
284 (dolist (group groups)
285 (nndoc-request-group group server))
286 t)
287
283(deffoo nndoc-request-type (group &optional article) 288(deffoo nndoc-request-type (group &optional article)
284 (cond ((not article) 'unknown) 289 (cond ((not article) 'unknown)
285 (nndoc-post-type nndoc-post-type) 290 (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'.")
224 (let* ((nnmh-allow-delete-final t) 224 (let* ((nnmh-allow-delete-final t)
225 (nnmail-expiry-target 225 (nnmail-expiry-target
226 (or (gnus-group-find-parameter 226 (or (gnus-group-find-parameter
227 (gnus-group-prefixed-name "nndraft" (list 'nndraft server)) 227 (gnus-group-prefixed-name group (list 'nndraft server))
228 'expiry-target t) 228 'expiry-target t)
229 nnmail-expiry-target)) 229 nnmail-expiry-target))
230 (res (nnoo-parent-function 'nndraft 230 (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'.")
70 "How mail is split. 70 "How mail is split.
71Uses the same syntax as nnmail-split-methods") 71Uses the same syntax as nnmail-split-methods")
72 72
73(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
74 "Gnus 5.13")
75
73(defvoo nnimap-authenticator nil 76(defvoo nnimap-authenticator nil
74 "How nnimap authenticate itself to the server. 77 "How nnimap authenticate itself to the server.
75Possible choices are nil (use default methods) or `anonymous'.") 78Possible choices are nil (use default methods) or `anonymous'.")
@@ -342,15 +345,6 @@ textual parts.")
342 (when (eq nnimap-stream 'starttls) 345 (when (eq nnimap-stream 'starttls)
343 (nnimap-command "STARTTLS") 346 (nnimap-command "STARTTLS")
344 (starttls-negotiate (nnimap-process nnimap-object))) 347 (starttls-negotiate (nnimap-process nnimap-object)))
345 ;; If this is a STARTTLS-capable server, then sever the
346 ;; connection and start a STARTTLS connection instead.
347 (when (and (eq nnimap-stream 'network)
348 (member "STARTTLS" (nnimap-capabilities nnimap-object)))
349 (let ((nnimap-stream 'starttls))
350 (delete-process (nnimap-process nnimap-object))
351 (kill-buffer (current-buffer))
352 (return
353 (nnimap-open-connection buffer))))
354 (when nnimap-server-port 348 (when nnimap-server-port
355 (push (format "%s" nnimap-server-port) ports)) 349 (push (format "%s" nnimap-server-port) ports))
356 (unless (equal connection-result "PREAUTH") 350 (unless (equal connection-result "PREAUTH")
@@ -428,7 +422,12 @@ textual parts.")
428 (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) 422 (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
429 (goto-char (point-min)) 423 (goto-char (point-min))
430 (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) 424 (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
431 (setq structure (ignore-errors (read (current-buffer))) 425 (setq structure (ignore-errors
426 (let ((start (point)))
427 (forward-sexp 1)
428 (downcase-region start (point))
429 (goto-char (point))
430 (read (current-buffer))))
432 parts (nnimap-find-wanted-parts structure)))) 431 parts (nnimap-find-wanted-parts structure))))
433 (when (if parts 432 (when (if parts
434 (nnimap-get-partial-article article parts structure) 433 (nnimap-get-partial-article article parts structure)
@@ -509,8 +508,15 @@ textual parts.")
509 t)) 508 t))
510 509
511(defun nnimap-insert-partial-structure (structure parts &optional subp) 510(defun nnimap-insert-partial-structure (structure parts &optional subp)
512 (let ((type (car (last structure 4))) 511 (let (type boundary)
513 (boundary (cadr (member "BOUNDARY" (car (last structure 3)))))) 512 (let ((bstruc structure))
513 (while (consp (car bstruc))
514 (pop bstruc))
515 (setq type (car bstruc))
516 (setq bstruc (car (cdr bstruc)))
517 (when (and (stringp (car bstruc))
518 (string= (downcase (car bstruc)) "boundary"))
519 (setq boundary (cadr bstruc))))
514 (when subp 520 (when subp
515 (insert (format "Content-type: multipart/%s; boundary=%S\n\n" 521 (insert (format "Content-type: multipart/%s; boundary=%S\n\n"
516 (downcase type) boundary))) 522 (downcase type) boundary)))
@@ -768,6 +774,7 @@ textual parts.")
768 (when (nnimap-possibly-change-group group server) 774 (when (nnimap-possibly-change-group group server)
769 (let (sequence) 775 (let (sequence)
770 (with-current-buffer (nnimap-buffer) 776 (with-current-buffer (nnimap-buffer)
777 (erase-buffer)
771 ;; Just send all the STORE commands without waiting for 778 ;; Just send all the STORE commands without waiting for
772 ;; response. If they're successful, they're successful. 779 ;; response. If they're successful, they're successful.
773 (dolist (action actions) 780 (dolist (action actions)
@@ -789,6 +796,7 @@ textual parts.")
789(deffoo nnimap-request-accept-article (group &optional server last) 796(deffoo nnimap-request-accept-article (group &optional server last)
790 (when (nnimap-possibly-change-group nil server) 797 (when (nnimap-possibly-change-group nil server)
791 (nnmail-check-syntax) 798 (nnmail-check-syntax)
799 (nnimap-add-cr)
792 (let ((message (buffer-string)) 800 (let ((message (buffer-string))
793 (message-id (message-field-value "message-id")) 801 (message-id (message-field-value "message-id"))
794 sequence) 802 sequence)
@@ -1288,7 +1296,9 @@ textual parts.")
1288(defun nnimap-split-incoming-mail () 1296(defun nnimap-split-incoming-mail ()
1289 (with-current-buffer (nnimap-buffer) 1297 (with-current-buffer (nnimap-buffer)
1290 (let ((nnimap-incoming-split-list nil) 1298 (let ((nnimap-incoming-split-list nil)
1291 (nnmail-split-methods nnimap-split-methods) 1299 (nnmail-split-methods (if (eq nnimap-split-methods 'default)
1300 nnmail-split-methods
1301 nnimap-split-methods))
1292 (nnmail-inhibit-default-split-group t) 1302 (nnmail-inhibit-default-split-group t)
1293 (groups (nnimap-get-groups)) 1303 (groups (nnimap-get-groups))
1294 new-articles) 1304 new-articles)
@@ -1339,6 +1349,7 @@ textual parts.")
1339(defun nnimap-mark-and-expunge-incoming (range) 1349(defun nnimap-mark-and-expunge-incoming (range)
1340 (when range 1350 (when range
1341 (setq range (nnimap-article-ranges range)) 1351 (setq range (nnimap-article-ranges range))
1352 (erase-buffer)
1342 (let ((sequence 1353 (let ((sequence
1343 (nnimap-send-command 1354 (nnimap-send-command
1344 "UID STORE %s +FLAGS.SILENT (\\Deleted)" range))) 1355 "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."
1588 (let ((sym (car parmspec)) 1588 (let ((sym (car parmspec))
1589 (prompt (cdr parmspec))) 1589 (prompt (cdr parmspec)))
1590 (if (listp prompt) 1590 (if (listp prompt)
1591 (let* ((result (apply 'completing-read prompt)) 1591 (let* ((result (gnus-completing-read prompt nil))
1592 (mapping (or (assoc result nnir-imap-search-arguments) 1592 (mapping (or (assoc result nnir-imap-search-arguments)
1593 (assoc nil nnir-imap-search-arguments)))) 1593 (assoc nil nnir-imap-search-arguments))))
1594 (cons sym (format (cdr mapping) result))) 1594 (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."
848All necessary information will be queried from the user." 848All necessary information will be queried from the user."
849 (interactive) 849 (interactive)
850 (let* ((name (read-string "Name of the mairix server: ")) 850 (let* ((name (read-string "Name of the mairix server: "))
851 (server (completing-read "Back end server (TAB for completion): " 851 (server (gnus-completing-read "Back end server"
852 (nnmairix-get-valid-servers) nil 1)) 852 (nnmairix-get-valid-servers) t))
853 (mairix (read-string "Command to call mairix: " "mairix")) 853 (mairix (read-string "Command to call mairix: " "mairix"))
854 (defaultgroup (read-string "Default search group: ")) 854 (defaultgroup (read-string "Default search group: "))
855 (backend (symbol-name (car (gnus-server-to-method server)))) 855 (backend (symbol-name (car (gnus-server-to-method server))))
@@ -1165,7 +1165,7 @@ nnmairix server. Only marks from current session will be set."
1165If SKIPDEFAULT is t, the default search group will not be 1165If SKIPDEFAULT is t, the default search group will not be
1166updated. 1166updated.
1167If UPDATEDB is t, database for SERVERNAME will be updated first." 1167If UPDATEDB is t, database for SERVERNAME will be updated first."
1168 (interactive (list (completing-read "Update groups on server: " 1168 (interactive (list (gnus-completing-read "Update groups on server"
1169 (nnmairix-get-nnmairix-servers)))) 1169 (nnmairix-get-nnmairix-servers))))
1170 (save-excursion 1170 (save-excursion
1171 (when (string-match ".*:\\(.*\\)" servername) 1171 (when (string-match ".*:\\(.*\\)" servername)
@@ -1302,7 +1302,7 @@ Otherwise, ask user for server."
1302 (while 1302 (while
1303 (equal '("") 1303 (equal '("")
1304 (setq nnmairix-last-server 1304 (setq nnmairix-last-server
1305 (list (completing-read "Server: " openedserver nil 1 1305 (list (gnus-completing-read "Server" openedserver t
1306 (or nnmairix-last-server 1306 (or nnmairix-last-server
1307 "nnmairix:")))))) 1307 "nnmairix:"))))))
1308 nnmairix-last-server) 1308 nnmairix-last-server)
@@ -1492,10 +1492,10 @@ group."
1492 (when (not found) 1492 (when (not found)
1493 (setq mairixserver 1493 (setq mairixserver
1494 (gnus-server-to-method 1494 (gnus-server-to-method
1495 (completing-read 1495 (gnus-completing-read
1496 (format "Cannot determine which nnmairix server indexes %s. Please specify: " 1496 (format "Cannot determine which nnmairix server indexes %s. Please specify"
1497 (gnus-method-to-server server)) 1497 (gnus-method-to-server server))
1498 (nnmairix-get-nnmairix-servers) nil nil "nnmairix:"))) 1498 (nnmairix-get-nnmairix-servers) nil "nnmairix:")))
1499 ;; Save result in parameter of default search group so that 1499 ;; Save result in parameter of default search group so that
1500 ;; we don't have to ask again 1500 ;; we don't have to ask again
1501 (setq defaultgroup (gnus-group-prefixed-name 1501 (setq defaultgroup (gnus-group-prefixed-name
@@ -1643,9 +1643,9 @@ search in raw mode."
1643 (gnus-registry-add-group mid cur))))) 1643 (gnus-registry-add-group mid cur)))))
1644 (if (> (length allgroups) 1) 1644 (if (> (length allgroups) 1)
1645 (setq group 1645 (setq group
1646 (completing-read 1646 (gnus-completing-read
1647 "Message exists in more than one group. Choose: " 1647 "Message exists in more than one group. Choose"
1648 allgroups nil t)) 1648 allgroups t))
1649 (setq group (car allgroups)))) 1649 (setq group (car allgroups))))
1650 (if group 1650 (if group
1651 ;; show article in summary buffer 1651 ;; show article in summary buffer
@@ -1748,9 +1748,9 @@ SERVER."
1748 (gnus-group-prefixed-name group (car cur)) 1748 (gnus-group-prefixed-name group (car cur))
1749 allgroups)))) 1749 allgroups))))
1750 (if (> (length allgroups) 1) 1750 (if (> (length allgroups) 1)
1751 (setq group (completing-read 1751 (setq group (gnus-completing-read
1752 "Group %s exists on more than one IMAP server. Choose: " 1752 "Group %s exists on more than one IMAP server. Choose"
1753 allgroups nil t)) 1753 allgroups t))
1754 (setq group (car allgroups)))) 1754 (setq group (car allgroups))))
1755 group)) 1755 group))
1756 1756
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'."
1048 (cdr (assoc "feedid" listinfo))))) 1048 (cdr (assoc "feedid" listinfo)))))
1049 feedinfo))) 1049 feedinfo)))
1050 (cdr (assoc 1050 (cdr (assoc
1051 (completing-read 1051 (gnus-completing-read
1052 "Multiple feeds found. Select one: " 1052 "Multiple feeds found. Select one"
1053 selection nil t) urllist))))))))) 1053 selection t) urllist)))))))))
1054 1054
1055(defun nnrss-rss-p (data) 1055(defun nnrss-rss-p (data)
1056 "Test if DATA is an RSS feed. 1056 "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'."
82 :version "22.1" ;; Oort Gnus 82 :version "22.1" ;; Oort Gnus
83 :group 'pop3) 83 :group 'pop3)
84 84
85(defcustom pop3-stream-length 100
86 "How many messages should be requested at one time.
87The lower the number, the more latency-sensitive the fetching
88will be. If your pop3 server doesn't support streaming at all,
89set this to 1."
90 :type 'number
91 :version "24.1"
92 :group 'pop3)
93
85(defcustom pop3-leave-mail-on-server nil 94(defcustom pop3-leave-mail-on-server nil
86 "*Non-nil if the mail is to be left on the POP server after fetching. 95 "*Non-nil if the mail is to be left on the POP server after fetching.
87 96
@@ -156,7 +165,7 @@ Use streaming commands."
156 (while (>= count i) 165 (while (>= count i)
157 (process-send-string process (format "%s %d\r\n" command i)) 166 (process-send-string process (format "%s %d\r\n" command i))
158 ;; Only do 100 messages at a time to avoid pipe stalls. 167 ;; Only do 100 messages at a time to avoid pipe stalls.
159 (when (zerop (% i 100)) 168 (when (zerop (% i pop3-stream-length))
160 (pop3-wait-for-messages process i total-size)) 169 (pop3-wait-for-messages process i total-size))
161 (incf i))) 170 (incf i)))
162 (pop3-wait-for-messages process count total-size)) 171 (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."
371 (if keyfile 371 (if keyfile
372 keyfile 372 keyfile
373 (smime-get-key-with-certs-by-email 373 (smime-get-key-with-certs-by-email
374 (completing-read 374 (gnus-completing-read
375 (concat "Sign using key" 375 "Sign using key"
376 (if smime-keys 376 smime-keys nil (car-safe (car-safe smime-keys))))))
377 (concat " (default " (caar smime-keys) "): ")
378 ": "))
379 smime-keys nil nil (car-safe (car-safe smime-keys))))))
380 (error "Signing failed")))) 377 (error "Signing failed"))))
381 378
382(defun smime-encrypt-buffer (&optional certfiles buffer) 379(defun smime-encrypt-buffer (&optional certfiles buffer)
@@ -502,11 +499,9 @@ in the buffer specified by `smime-details-buffer'."
502 (expand-file-name 499 (expand-file-name
503 (or keyfile 500 (or keyfile
504 (smime-get-key-by-email 501 (smime-get-key-by-email
505 (completing-read 502 (gnus-completing-read
506 (concat "Decipher using key" 503 "Decipher using key"
507 (if smime-keys (concat " (default " (caar smime-keys) "): ") 504 smime-keys nil (car-safe (car-safe smime-keys)))))))))
508 ": "))
509 smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
510 505
511;; Various operations 506;; Various operations
512 507
@@ -660,6 +655,7 @@ A string or a list of strings is returned."
660 (define-key smime-mode-map "f" 'smime-certificate-info)) 655 (define-key smime-mode-map "f" 'smime-certificate-info))
661 656
662(autoload 'gnus-run-mode-hooks "gnus-util") 657(autoload 'gnus-run-mode-hooks "gnus-util")
658(autoload 'gnus-completing-read "gnus-util")
663 659
664(defun smime-mode () 660(defun smime-mode ()
665 "Major mode for browsing, viewing and fetching certificates. 661 "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 @@
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 5
6;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 6;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
7;; Keywords: hotmail netaddress my-deja netscape 7;; Keywords: hotmail netaddress
8 8
9;; This file is part of GNU Emacs. 9;; This file is part of GNU Emacs.
10 10
@@ -115,39 +115,7 @@
115 (article-snarf . webmail-netaddress-article) 115 (article-snarf . webmail-netaddress-article)
116 (trash-url 116 (trash-url
117 "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1" 117 "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
118 webmail-session id)) 118 webmail-session id))))
119 (netscape
120 (paranoid cookie post agent)
121 (address . "webmail.netscape.com")
122 (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")
123 (open-snarf . webmail-netscape-open)
124 (login-url
125 content
126 ("http://ureg.netscape.com/iiop/UReg2/login/loginform")
127 "U2_USERNAME=%s&U2_PASSWORD=%s%s"
128 user password webmail-aux)
129 (login-snarf . webmail-netaddress-login)
130 (list-url
131 "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
132 webmail-session)
133 (list-snarf . webmail-netaddress-list)
134 (article-url "http://webmail.netscape.com/")
135 (article-snarf . webmail-netscape-article)
136 (trash-url
137 "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
138 webmail-session id))
139 (my-deja
140 (paranoid cookie post)
141 (address . "www.my-deja.com")
142 ;;(open-snarf . webmail-my-deja-open)
143 (login-url
144 content
145 ("http://mydeja.google.com/cgi-bin/deja/maillogin.py")
146 "userid=%s&password=%s"
147 user password)
148 (list-snarf . webmail-my-deja-list)
149 (article-snarf . webmail-my-deja-article)
150 (trash-url webmail-aux id))))
151 119
152(defvar webmail-variables 120(defvar webmail-variables
153 '(address article-snarf article-url list-snarf list-url 121 '(address article-snarf article-url list-snarf list-url
@@ -683,15 +651,6 @@
683 651
684;;; netaddress 652;;; netaddress
685 653
686(defun webmail-netscape-open ()
687 (goto-char (point-min))
688 (setq webmail-aux "")
689 (while (re-search-forward
690 "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
691 nil t)
692 (setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
693 (match-string 2)))))
694
695(defun webmail-netaddress-open () 654(defun webmail-netaddress-open ()
696 (goto-char (point-min)) 655 (goto-char (point-min))
697 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t) 656 (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
@@ -872,280 +831,6 @@
872 (insert ">")))) 831 (insert ">"))))
873 (mm-append-to-file (point-min) (point-max) file))) 832 (mm-append-to-file (point-min) (point-max) file)))
874 833
875(defun webmail-netscape-article (file id)
876 (let (p p1 attachment count mime type)
877 (save-restriction
878 (webmail-encode-8bit)
879 (goto-char (point-min))
880 (if (not (search-forward "Trash" nil t))
881 (webmail-error "article@1"))
882 (if (not (search-forward "<form>" nil t))
883 (webmail-error "article@2"))
884 (delete-region (point-min) (match-beginning 0))
885 (if (not (search-forward "</form>" nil t))
886 (webmail-error "article@3"))
887 (narrow-to-region (point-min) (match-end 0))
888 (goto-char (point-min))
889 (while (re-search-forward "[\040\t\r\n]+" nil t)
890 (replace-match " "))
891 (goto-char (point-min))
892 (while (re-search-forward "<a href=[^>]*>[^<]*</a>" nil t)
893 (replace-match ""))
894 (goto-char (point-min))
895 (while (search-forward "<b>" nil t)
896 (replace-match "\n"))
897 (mm-url-remove-markup)
898 (mm-url-decode-entities-nbsp)
899 (goto-char (point-min))
900 (delete-blank-lines)
901 (goto-char (point-min))
902 (while (re-search-forward "^\040+\\|\040+$" nil t)
903 (replace-match ""))
904 (goto-char (point-min))
905 (while (re-search-forward "\040+" nil t)
906 (replace-match " "))
907 (goto-char (point-max))
908 (widen)
909 (insert "\n\n")
910 (setq p (point))
911 (unless (search-forward "<!-- Data -->" nil t)
912 (webmail-error "article@4"))
913 (forward-line 14)
914 (delete-region p (point))
915 (goto-char (point-max))
916 (unless (re-search-backward
917 "<form name=\"Transfer2\"" p t)
918 (webmail-error "article@5"))
919 (delete-region (point) (point-max))
920 (goto-char p)
921 (while (search-forward
922 "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
923 nil t 2)
924 (setq mime t)
925 (unless (search-forward "</TABLE>" nil t)
926 (webmail-error "article@6"))
927 (setq p1 (point))
928 (if (search-backward "<IMG " p t)
929 (progn
930 (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
931 (webmail-error "article@7"))
932 (setq attachment (match-string 1))
933 (setq type (match-string 2))
934 (unless (search-forward "</TABLE>" nil t)
935 (webmail-error "article@8"))
936 (delete-region p (point))
937 (let (bufname);; Attachment
938 (save-excursion
939 (set-buffer (generate-new-buffer " *webmail-att*"))
940 (mm-url-insert (concat (car webmail-open-url) attachment))
941 (push (current-buffer) webmail-buffer-list)
942 (setq bufname (buffer-name)))
943 (insert "<#part type=" type)
944 (insert " buffer=\"" bufname "\"")
945 (insert " disposition=\"inline\"")
946 (insert "><#/part>\n")
947 (setq p (point))))
948 (delete-region p p1)
949 (narrow-to-region
950 p
951 (if (search-forward
952 "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
953 nil t)
954 (match-beginning 0)
955 (point-max)))
956 (webmail-netaddress-single-part)
957 (goto-char (point-max))
958 (setq p (point))
959 (widen)))
960 (unless mime
961 (narrow-to-region p (point-max))
962 (setq mime (webmail-netaddress-single-part))
963 (widen))
964 (goto-char (point-min))
965 ;; Some blank line to separate mails.
966 (insert "\n\nFrom nobody " (current-time-string) "\n")
967 (insert "X-Gnus-Webmail: " (symbol-value 'user)
968 "@" (symbol-name webmail-type) "\n")
969 (if id
970 (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
971 (unless (looking-at "$")
972 (if (search-forward "\n\n" nil t)
973 (forward-line -1)
974 (webmail-error "article@2")))
975 (when mime
976 (narrow-to-region (point-min) (point))
977 (goto-char (point-min))
978 (while (not (eobp))
979 (if (looking-at "MIME-Version\\|Content-Type")
980 (delete-region (point)
981 (progn
982 (forward-line 1)
983 (if (re-search-forward "^[^ \t]" nil t)
984 (goto-char (match-beginning 0))
985 (point-max))))
986 (forward-line 1)))
987 (goto-char (point-max))
988 (widen)
989 (narrow-to-region (point) (point-max))
990 (insert "MIME-Version: 1.0\n"
991 (prog1
992 (mml-generate-mime)
993 (delete-region (point-min) (point-max))))
994 (goto-char (point-min))
995 (widen))
996 (let (case-fold-search)
997 (while (re-search-forward "^From " nil t)
998 (beginning-of-line)
999 (insert ">"))))
1000 (mm-append-to-file (point-min) (point-max) file)))
1001
1002;;; my-deja
1003
1004(defun webmail-my-deja-open ()
1005 (webmail-refresh-redirect)
1006 (goto-char (point-min))
1007 (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\""
1008 nil t)
1009 (setq webmail-aux (match-string 1))
1010 (webmail-error "open@1")))
1011
1012(defun webmail-my-deja-list ()
1013 (let (item id newp base)
1014 (goto-char (point-min))
1015 (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
1016 nil t)
1017 (let ((url (match-string 1)))
1018 (setq base (match-string 2))
1019 (erase-buffer)
1020 (mm-url-insert url)))
1021 (goto-char (point-min))
1022 (when (re-search-forward
1023 "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
1024 nil t)
1025 (message "Found %s mail(s), %s unread"
1026 (match-string 1) (match-string 2)))
1027 (goto-char (point-min))
1028 (while (re-search-forward
1029 "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1030 nil t)
1031 (if (setq id (match-string 2))
1032 (when (and (or newp (not webmail-newmail-only))
1033 (not (assoc id webmail-articles)))
1034 (push (cons id (setq webmail-aux
1035 (concat base "/" (match-string 1))))
1036 webmail-articles)
1037 (setq newp nil))
1038 (setq newp t)))
1039 (setq webmail-articles (nreverse webmail-articles))))
1040
1041(defun webmail-my-deja-article-part (base)
1042 (let (p)
1043 (cond
1044 ((looking-at "[\t\040\r\n]*<!--[^>]*>")
1045 (replace-match ""))
1046 ((looking-at "[\t\040\r\n]*</PRE>")
1047 (replace-match ""))
1048 ((looking-at "[\t\040\r\n]*<PRE>")
1049 ;; text/plain
1050 (replace-match "")
1051 (save-restriction
1052 (narrow-to-region (point)
1053 (if (re-search-forward "</?PRE>" nil t)
1054 (match-beginning 0)
1055 (point-max)))
1056 (goto-char (point-min))
1057 (mm-url-remove-markup)
1058 (mm-url-decode-entities-nbsp)
1059 (goto-char (point-max))))
1060 ((looking-at "[\t\040\r\n]*<TABLE")
1061 (save-restriction
1062 (narrow-to-region (point)
1063 (if (search-forward "</TABLE>" nil t 2)
1064 (point)
1065 (point-max)))
1066 (goto-char (point-min))
1067 (let (name type url bufname)
1068 (if (and (search-forward "File Name:" nil t)
1069 (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1070 (setq name (match-string 1)))
1071 (if (and (search-forward "File Type:" nil t)
1072 (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
1073 (setq type (match-string 1)))
1074 (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
1075 nil t)
1076 (webmail-error "article@5"))
1077 (setq url (concat base "/getattach.cgi/" (match-string 1)
1078 "?sm=Download"))
1079 (while (re-search-forward
1080 "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
1081 nil t)
1082 (setq url (concat url "&" (match-string 1) "="
1083 (match-string 2))))
1084 (delete-region (point-min) (point-max))
1085 (save-excursion
1086 (set-buffer (generate-new-buffer " *webmail-att*"))
1087 (mm-url-insert url)
1088 (push (current-buffer) webmail-buffer-list)
1089 (setq bufname (buffer-name)))
1090 (insert "<#part type=\"" type "\"")
1091 (if name (insert " filename=\"" name "\""))
1092 (insert " buffer=\"" bufname "\"")
1093 (insert " disposition=inline><#/part>"))))
1094 (t
1095 (insert "<#part type=\"text/html\" disposition=inline>")
1096 (goto-char (point-max))
1097 (insert "<#/part>")))))
1098
1099(defun webmail-my-deja-article (file id)
1100 (let (base)
1101 (goto-char (point-min))
1102 (unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
1103 (webmail-error "article@0"))
1104 (setq base (match-string 1 webmail-aux))
1105 (when (re-search-forward
1106 "href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
1107 nil t)
1108 (setq webmail-aux (concat base "/" (match-string 1)))
1109 (string-match "mid=[^\"&]+" webmail-aux)
1110 (setq webmail-aux (replace-match "mid=%s" nil nil webmail-aux)))
1111 (unless (search-forward "<HR noshade>" nil t)
1112 (webmail-error "article@1"))
1113 (delete-region (point-min) (point))
1114 (unless (search-forward "<HR noshade>" nil t)
1115 (webmail-error "article@2"))
1116 (save-restriction
1117 (narrow-to-region (point-min) (point))
1118 (while (search-forward "\r\n" nil t)
1119 (replace-match "\n"))
1120 (mm-url-remove-markup)
1121 (mm-url-decode-entities-nbsp)
1122 (goto-char (point-min))
1123 (while (re-search-forward "\n\n+" nil t)
1124 (replace-match "\n"))
1125 (goto-char (point-max)))
1126 (save-restriction
1127 (narrow-to-region (point) (point-max))
1128 (goto-char (point-max))
1129 (unless (search-backward "<HR noshade>" nil t)
1130 (webmail-error "article@3"))
1131 (unless (search-backward "</TT>" nil t)
1132 (webmail-error "article@4"))
1133 (delete-region (point) (point-max))
1134 (goto-char (point-min))
1135 (while (not (eobp))
1136 (webmail-my-deja-article-part base))
1137 (insert "MIME-Version: 1.0\n"
1138 (prog1
1139 (mml-generate-mime)
1140 (delete-region (point-min) (point-max)))))
1141 (goto-char (point-min))
1142 (insert "\n\nFrom nobody " (current-time-string) "\n")
1143 (insert "X-Gnus-Webmail: " (symbol-value 'user)
1144 "@" (symbol-name webmail-type) "\n")
1145 (if (eq (char-after) ?\n)
1146 (delete-char 1))
1147 (mm-append-to-file (point-min) (point-max) file)))
1148
1149(provide 'webmail) 834(provide 'webmail)
1150 835
1151;;; webmail.el ends here 836;;; webmail.el ends here