diff options
| author | Gnus developers | 2010-09-30 08:39:23 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-09-30 08:39:23 +0000 |
| commit | 229b59da361fdfbea696ef7d829453222b78b219 (patch) | |
| tree | fde9a1b1de67f3d0522c7701dbb6551a739716df | |
| parent | 968ef9b4dae78c5badd7f377b26519c8840823e7 (diff) | |
| download | emacs-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.
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 |
| 10800 | If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will | 10800 | If @code{<backend>-fetch-partial-articles} is non-@code{nil}, Gnus will |
| 10801 | fetch partial articles, if the backend it fetches them from supports | 10801 | fetch partial articles, if the backend it fetches them from supports |
| 10802 | it. Currently only @code{nnimap} does. If you're looking at a | 10802 | it. Currently only @code{nnimap} does. If you're looking at a |
| 10803 | partial article, and want to see the complete article instead, then | 10803 | partial 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 | ||
| 14794 | The most popular mail backend is probably @code{nnimap}, which | 14794 | The most popular mail backend is probably @code{nnimap}, which |
| @@ -14798,14 +14798,14 @@ This means that it's a convenient choice when you're reading your mail | |||
| 14798 | from different locations, or with different user agents. | 14798 | from 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 | ||
| 14810 | Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the | 14810 | Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the |
| 14811 | group buffer, or (if your primary interest is reading email), say | 14811 | group buffer, or (if your primary interest is reading email), say |
| @@ -14826,15 +14826,15 @@ machine imap.gmail.com login <username> password <password> port imap | |||
| 14826 | That should basically be it for most users. | 14826 | That 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 | ||
| 14832 | Here's an example method that's more complex: | 14832 | Here'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}. | |||
| 14878 | Virtually all @code{IMAP} server support fast streaming of data. If | 14878 | Virtually all @code{IMAP} server support fast streaming of data. If |
| 14879 | you have problems connecting to the server, try setting this to @code{nil}. | 14879 | you have problems connecting to the server, try setting this to @code{nil}. |
| 14880 | 14880 | ||
| 14881 | @item nnimap-fetch-partial-articles | ||
| 14882 | If non-@code{nil}, fetch partial articles from the server. If set to | ||
| 14883 | a string, then it's interpreted as a regexp, and parts that have | ||
| 14884 | matching types will be fetched. For instance, @samp{"text/"} will | ||
| 14885 | fetch 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 | ||
| 14887 | Many people prefer to do the sorting/splitting of mail into their mail | 14893 | Many people prefer to do the sorting/splitting of mail into their mail |
| 14888 | boxes on the @acronym{IMAP} server. That way they don't have to | 14894 | boxes on the @acronym{IMAP} server. That way they don't have to |
| @@ -14897,7 +14903,8 @@ This is the @acronym{IMAP} mail box that will be scanned for new mail. | |||
| 14897 | 14903 | ||
| 14898 | @item nnimap-split-methods | 14904 | @item nnimap-split-methods |
| 14899 | Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting | 14905 | Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting |
| 14900 | Mail}). | 14906 | Mail}), except the symbol @code{default}, which means that it should |
| 14907 | use 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 |
| 15461 | with nnimap), for some reason or other, Gnus let you treat it similar | 15468 | with nnimap), for some reason or other, Gnus let you treat it similar |
| 15462 | to a @acronym{POP} server and fetches articles from a given | 15469 | to 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 | ||
| 15465 | Keywords: | 15472 | Keywords: |
| 15466 | 15473 | ||
| @@ -15929,7 +15936,7 @@ after @code{save-excursion} and @code{save-restriction} in the example | |||
| 15929 | above. Also note that with the nnimap backend, message bodies will | 15936 | above. Also note that with the nnimap backend, message bodies will |
| 15930 | not be downloaded by default. You need to set | 15937 | not 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}) |
| 15935 | If the split is a list, and the first element is @code{!}, then | 15942 | If the split is a list, and the first element is @code{!}, then |
| @@ -23263,12 +23270,9 @@ The following variables offer control over how things are displayed. | |||
| 23263 | The size in pixels of gravatars. Gravatars are always square, so one | 23270 | The size in pixels of gravatars. Gravatars are always square, so one |
| 23264 | number for the size is enough. | 23271 | number 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 |
| 23268 | If non-nil, adds a shadow rectangle around the image. The value, | 23275 | List of image properties applied to Gravatar images. |
| 23269 | relief, specifies the width of the shadow lines, in pixels. If relief | ||
| 23270 | is negative, shadows are drawn so that the image appears as a pressed | ||
| 23271 | button; 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: | |||
| 23618 | Note that with the nnimap back end, message bodies will not be | 23622 | Note that with the nnimap back end, message bodies will not be |
| 23619 | downloaded by default. You need to set | 23623 | downloaded 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 | ||
| 23623 | That is about it. As some spam is likely to get through anyway, you | 23627 | That is about it. As some spam is likely to get through anyway, you |
| 23624 | might want to have a nifty function to call when you happen to read | 23628 | might want to have a nifty function to call when you happen to read |
| @@ -23907,7 +23911,7 @@ the message headers; @code{nnimap-split-download-body} tells it to | |||
| 23907 | retrieve the message bodies as well. We don't set this by default | 23911 | retrieve the message bodies as well. We don't set this by default |
| 23908 | because it will slow @acronym{IMAP} down, and that is not an | 23912 | because it will slow @acronym{IMAP} down, and that is not an |
| 23909 | appropriate decision to make on behalf of the user. @xref{Client-Side | 23913 | appropriate decision to make on behalf of the user. @xref{Client-Side |
| 23910 | @acronym{IMAP} Splitting}. | 23914 | IMAP Splitting}. |
| 23911 | 23915 | ||
| 23912 | You have to specify one or more spam back ends for @code{spam-split} | 23916 | You have to specify one or more spam back ends for @code{spam-split} |
| 23913 | to use, by setting the @code{spam-use-*} variables. @xref{Spam Back | 23917 | to use, by setting the @code{spam-use-*} variables. @xref{Spam Back |
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS index de5318d45cb..ca2f2309b99 100644 --- a/etc/GNUS-NEWS +++ b/etc/GNUS-NEWS | |||
| @@ -50,7 +50,7 @@ support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top. | |||
| 50 | The primary change this brings is support for DIGEST-MD5 and NTLM, when | 50 | The primary change this brings is support for DIGEST-MD5 and NTLM, when |
| 51 | the server supports it. | 51 | the 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 | ||
| 55 | It is enabled by default (see `password-cache'), with a short timeout of | 55 | It is enabled by default (see `password-cache'), with a short timeout of |
| 56 | 16 seconds (see `password-cache-expiry'). If PGG is used as the PGP | 56 | 16 seconds (see `password-cache-expiry'). If PGG is used as the PGP |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 4788deba5da..8043620c6b7 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -459,10 +459,7 @@ manipulated as follows: | |||
| 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." |
| 40 | value, relief, specifies the width of the shadow lines, in | 41 | :type 'list |
| 41 | pixels. If relief is negative, shadows are drawn so that the | 42 | :version "24.1" |
| 42 | image appears as a pressed button; otherwise, it appears as an | ||
| 43 | unpressed 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. |
| 2171 | The arguments are the same as `completing-read' except that COLLECTION | 2170 | The arguments are the same as `completing-read' except that COLLECTION |
| 2172 | and HIST default to `gnus-active-hashtb' and `gnus-group-history' | 2171 | and HIST default to `gnus-active-hashtb' and `gnus-group-history' |
| 2173 | respectively if they are omitted." | 2172 | respectively 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. |
| 2201 | If ARTICLES, display those articles. | 2192 | If ARTICLES, display those articles. |
| 2202 | Returns whether the fetching was successful or not." | 2193 | Returns 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. |
| 2655 | The user will be prompted for GROUP." | 2646 | The 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." | |||
| 3672 | Killed newsgroups are subscribed. If SILENT, don't try to update the | 3664 | Killed newsgroups are subscribed. If SILENT, don't try to update the |
| 3673 | group line." | 3665 | group 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." | |||
| 4013 | If given a prefix argument, prompt for a group." | 4005 | If 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 | |||
| 4314 | If not, METHOD should be a list where the first element is the method | 4306 | If not, METHOD should be a list where the first element is the method |
| 4315 | and the second element is the address." | 4307 | and 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. | |||
| 913 | TYPE is the score type. | 913 | TYPE is the score type. |
| 914 | SCORE is the score to add. | 914 | SCORE is the score to add. |
| 915 | EXTRA is the possible non-standard header." | 915 | EXTRA 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 | |||
| 7999 | is a number, it is the line the article is to be displayed on." | 7999 | is 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 | |||
| 9234 | article. If BACKWARD (the prefix) is non-nil, search backward instead." | 9230 | article. 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." | |||
| 1303 | If COPYP, copy the groups instead." | 1301 | If 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. |
| 1724 | If REVERSE, reverse the sorting order." | 1725 | If 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. |
| 71 | Uses the same syntax as nnmail-split-methods") | 71 | Uses 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. |
| 75 | Possible choices are nil (use default methods) or `anonymous'.") | 78 | Possible 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." | |||
| 848 | All necessary information will be queried from the user." | 848 | All 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." | |||
| 1165 | If SKIPDEFAULT is t, the default search group will not be | 1165 | If SKIPDEFAULT is t, the default search group will not be |
| 1166 | updated. | 1166 | updated. |
| 1167 | If UPDATEDB is t, database for SERVERNAME will be updated first." | 1167 | If 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. | ||
| 87 | The lower the number, the more latency-sensitive the fetching | ||
| 88 | will be. If your pop3 server doesn't support streaming at all, | ||
| 89 | set 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 |