diff options
| author | Gnus developers | 2010-09-26 04:03:19 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-09-26 04:03:19 +0000 |
| commit | 8ccbef23ea624d892bada3c66ef2339ada342997 (patch) | |
| tree | b8baaa6929a0742ffd301529bcc27001dd08e031 | |
| parent | 83e245c4906513429cb56629485deb5f04a240a3 (diff) | |
| download | emacs-8ccbef23ea624d892bada3c66ef2339ada342997.tar.gz emacs-8ccbef23ea624d892bada3c66ef2339ada342997.zip | |
Merge changes made in Gnus trunk.
nnimap.el: Implement partial IMAP article fetch.
nnimap.el: Have nnimap not update the infos if it can't get info from the server.
Implement functions for showing the complete articles.
gnus-int.el (gnus-open-server): Don't query whether to go offline -- just do it.
gnus-art.el (gnus-mime-delete-part): Fix plural for "byte" when there isn't a single byte.
nndoc.el (nndoc-type-alist): Move mime-parts after mbox. Suggested by Jay Berkenbilt.
mm-decode.el (mm-save-part): Allow saving to other directories the normal Emacs way.
gnus-html.el (gnus-html-rescale-image): Use our defalias gnus-window-inside-pixel-edges.
gnus-srvr.el (gnus-server-copy-server): Add documentation.
gnus.texi (Using IMAP): Document the new nnimap.
nnimap.el (nnimap-wait-for-response): Search further when we're not using streaming.
gnus-int.el (gnus-check-server): Say what the error was when opening failed.
nnheader.el (nnheader-get-report-string): New function.
gnus-int.el (gnus-check-server): Use report-string.
nnimap.el (nnimap-open-connection): Add more error reporting when nnimap fails early.
gnus-start.el (gnus-get-unread-articles): Don't try to open failed servers twice.
nnimap.el (nnimap-wait-for-response): Reversed logic in the nnimap-streaming test.
gnus-art.el: Removed CTAN button stuff, which I don't think is very relevant any more.
Remove NoCeM support, since nobody seems to use it any more.
Remove earcon and gnus-audio.
gnus.el (gnus): Silence gnus-load message.
gnus-group.el (gnus-read-ephemeral-bug-group): Add the bug email address to the To list for easier response.
gnus.texi (Connecting to an IMAP Server): Show how to use as primary method instead of secondary.
| -rw-r--r-- | doc/misc/gnus-news.texi | 12 | ||||
| -rw-r--r-- | doc/misc/gnus.texi | 1107 | ||||
| -rw-r--r-- | lisp/gnus/earcon.el | 230 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 120 | ||||
| -rw-r--r-- | lisp/gnus/gnus-audio.el | 149 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cus.el | 5 | ||||
| -rw-r--r-- | lisp/gnus/gnus-demon.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 16 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/gnus-int.el | 68 | ||||
| -rw-r--r-- | lisp/gnus/gnus-nocem.el | 452 | ||||
| -rw-r--r-- | lisp/gnus/gnus-srvr.el | 62 | ||||
| -rw-r--r-- | lisp/gnus/gnus-start.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 25 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 37 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 24 | ||||
| -rw-r--r-- | lisp/gnus/mml1991.el | 95 | ||||
| -rw-r--r-- | lisp/gnus/mml2015.el | 365 | ||||
| -rw-r--r-- | lisp/gnus/nndoc.el | 6 | ||||
| -rw-r--r-- | lisp/gnus/nnheader.el | 12 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 269 |
21 files changed, 587 insertions, 2500 deletions
diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 8aa28dd89c8..bf7a685003f 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi | |||
| @@ -246,6 +246,16 @@ of the "Whomever writes:" line. You need to set | |||
| 246 | @code{message-insert-formatted-citation-line} as well. | 246 | @code{message-insert-formatted-citation-line} as well. |
| 247 | @end itemize | 247 | @end itemize |
| 248 | 248 | ||
| 249 | @item Changes in Browse Server mode | ||
| 250 | |||
| 251 | @itemize @bullet | ||
| 252 | @item Gnus' sophisticated subscription methods are now available in | ||
| 253 | Browse Server buffers as well using the variable | ||
| 254 | @code{gnus-browse-subscribe-newsgroup-method}. | ||
| 255 | |||
| 256 | @end itemize | ||
| 257 | |||
| 258 | |||
| 249 | @item Changes in back ends | 259 | @item Changes in back ends |
| 250 | 260 | ||
| 251 | @itemize @bullet | 261 | @itemize @bullet |
| @@ -336,6 +346,8 @@ be unchanged except that the marks will be removed when copying or | |||
| 336 | moving articles to a group that has not turned auto-expire on. | 346 | moving articles to a group that has not turned auto-expire on. |
| 337 | @xref{Expiring Mail}. | 347 | @xref{Expiring Mail}. |
| 338 | 348 | ||
| 349 | @item NoCeM support has been removed. | ||
| 350 | |||
| 339 | @end itemize | 351 | @end itemize |
| 340 | 352 | ||
| 341 | @end itemize | 353 | @end itemize |
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a22644f2f98..46a7d8fd7ef 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi | |||
| @@ -629,9 +629,9 @@ 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 | * Getting Mail:: Reading your personal mail with Gnus. | 633 | * Getting Mail:: Reading your personal mail with Gnus. |
| 633 | * Browsing the Web:: Getting messages from a plethora of Web sources. | 634 | * Browsing the Web:: Getting messages from a plethora of Web sources. |
| 634 | * IMAP:: Using Gnus as a @acronym{IMAP} client. | ||
| 635 | * Other Sources:: Reading directories, files. | 635 | * Other Sources:: Reading directories, files. |
| 636 | * Combined Groups:: Combining groups into one group. | 636 | * Combined Groups:: Combining groups into one group. |
| 637 | * Email Based Diary:: Using mails to manage diary events in Gnus. | 637 | * Email Based Diary:: Using mails to manage diary events in Gnus. |
| @@ -698,15 +698,6 @@ Browsing the Web | |||
| 698 | * RSS:: Reading RDF site summary. | 698 | * RSS:: Reading RDF site summary. |
| 699 | * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. | 699 | * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. |
| 700 | 700 | ||
| 701 | @acronym{IMAP} | ||
| 702 | |||
| 703 | * Splitting in IMAP:: Splitting mail with nnimap. | ||
| 704 | * Expiring in IMAP:: Expiring mail with nnimap. | ||
| 705 | * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. | ||
| 706 | * Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. | ||
| 707 | * A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. | ||
| 708 | * Debugging IMAP:: What to do when things don't work. | ||
| 709 | |||
| 710 | Other Sources | 701 | Other Sources |
| 711 | 702 | ||
| 712 | * Directory Groups:: You can read a directory as if it was a newsgroup. | 703 | * Directory Groups:: You can read a directory as if it was a newsgroup. |
| @@ -808,7 +799,6 @@ Various | |||
| 808 | * Highlighting and Menus:: Making buffers look all nice and cozy. | 799 | * Highlighting and Menus:: Making buffers look all nice and cozy. |
| 809 | * Buttons:: Get tendinitis in ten easy steps! | 800 | * Buttons:: Get tendinitis in ten easy steps! |
| 810 | * Daemons:: Gnus can do things behind your back. | 801 | * Daemons:: Gnus can do things behind your back. |
| 811 | * NoCeM:: How to avoid spam and other fatty foods. | ||
| 812 | * Undo:: Some actions can be undone. | 802 | * Undo:: Some actions can be undone. |
| 813 | * Predicate Specifiers:: Specifying predicates. | 803 | * Predicate Specifiers:: Specifying predicates. |
| 814 | * Moderation:: What to do if you're a moderator. | 804 | * Moderation:: What to do if you're a moderator. |
| @@ -1637,15 +1627,6 @@ of doing your job. Note that this variable is used before | |||
| 1637 | @vindex gnus-no-groups-message | 1627 | @vindex gnus-no-groups-message |
| 1638 | Message displayed by Gnus when no groups are available. | 1628 | Message displayed by Gnus when no groups are available. |
| 1639 | 1629 | ||
| 1640 | @item gnus-play-startup-jingle | ||
| 1641 | @vindex gnus-play-startup-jingle | ||
| 1642 | If non-@code{nil}, play the Gnus jingle at startup. | ||
| 1643 | |||
| 1644 | @item gnus-startup-jingle | ||
| 1645 | @vindex gnus-startup-jingle | ||
| 1646 | Jingle to be played if the above variable is non-@code{nil}. The | ||
| 1647 | default is @samp{Tuxedomoon.Jingle4.au}. | ||
| 1648 | |||
| 1649 | @item gnus-use-backend-marks | 1630 | @item gnus-use-backend-marks |
| 1650 | @vindex gnus-use-backend-marks | 1631 | @vindex gnus-use-backend-marks |
| 1651 | If non-@code{nil}, Gnus will store article marks both in the | 1632 | If non-@code{nil}, Gnus will store article marks both in the |
| @@ -3617,8 +3598,12 @@ Enter the current group (@code{gnus-browse-select-group}). | |||
| 3617 | @item u | 3598 | @item u |
| 3618 | @kindex u (Browse) | 3599 | @kindex u (Browse) |
| 3619 | @findex gnus-browse-unsubscribe-current-group | 3600 | @findex gnus-browse-unsubscribe-current-group |
| 3601 | @vindex gnus-browse-subscribe-newsgroup-method | ||
| 3620 | Unsubscribe to the current group, or, as will be the case here, | 3602 | Unsubscribe to the current group, or, as will be the case here, |
| 3621 | subscribe to it (@code{gnus-browse-unsubscribe-current-group}). | 3603 | subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You |
| 3604 | can affect the way the new group is entered into the Group buffer | ||
| 3605 | using the variable @code{gnus-browse-subscribe-newsgroup-method}. See | ||
| 3606 | @pxref{Subscription Methods} for available options. | ||
| 3622 | 3607 | ||
| 3623 | @item l | 3608 | @item l |
| 3624 | @itemx q | 3609 | @itemx q |
| @@ -10086,18 +10071,6 @@ string is invalid. | |||
| 10086 | An alist of @code{(RATE . REGEXP)} pairs used by the function | 10071 | An alist of @code{(RATE . REGEXP)} pairs used by the function |
| 10087 | @code{gnus-button-mid-or-mail-heuristic}. | 10072 | @code{gnus-button-mid-or-mail-heuristic}. |
| 10088 | 10073 | ||
| 10089 | @c Stuff related to gnus-button-tex-level | ||
| 10090 | |||
| 10091 | @item gnus-button-ctan-handler | ||
| 10092 | @findex gnus-button-ctan-handler | ||
| 10093 | The function to use for displaying CTAN links. It must take one | ||
| 10094 | argument, the string naming the URL. | ||
| 10095 | |||
| 10096 | @item gnus-ctan-url | ||
| 10097 | @vindex gnus-ctan-url | ||
| 10098 | Top directory of a CTAN (Comprehensive TeX Archive Network) archive used | ||
| 10099 | by @code{gnus-button-ctan-handler}. | ||
| 10100 | |||
| 10101 | @c Misc stuff | 10074 | @c Misc stuff |
| 10102 | 10075 | ||
| 10103 | @item gnus-article-button-face | 10076 | @item gnus-article-button-face |
| @@ -10170,14 +10143,6 @@ Related variables and functions include | |||
| 10170 | @code{gnus-button-mid-or-mail-heuristic}, and | 10143 | @code{gnus-button-mid-or-mail-heuristic}, and |
| 10171 | @code{gnus-button-mid-or-mail-heuristic-alist}. | 10144 | @code{gnus-button-mid-or-mail-heuristic-alist}. |
| 10172 | 10145 | ||
| 10173 | @item gnus-button-tex-level | ||
| 10174 | @vindex gnus-button-tex-level | ||
| 10175 | Controls the display of references to @TeX{} or LaTeX stuff, e.g. for CTAN | ||
| 10176 | URLs. See the variables @code{gnus-ctan-url}, | ||
| 10177 | @code{gnus-button-ctan-handler}, | ||
| 10178 | @code{gnus-button-ctan-directory-regexp}, and | ||
| 10179 | @code{gnus-button-handle-ctan-bogus-regexp}. | ||
| 10180 | |||
| 10181 | @end table | 10146 | @end table |
| 10182 | 10147 | ||
| 10183 | 10148 | ||
| @@ -10829,6 +10794,16 @@ Generate and print a PostScript image of the article buffer | |||
| 10829 | be run just before printing the buffer. An alternative way to print | 10794 | be run just before printing the buffer. An alternative way to print |
| 10830 | article is to use Muttprint (@pxref{Saving Articles}). | 10795 | article is to use Muttprint (@pxref{Saving Articles}). |
| 10831 | 10796 | ||
| 10797 | @item A C | ||
| 10798 | @vindex gnus-fetch-partial-articles | ||
| 10799 | @findex gnus-summary-show-complete-article | ||
| 10800 | If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will | ||
| 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 | ||
| 10803 | partial article, and want to see the complete article instead, then | ||
| 10804 | the @kbd{A C} command (@code{gnus-summary-show-complete-article}) will | ||
| 10805 | do so. | ||
| 10806 | |||
| 10832 | @end table | 10807 | @end table |
| 10833 | 10808 | ||
| 10834 | 10809 | ||
| @@ -11877,8 +11852,7 @@ read the same article more than once. Unless, of course, somebody has | |||
| 11877 | posted it to several groups separately. Posting the same article to | 11852 | posted it to several groups separately. Posting the same article to |
| 11878 | several groups (not cross-posting) is called @dfn{spamming}, and you are | 11853 | several groups (not cross-posting) is called @dfn{spamming}, and you are |
| 11879 | by law required to send nasty-grams to anyone who perpetrates such a | 11854 | by law required to send nasty-grams to anyone who perpetrates such a |
| 11880 | heinous crime. You may want to try NoCeM handling to filter out spam | 11855 | heinous crime. |
| 11881 | (@pxref{NoCeM}). | ||
| 11882 | 11856 | ||
| 11883 | Remember: Cross-posting is kinda ok, but posting the same article | 11857 | Remember: Cross-posting is kinda ok, but posting the same article |
| 11884 | separately to several groups is not. Massive cross-posting (aka. | 11858 | separately to several groups is not. Massive cross-posting (aka. |
| @@ -12009,7 +11983,7 @@ To handle @acronym{PGP} and @acronym{PGP/MIME} messages, you have to | |||
| 12009 | install an OpenPGP implementation such as GnuPG. The Lisp interface | 11983 | install an OpenPGP implementation such as GnuPG. The Lisp interface |
| 12010 | to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG, | 11984 | to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG, |
| 12011 | epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg, | 11985 | epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg, |
| 12012 | PGG Manual}), Mailcrypt, and gpg.el are also supported. | 11986 | PGG Manual}), and Mailcrypt are also supported. |
| 12013 | 11987 | ||
| 12014 | @item | 11988 | @item |
| 12015 | To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6 | 11989 | To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6 |
| @@ -12048,7 +12022,7 @@ public-key matching the @samp{From:} header as the recipient; | |||
| 12048 | @vindex mml1991-use | 12022 | @vindex mml1991-use |
| 12049 | Symbol indicating elisp interface to OpenPGP implementation for | 12023 | Symbol indicating elisp interface to OpenPGP implementation for |
| 12050 | @acronym{PGP} messages. The default is @code{epg}, but @code{pgg}, | 12024 | @acronym{PGP} messages. The default is @code{epg}, but @code{pgg}, |
| 12051 | @code{mailcrypt}, and @code{gpg} are also supported although | 12025 | and @code{mailcrypt} are also supported although |
| 12052 | deprecated. By default, Gnus uses the first available interface in | 12026 | deprecated. By default, Gnus uses the first available interface in |
| 12053 | this order. | 12027 | this order. |
| 12054 | 12028 | ||
| @@ -12056,7 +12030,7 @@ this order. | |||
| 12056 | @vindex mml2015-use | 12030 | @vindex mml2015-use |
| 12057 | Symbol indicating elisp interface to OpenPGP implementation for | 12031 | Symbol indicating elisp interface to OpenPGP implementation for |
| 12058 | @acronym{PGP/MIME} messages. The default is @code{epg}, but | 12032 | @acronym{PGP/MIME} messages. The default is @code{epg}, but |
| 12059 | @code{pgg}, @code{mailcrypt}, and @code{gpg} are also supported | 12033 | @code{pgg}, and @code{mailcrypt} are also supported |
| 12060 | although deprecated. By default, Gnus uses the first available | 12034 | although deprecated. By default, Gnus uses the first available |
| 12061 | interface in this order. | 12035 | interface in this order. |
| 12062 | 12036 | ||
| @@ -13726,9 +13700,9 @@ The different methods all have their peculiarities, of course. | |||
| 13726 | @menu | 13700 | @menu |
| 13727 | * Server Buffer:: Making and editing virtual servers. | 13701 | * Server Buffer:: Making and editing virtual servers. |
| 13728 | * Getting News:: Reading USENET news with Gnus. | 13702 | * Getting News:: Reading USENET news with Gnus. |
| 13703 | * Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. | ||
| 13729 | * Getting Mail:: Reading your personal mail with Gnus. | 13704 | * Getting Mail:: Reading your personal mail with Gnus. |
| 13730 | * Browsing the Web:: Getting messages from a plethora of Web sources. | 13705 | * Browsing the Web:: Getting messages from a plethora of Web sources. |
| 13731 | * IMAP:: Using Gnus as a @acronym{IMAP} client. | ||
| 13732 | * Other Sources:: Reading directories, files. | 13706 | * Other Sources:: Reading directories, files. |
| 13733 | * Combined Groups:: Combining groups into one group. | 13707 | * Combined Groups:: Combining groups into one group. |
| 13734 | * Email Based Diary:: Using mails to manage diary events in Gnus. | 13708 | * Email Based Diary:: Using mails to manage diary events in Gnus. |
| @@ -14141,6 +14115,14 @@ Close the connections to all servers in the buffer | |||
| 14141 | Remove all marks to whether Gnus was denied connection from any servers | 14115 | Remove all marks to whether Gnus was denied connection from any servers |
| 14142 | (@code{gnus-server-remove-denials}). | 14116 | (@code{gnus-server-remove-denials}). |
| 14143 | 14117 | ||
| 14118 | @item c | ||
| 14119 | @kindex c (Server) | ||
| 14120 | @findex gnus-server-copy-server | ||
| 14121 | Copy a server and give it a new name | ||
| 14122 | (@code{gnus-server-copy-server}). This can be useful if you have a | ||
| 14123 | complex method definition, and want to use the same definition towards | ||
| 14124 | a different (physical) server. | ||
| 14125 | |||
| 14144 | @item L | 14126 | @item L |
| 14145 | @kindex L (Server) | 14127 | @kindex L (Server) |
| 14146 | @findex gnus-server-offline-server | 14128 | @findex gnus-server-offline-server |
| @@ -14805,6 +14787,121 @@ there. | |||
| 14805 | @end table | 14787 | @end table |
| 14806 | 14788 | ||
| 14807 | 14789 | ||
| 14790 | @node Using @acronym{IMAP} | ||
| 14791 | @section Using @acronym{IMAP} | ||
| 14792 | @cindex imap | ||
| 14793 | |||
| 14794 | The most popular mail backend is probably @code{nnimap}, which | ||
| 14795 | provides access to @acronym{IMAP} servers. @acronym{IMAP} servers | ||
| 14796 | store mail remotely, so the client doesn't store anything locally. | ||
| 14797 | This means that it's a convenient choice when you're reading your mail | ||
| 14798 | from different locations, or with different user agents. | ||
| 14799 | |||
| 14800 | @menu | ||
| 14801 | * Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}. | ||
| 14802 | * Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection. | ||
| 14803 | * Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box. | ||
| 14804 | @end menu | ||
| 14805 | |||
| 14806 | |||
| 14807 | @node Connecting to an @acronym{IMAP} Server | ||
| 14808 | @subsection Connecting to an @acronym{IMAP} Server | ||
| 14809 | |||
| 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 | ||
| 14812 | something like: | ||
| 14813 | |||
| 14814 | @example | ||
| 14815 | (setq gnus-select-method | ||
| 14816 | '(nnimap "imap.gmail.com")) | ||
| 14817 | @end example | ||
| 14818 | |||
| 14819 | You'll be prompted for a user name and password. If you grow tired of | ||
| 14820 | that, then add the following to your @file{~/.authinfo} file: | ||
| 14821 | |||
| 14822 | @example | ||
| 14823 | machine imap.gmail.com login <username> password <password> port imap | ||
| 14824 | @end example | ||
| 14825 | |||
| 14826 | That should basically be it for most users. | ||
| 14827 | |||
| 14828 | |||
| 14829 | @node Customizing the @acronym{IMAP} Connection | ||
| 14830 | @subsection Customizing the @acronym{IMAP} Connection | ||
| 14831 | |||
| 14832 | Here's an example method that's more complex: | ||
| 14833 | |||
| 14834 | @example | ||
| 14835 | (nnimap "imap.gmail.com" | ||
| 14836 | (nnimap-inbox "INBOX") | ||
| 14837 | (nnimap-split-methods ,nnmail-split-methods) | ||
| 14838 | (nnimap-expunge t) | ||
| 14839 | (nnimap-stream 'ssl) | ||
| 14840 | (nnir-search-engine imap) | ||
| 14841 | (nnimap-expunge-inbox t)) | ||
| 14842 | @end example | ||
| 14843 | |||
| 14844 | @table @code | ||
| 14845 | @item nnimap-address | ||
| 14846 | The address of the server, like @samp{imap.gmail.com}. | ||
| 14847 | |||
| 14848 | @item nnimap-server-port | ||
| 14849 | If the server uses a non-standard port, that can be specified here. A | ||
| 14850 | typical port would be @samp{imap} or @samp{imaps}. | ||
| 14851 | |||
| 14852 | @item nnimap-stream | ||
| 14853 | How @code{nnimap} should connect to the server. Possible values are: | ||
| 14854 | |||
| 14855 | @table @code | ||
| 14856 | @item ssl | ||
| 14857 | This is the default, and this uses standard | ||
| 14858 | @acronym{TLS}/@acronym{SSL} connection. | ||
| 14859 | |||
| 14860 | @item network | ||
| 14861 | Non-encrypted and unsafe straight socket connection. | ||
| 14862 | |||
| 14863 | @item starttls | ||
| 14864 | Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port. | ||
| 14865 | |||
| 14866 | @item shell | ||
| 14867 | If you need to tunnel via other systems to connect to the server, you | ||
| 14868 | can use this option, and customize @code{nnimap-shell-program} to be | ||
| 14869 | what you need. | ||
| 14870 | |||
| 14871 | @end table | ||
| 14872 | |||
| 14873 | @item nnimap-authenticator | ||
| 14874 | Some @acronym{IMAP} servers allow anonymous logins. In that case, | ||
| 14875 | this should be set to @code{anonymous}. | ||
| 14876 | |||
| 14877 | @item nnimap-streaming | ||
| 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}. | ||
| 14880 | |||
| 14881 | @end table | ||
| 14882 | |||
| 14883 | |||
| 14884 | @node Client-Side @acronym{IMAP} Splitting | ||
| 14885 | @subsection Client-Side @acronym{IMAP} Splitting | ||
| 14886 | |||
| 14887 | 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 | ||
| 14889 | download the mail they're not all that interested in. | ||
| 14890 | |||
| 14891 | If you do want to do client-side mail splitting, then the following | ||
| 14892 | variables are relevant: | ||
| 14893 | |||
| 14894 | @table @code | ||
| 14895 | @item nnimap-inbox | ||
| 14896 | This is the @acronym{IMAP} mail box that will be scanned for new mail. | ||
| 14897 | |||
| 14898 | @item nnimap-split-methods | ||
| 14899 | Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting | ||
| 14900 | Mail}). | ||
| 14901 | |||
| 14902 | @end table | ||
| 14903 | |||
| 14904 | |||
| 14808 | @node Getting Mail | 14905 | @node Getting Mail |
| 14809 | @section Getting Mail | 14906 | @section Getting Mail |
| 14810 | @cindex reading mail | 14907 | @cindex reading mail |
| @@ -15363,10 +15460,7 @@ Get mail from a @acronym{IMAP} server. If you don't want to use | |||
| 15363 | @acronym{IMAP} as intended, as a network mail reading protocol (ie | 15460 | @acronym{IMAP} as intended, as a network mail reading protocol (ie |
| 15364 | with nnimap), for some reason or other, Gnus let you treat it similar | 15461 | with nnimap), for some reason or other, Gnus let you treat it similar |
| 15365 | to a @acronym{POP} server and fetches articles from a given | 15462 | to a @acronym{POP} server and fetches articles from a given |
| 15366 | @acronym{IMAP} mailbox. @xref{IMAP}, for more information. | 15463 | @acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information. |
| 15367 | |||
| 15368 | Note that for the Kerberos, GSSAPI, @acronym{TLS}/@acronym{SSL} and STARTTLS support you | ||
| 15369 | may need external programs and libraries, @xref{IMAP}. | ||
| 15370 | 15464 | ||
| 15371 | Keywords: | 15465 | Keywords: |
| 15372 | 15466 | ||
| @@ -15835,7 +15929,7 @@ after @code{save-excursion} and @code{save-restriction} in the example | |||
| 15835 | above. Also note that with the nnimap backend, message bodies will | 15929 | above. Also note that with the nnimap backend, message bodies will |
| 15836 | not be downloaded by default. You need to set | 15930 | not be downloaded by default. You need to set |
| 15837 | @code{nnimap-split-download-body} to @code{t} to do that | 15931 | @code{nnimap-split-download-body} to @code{t} to do that |
| 15838 | (@pxref{Splitting in IMAP}). | 15932 | (@pxref{Client-Side @acronym{IMAP} Splitting}). |
| 15839 | 15933 | ||
| 15840 | @item (! @var{func} @var{split}) | 15934 | @item (! @var{func} @var{split}) |
| 15841 | If the split is a list, and the first element is @code{!}, then | 15935 | If the split is a list, and the first element is @code{!}, then |
| @@ -16599,6 +16693,7 @@ Spool}). | |||
| 16599 | @end menu | 16693 | @end menu |
| 16600 | 16694 | ||
| 16601 | 16695 | ||
| 16696 | |||
| 16602 | @node Unix Mail Box | 16697 | @node Unix Mail Box |
| 16603 | @subsubsection Unix Mail Box | 16698 | @subsubsection Unix Mail Box |
| 16604 | @cindex nnmbox | 16699 | @cindex nnmbox |
| @@ -17724,739 +17819,6 @@ Put that in your @file{.emacs} file, and hitting links in W3-rendered | |||
| 17724 | follow the link. | 17819 | follow the link. |
| 17725 | 17820 | ||
| 17726 | 17821 | ||
| 17727 | @node IMAP | ||
| 17728 | @section IMAP | ||
| 17729 | @cindex nnimap | ||
| 17730 | @cindex @acronym{IMAP} | ||
| 17731 | |||
| 17732 | @acronym{IMAP} is a network protocol for reading mail (or news, or @dots{}), | ||
| 17733 | think of it as a modernized @acronym{NNTP}. Connecting to a @acronym{IMAP} | ||
| 17734 | server is much similar to connecting to a news server, you just | ||
| 17735 | specify the network address of the server. | ||
| 17736 | |||
| 17737 | @acronym{IMAP} has two properties. First, @acronym{IMAP} can do | ||
| 17738 | everything that @acronym{POP} can, it can hence be viewed as a | ||
| 17739 | @acronym{POP++}. Secondly, @acronym{IMAP} is a mail storage protocol, | ||
| 17740 | similar to @acronym{NNTP} being a news storage protocol---however, | ||
| 17741 | @acronym{IMAP} offers more features than @acronym{NNTP} because news | ||
| 17742 | is more or less read-only whereas mail is read-write. | ||
| 17743 | |||
| 17744 | If you want to use @acronym{IMAP} as a @acronym{POP++}, use an imap | ||
| 17745 | entry in @code{mail-sources}. With this, Gnus will fetch mails from | ||
| 17746 | the @acronym{IMAP} server and store them on the local disk. This is | ||
| 17747 | not the usage described in this section---@xref{Mail Sources}. | ||
| 17748 | |||
| 17749 | If you want to use @acronym{IMAP} as a mail storage protocol, use an nnimap | ||
| 17750 | entry in @code{gnus-secondary-select-methods}. With this, Gnus will | ||
| 17751 | manipulate mails stored on the @acronym{IMAP} server. This is the kind of | ||
| 17752 | usage explained in this section. | ||
| 17753 | |||
| 17754 | A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP} | ||
| 17755 | servers might look something like the following. (Note that for | ||
| 17756 | @acronym{TLS}/@acronym{SSL}, you need external programs and libraries, | ||
| 17757 | see below.) | ||
| 17758 | |||
| 17759 | @lisp | ||
| 17760 | (setq gnus-secondary-select-methods | ||
| 17761 | '((nnimap "simpleserver") ; @r{no special configuration} | ||
| 17762 | ; @r{perhaps a ssh port forwarded server:} | ||
| 17763 | (nnimap "dolk" | ||
| 17764 | (nnimap-address "localhost") | ||
| 17765 | (nnimap-server-port 1430)) | ||
| 17766 | ; @r{a UW server running on localhost} | ||
| 17767 | (nnimap "barbar" | ||
| 17768 | (nnimap-server-port 143) | ||
| 17769 | (nnimap-address "localhost") | ||
| 17770 | (nnimap-list-pattern ("INBOX" "mail/*"))) | ||
| 17771 | ; @r{anonymous public cyrus server:} | ||
| 17772 | (nnimap "cyrus.andrew.cmu.edu" | ||
| 17773 | (nnimap-authenticator anonymous) | ||
| 17774 | (nnimap-list-pattern "archive.*") | ||
| 17775 | (nnimap-stream network)) | ||
| 17776 | ; @r{a ssl server on a non-standard port:} | ||
| 17777 | (nnimap "vic20" | ||
| 17778 | (nnimap-address "vic20.somewhere.com") | ||
| 17779 | (nnimap-server-port 9930) | ||
| 17780 | (nnimap-stream ssl)))) | ||
| 17781 | @end lisp | ||
| 17782 | |||
| 17783 | After defining the new server, you can subscribe to groups on the | ||
| 17784 | server using normal Gnus commands such as @kbd{U} in the Group Buffer | ||
| 17785 | (@pxref{Subscription Commands}) or via the Server Buffer | ||
| 17786 | (@pxref{Server Buffer}). | ||
| 17787 | |||
| 17788 | The following variables can be used to create a virtual @code{nnimap} | ||
| 17789 | server: | ||
| 17790 | |||
| 17791 | @table @code | ||
| 17792 | |||
| 17793 | @item nnimap-address | ||
| 17794 | @vindex nnimap-address | ||
| 17795 | |||
| 17796 | The address of the remote @acronym{IMAP} server. Defaults to the virtual | ||
| 17797 | server name if not specified. | ||
| 17798 | |||
| 17799 | @item nnimap-server-port | ||
| 17800 | @vindex nnimap-server-port | ||
| 17801 | Port on server to contact. Defaults to port 143, or 993 for @acronym{TLS}/@acronym{SSL}. | ||
| 17802 | |||
| 17803 | Note that this should be an integer, example server specification: | ||
| 17804 | |||
| 17805 | @lisp | ||
| 17806 | (nnimap "mail.server.com" | ||
| 17807 | (nnimap-server-port 4711)) | ||
| 17808 | @end lisp | ||
| 17809 | |||
| 17810 | @item nnimap-list-pattern | ||
| 17811 | @vindex nnimap-list-pattern | ||
| 17812 | String or list of strings of mailboxes to limit available groups to. | ||
| 17813 | This is used when the server has very many mailboxes and you're only | ||
| 17814 | interested in a few---some servers export your home directory via | ||
| 17815 | @acronym{IMAP}, you'll probably want to limit the mailboxes to those in | ||
| 17816 | @file{~/Mail/*} then. | ||
| 17817 | |||
| 17818 | The string can also be a cons of REFERENCE and the string as above, what | ||
| 17819 | REFERENCE is used for is server specific, but on the University of | ||
| 17820 | Washington server it's a directory that will be concatenated with the | ||
| 17821 | mailbox. | ||
| 17822 | |||
| 17823 | Example server specification: | ||
| 17824 | |||
| 17825 | @lisp | ||
| 17826 | (nnimap "mail.server.com" | ||
| 17827 | (nnimap-list-pattern ("INBOX" "Mail/*" "alt.sex.*" | ||
| 17828 | ("~friend/Mail/" . "list/*")))) | ||
| 17829 | @end lisp | ||
| 17830 | |||
| 17831 | @item nnimap-stream | ||
| 17832 | @vindex nnimap-stream | ||
| 17833 | The type of stream used to connect to your server. By default, nnimap | ||
| 17834 | will detect and automatically use all of the below, with the exception | ||
| 17835 | of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over | ||
| 17836 | @acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can | ||
| 17837 | be automatically detected, but it's not widely deployed yet.) | ||
| 17838 | |||
| 17839 | Example server specification: | ||
| 17840 | |||
| 17841 | @lisp | ||
| 17842 | (nnimap "mail.server.com" | ||
| 17843 | (nnimap-stream ssl)) | ||
| 17844 | @end lisp | ||
| 17845 | |||
| 17846 | Please note that the value of @code{nnimap-stream} is a symbol! | ||
| 17847 | |||
| 17848 | @itemize @bullet | ||
| 17849 | @item | ||
| 17850 | @dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the | ||
| 17851 | @samp{gsasl} or @samp{imtest} program. | ||
| 17852 | @item | ||
| 17853 | @dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. | ||
| 17854 | @item | ||
| 17855 | @dfn{starttls:} Connect via the STARTTLS extension (similar to | ||
| 17856 | @acronym{TLS}/@acronym{SSL}). Requires the external library @samp{starttls.el} and program | ||
| 17857 | @samp{starttls}. | ||
| 17858 | @item | ||
| 17859 | @dfn{tls:} Connect through @acronym{TLS}. Requires GNUTLS (the program | ||
| 17860 | @samp{gnutls-cli}). | ||
| 17861 | @item | ||
| 17862 | @dfn{ssl:} Connect through @acronym{SSL}. Requires OpenSSL (the program | ||
| 17863 | @samp{openssl}) or SSLeay (@samp{s_client}). | ||
| 17864 | @item | ||
| 17865 | @dfn{shell:} Use a shell command to start @acronym{IMAP} connection. | ||
| 17866 | @item | ||
| 17867 | @dfn{network:} Plain, TCP/IP network connection. | ||
| 17868 | @end itemize | ||
| 17869 | |||
| 17870 | @vindex imap-kerberos4-program | ||
| 17871 | The @samp{imtest} program is shipped with Cyrus IMAPD. If you're | ||
| 17872 | using @samp{imtest} from Cyrus IMAPD < 2.0.14 (which includes version | ||
| 17873 | 1.5.x and 1.6.x) you need to frob @code{imap-process-connection-type} | ||
| 17874 | to make @code{imap.el} use a pty instead of a pipe when communicating | ||
| 17875 | with @samp{imtest}. You will then suffer from a line length | ||
| 17876 | restrictions on @acronym{IMAP} commands, which might make Gnus seem to hang | ||
| 17877 | indefinitely if you have many articles in a mailbox. The variable | ||
| 17878 | @code{imap-kerberos4-program} contain parameters to pass to the imtest | ||
| 17879 | program. | ||
| 17880 | |||
| 17881 | For @acronym{TLS} connection, the @code{gnutls-cli} program from GNUTLS is | ||
| 17882 | needed. It is available from | ||
| 17883 | @uref{http://www.gnu.org/software/gnutls/}. | ||
| 17884 | |||
| 17885 | @vindex imap-gssapi-program | ||
| 17886 | This parameter specifies a list of command lines that invoke a GSSAPI | ||
| 17887 | authenticated @acronym{IMAP} stream in a subshell. They are tried | ||
| 17888 | sequentially until a connection is made, or the list has been | ||
| 17889 | exhausted. By default, @samp{gsasl} from GNU SASL, available from | ||
| 17890 | @uref{http://www.gnu.org/software/gsasl/}, and the @samp{imtest} | ||
| 17891 | program from Cyrus IMAPD (see @code{imap-kerberos4-program}), are | ||
| 17892 | tried. | ||
| 17893 | |||
| 17894 | @vindex imap-ssl-program | ||
| 17895 | For @acronym{SSL} connections, the OpenSSL program is available from | ||
| 17896 | @uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, | ||
| 17897 | and nnimap support it too---although the most recent versions of | ||
| 17898 | SSLeay, 0.9.x, are known to have serious bugs making it | ||
| 17899 | useless. Earlier versions, especially 0.8.x, of SSLeay are known to | ||
| 17900 | work. The variable @code{imap-ssl-program} contain parameters to pass | ||
| 17901 | to OpenSSL/SSLeay. | ||
| 17902 | |||
| 17903 | @vindex imap-shell-program | ||
| 17904 | @vindex imap-shell-host | ||
| 17905 | For @acronym{IMAP} connections using the @code{shell} stream, the | ||
| 17906 | variable @code{imap-shell-program} specify what program to call. Make | ||
| 17907 | sure nothing is interfering with the output of the program, e.g., don't | ||
| 17908 | forget to redirect the error output to the void. | ||
| 17909 | |||
| 17910 | @item nnimap-authenticator | ||
| 17911 | @vindex nnimap-authenticator | ||
| 17912 | |||
| 17913 | The authenticator used to connect to the server. By default, nnimap | ||
| 17914 | will use the most secure authenticator your server is capable of. | ||
| 17915 | |||
| 17916 | Example server specification: | ||
| 17917 | |||
| 17918 | @lisp | ||
| 17919 | (nnimap "mail.server.com" | ||
| 17920 | (nnimap-authenticator anonymous)) | ||
| 17921 | @end lisp | ||
| 17922 | |||
| 17923 | Please note that the value of @code{nnimap-authenticator} is a symbol! | ||
| 17924 | |||
| 17925 | @itemize @bullet | ||
| 17926 | @item | ||
| 17927 | @dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires | ||
| 17928 | external program @code{gsasl} or @code{imtest}. | ||
| 17929 | @item | ||
| 17930 | @dfn{kerberos4:} Kerberos 4 authentication. Requires external program | ||
| 17931 | @code{imtest}. | ||
| 17932 | @item | ||
| 17933 | @dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires | ||
| 17934 | external library @code{digest-md5.el}. | ||
| 17935 | @item | ||
| 17936 | @dfn{cram-md5:} Encrypted username/password via CRAM-MD5. | ||
| 17937 | @item | ||
| 17938 | @dfn{login:} Plain-text username/password via LOGIN. | ||
| 17939 | @item | ||
| 17940 | @dfn{anonymous:} Login as ``anonymous'', supplying your email address as password. | ||
| 17941 | @end itemize | ||
| 17942 | |||
| 17943 | @item nnimap-expunge-on-close | ||
| 17944 | @cindex expunging | ||
| 17945 | @vindex nnimap-expunge-on-close | ||
| 17946 | Unlike Parmenides the @acronym{IMAP} designers have decided things that | ||
| 17947 | don't exist actually do exist. More specifically, @acronym{IMAP} has | ||
| 17948 | this concept of marking articles @code{Deleted} which doesn't actually | ||
| 17949 | delete them, and this (marking them @code{Deleted}, that is) is what | ||
| 17950 | nnimap does when you delete an article in Gnus (with @kbd{B DEL} or | ||
| 17951 | similar). | ||
| 17952 | |||
| 17953 | Since the articles aren't really removed when we mark them with the | ||
| 17954 | @code{Deleted} flag we'll need a way to actually delete them. Feel like | ||
| 17955 | running in circles yet? | ||
| 17956 | |||
| 17957 | Traditionally, nnimap has removed all articles marked as @code{Deleted} | ||
| 17958 | when closing a mailbox but this is now configurable by this server | ||
| 17959 | variable. | ||
| 17960 | |||
| 17961 | The possible options are: | ||
| 17962 | |||
| 17963 | @table @code | ||
| 17964 | |||
| 17965 | @item always | ||
| 17966 | The default behavior, delete all articles marked as ``Deleted'' when | ||
| 17967 | closing a mailbox. | ||
| 17968 | @item never | ||
| 17969 | Never actually delete articles. Currently there is no way of showing | ||
| 17970 | the articles marked for deletion in nnimap, but other @acronym{IMAP} clients | ||
| 17971 | may allow you to do this. If you ever want to run the EXPUNGE command | ||
| 17972 | manually, @xref{Expunging mailboxes}. | ||
| 17973 | @item ask | ||
| 17974 | When closing mailboxes, nnimap will ask if you wish to expunge deleted | ||
| 17975 | articles or not. | ||
| 17976 | |||
| 17977 | @end table | ||
| 17978 | |||
| 17979 | @item nnimap-importantize-dormant | ||
| 17980 | @vindex nnimap-importantize-dormant | ||
| 17981 | |||
| 17982 | If non-@code{nil} (the default), marks dormant articles as ticked (as | ||
| 17983 | well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will | ||
| 17984 | naturally still (only) be marked as dormant. This is to make dormant | ||
| 17985 | articles stand out, just like ticked articles, in other @acronym{IMAP} | ||
| 17986 | clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP} | ||
| 17987 | has only one.) | ||
| 17988 | |||
| 17989 | Probably the only reason for frobbing this would be if you're trying | ||
| 17990 | enable per-user persistent dormant flags, using something like: | ||
| 17991 | |||
| 17992 | @lisp | ||
| 17993 | (setcdr (assq 'dormant nnimap-mark-to-flag-alist) | ||
| 17994 | (format "gnus-dormant-%s" (user-login-name))) | ||
| 17995 | (setcdr (assq 'dormant nnimap-mark-to-predicate-alist) | ||
| 17996 | (format "KEYWORD gnus-dormant-%s" (user-login-name))) | ||
| 17997 | @end lisp | ||
| 17998 | |||
| 17999 | In this case, you would not want the per-user dormant flag showing up | ||
| 18000 | as ticked for other users. | ||
| 18001 | |||
| 18002 | @item nnimap-expunge-search-string | ||
| 18003 | @cindex expunging | ||
| 18004 | @vindex nnimap-expunge-search-string | ||
| 18005 | @cindex expiring @acronym{IMAP} mail | ||
| 18006 | |||
| 18007 | This variable contain the @acronym{IMAP} search command sent to server when | ||
| 18008 | searching for articles eligible for expiring. The default is | ||
| 18009 | @code{"UID %s NOT SINCE %s"}, where the first @code{%s} is replaced by | ||
| 18010 | UID set and the second @code{%s} is replaced by a date. | ||
| 18011 | |||
| 18012 | Probably the only useful value to change this to is | ||
| 18013 | @code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in | ||
| 18014 | messages instead of the internal article date. See section 6.4.4 of | ||
| 18015 | RFC 2060 for more information on valid strings. | ||
| 18016 | |||
| 18017 | However, if @code{nnimap-search-uids-not-since-is-evil} | ||
| 18018 | is true, this variable has no effect since the search logic | ||
| 18019 | is reversed, as described below. | ||
| 18020 | |||
| 18021 | @item nnimap-authinfo-file | ||
| 18022 | @vindex nnimap-authinfo-file | ||
| 18023 | |||
| 18024 | A file containing credentials used to log in on servers. The format is | ||
| 18025 | (almost) the same as the @code{ftp} @file{~/.netrc} file. See the | ||
| 18026 | variable @code{nntp-authinfo-file} for exact syntax; also see | ||
| 18027 | @ref{NNTP}. An example of an .authinfo line for an IMAP server, is: | ||
| 18028 | |||
| 18029 | @example | ||
| 18030 | machine students.uio.no login larsi password geheimnis port imap | ||
| 18031 | @end example | ||
| 18032 | |||
| 18033 | Note that it should be @code{port imap}, or @code{port 143}, if you | ||
| 18034 | use a @code{nnimap-stream} of @code{tls} or @code{ssl}, even if the | ||
| 18035 | actual port number used is port 993 for secured IMAP. For | ||
| 18036 | convenience, Gnus will accept @code{port imaps} as a synonym of | ||
| 18037 | @code{port imap}. | ||
| 18038 | |||
| 18039 | @item nnimap-need-unselect-to-notice-new-mail | ||
| 18040 | @vindex nnimap-need-unselect-to-notice-new-mail | ||
| 18041 | |||
| 18042 | Unselect mailboxes before looking for new mail in them. Some servers | ||
| 18043 | seem to need this under some circumstances; it was reported that | ||
| 18044 | Courier 1.7.1 did. | ||
| 18045 | |||
| 18046 | @item nnimap-nov-is-evil | ||
| 18047 | @vindex nnimap-nov-is-evil | ||
| 18048 | @cindex Courier @acronym{IMAP} server | ||
| 18049 | @cindex @acronym{NOV} | ||
| 18050 | |||
| 18051 | Never generate or use a local @acronym{NOV} database. Defaults to the | ||
| 18052 | value of @code{gnus-agent}. | ||
| 18053 | |||
| 18054 | Using a @acronym{NOV} database usually makes header fetching much | ||
| 18055 | faster, but it uses the @code{UID SEARCH UID} command, which is very | ||
| 18056 | slow on some servers (notably some versions of Courier). Since the Gnus | ||
| 18057 | Agent caches the information in the @acronym{NOV} database without using | ||
| 18058 | the slow command, this variable defaults to true if the Agent is in use, | ||
| 18059 | and false otherwise. | ||
| 18060 | |||
| 18061 | @item nnimap-search-uids-not-since-is-evil | ||
| 18062 | @vindex nnimap-search-uids-not-since-is-evil | ||
| 18063 | @cindex Courier @acronym{IMAP} server | ||
| 18064 | @cindex expiring @acronym{IMAP} mail | ||
| 18065 | |||
| 18066 | Avoid the @code{UID SEARCH UID @var{message numbers} NOT SINCE | ||
| 18067 | @var{date}} command, which is slow on some @acronym{IMAP} servers | ||
| 18068 | (notably, some versions of Courier). Instead, use @code{UID SEARCH SINCE | ||
| 18069 | @var{date}} and prune the list of expirable articles within Gnus. | ||
| 18070 | |||
| 18071 | When Gnus expires your mail (@pxref{Expiring Mail}), it starts with a | ||
| 18072 | list of expirable articles and asks the IMAP server questions like ``Of | ||
| 18073 | these articles, which ones are older than a week?'' While this seems | ||
| 18074 | like a perfectly reasonable question, some IMAP servers take a long time | ||
| 18075 | to answer it, since they seemingly go looking into every old article to | ||
| 18076 | see if it is one of the expirable ones. Curiously, the question ``Of | ||
| 18077 | @emph{all} articles, which ones are newer than a week?'' seems to be | ||
| 18078 | much faster to answer, so setting this variable causes Gnus to ask this | ||
| 18079 | question and figure out the answer to the real question itself. | ||
| 18080 | |||
| 18081 | This problem can really sneak up on you: when you first configure Gnus, | ||
| 18082 | everything works fine, but once you accumulate a couple thousand | ||
| 18083 | messages, you start cursing Gnus for being so slow. On the other hand, | ||
| 18084 | if you get a lot of email within a week, setting this variable will | ||
| 18085 | cause a lot of network traffic between Gnus and the IMAP server. | ||
| 18086 | |||
| 18087 | @item nnimap-logout-timeout | ||
| 18088 | @vindex nnimap-logout-timeout | ||
| 18089 | |||
| 18090 | There is a case where a connection to a @acronym{IMAP} server is unable | ||
| 18091 | to close, when connecting to the server via a certain kind of network, | ||
| 18092 | e.g. @acronym{VPN}. In that case, it will be observed that a connection | ||
| 18093 | between Emacs and the local network looks alive even if the server has | ||
| 18094 | closed a connection for some reason (typically, a timeout). | ||
| 18095 | Consequently, Emacs continues waiting for a response from the server for | ||
| 18096 | the @code{LOGOUT} command that Emacs sent, or hangs in other words. If | ||
| 18097 | you are in such a network, setting this variable to a number of seconds | ||
| 18098 | will be helpful. If it is set, a hung connection will be closed | ||
| 18099 | forcibly, after this number of seconds from the time Emacs sends the | ||
| 18100 | @code{LOGOUT} command. It should not be too small value but too large | ||
| 18101 | value will be inconvenient too. Perhaps the value 1.0 will be a good | ||
| 18102 | candidate but it might be worth trying some other values. | ||
| 18103 | |||
| 18104 | Example server specification: | ||
| 18105 | |||
| 18106 | @lisp | ||
| 18107 | (nnimap "mail.server.com" | ||
| 18108 | (nnimap-logout-timeout 1.0)) | ||
| 18109 | @end lisp | ||
| 18110 | |||
| 18111 | @end table | ||
| 18112 | |||
| 18113 | @menu | ||
| 18114 | * Splitting in IMAP:: Splitting mail with nnimap. | ||
| 18115 | * Expiring in IMAP:: Expiring mail with nnimap. | ||
| 18116 | * Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. | ||
| 18117 | * Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. | ||
| 18118 | * A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. | ||
| 18119 | * Debugging IMAP:: What to do when things don't work. | ||
| 18120 | @end menu | ||
| 18121 | |||
| 18122 | |||
| 18123 | |||
| 18124 | @node Splitting in IMAP | ||
| 18125 | @subsection Splitting in IMAP | ||
| 18126 | @cindex splitting imap mail | ||
| 18127 | |||
| 18128 | Splitting is something Gnus users have loved and used for years, and now | ||
| 18129 | the rest of the world is catching up. Yeah, dream on, not many | ||
| 18130 | @acronym{IMAP} servers have server side splitting and those that have | ||
| 18131 | splitting seem to use some non-standard protocol. This means that | ||
| 18132 | @acronym{IMAP} support for Gnus has to do its own splitting. | ||
| 18133 | |||
| 18134 | And it does. | ||
| 18135 | |||
| 18136 | (Incidentally, people seem to have been dreaming on, and Sieve has | ||
| 18137 | gaining a market share and is supported by several IMAP servers. | ||
| 18138 | Fortunately, Gnus support it too, @xref{Sieve Commands}.) | ||
| 18139 | |||
| 18140 | Here are the variables of interest: | ||
| 18141 | |||
| 18142 | @table @code | ||
| 18143 | |||
| 18144 | @item nnimap-split-crosspost | ||
| 18145 | @cindex splitting, crosspost | ||
| 18146 | @cindex crosspost | ||
| 18147 | @vindex nnimap-split-crosspost | ||
| 18148 | |||
| 18149 | If non-@code{nil}, do crossposting if several split methods match the | ||
| 18150 | mail. If @code{nil}, the first match in @code{nnimap-split-rule} | ||
| 18151 | found will be used. | ||
| 18152 | |||
| 18153 | Nnmail equivalent: @code{nnmail-crosspost}. | ||
| 18154 | |||
| 18155 | @item nnimap-split-inbox | ||
| 18156 | @cindex splitting, inbox | ||
| 18157 | @cindex inbox | ||
| 18158 | @vindex nnimap-split-inbox | ||
| 18159 | |||
| 18160 | A string or a list of strings that gives the name(s) of @acronym{IMAP} | ||
| 18161 | mailboxes to split from. Defaults to @code{nil}, which means that | ||
| 18162 | splitting is disabled! | ||
| 18163 | |||
| 18164 | @lisp | ||
| 18165 | (setq nnimap-split-inbox | ||
| 18166 | '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap")) | ||
| 18167 | @end lisp | ||
| 18168 | |||
| 18169 | No nnmail equivalent. | ||
| 18170 | |||
| 18171 | @item nnimap-split-rule | ||
| 18172 | @cindex splitting, rules | ||
| 18173 | @vindex nnimap-split-rule | ||
| 18174 | |||
| 18175 | New mail found in @code{nnimap-split-inbox} will be split according to | ||
| 18176 | this variable. | ||
| 18177 | |||
| 18178 | This variable contains a list of lists, where the first element in the | ||
| 18179 | sublist gives the name of the @acronym{IMAP} mailbox to move articles | ||
| 18180 | matching the regexp in the second element in the sublist. Got that? | ||
| 18181 | Neither did I, we need examples. | ||
| 18182 | |||
| 18183 | @lisp | ||
| 18184 | (setq nnimap-split-rule | ||
| 18185 | '(("INBOX.nnimap" | ||
| 18186 | "^Sender: owner-nnimap@@vic20.globalcom.se") | ||
| 18187 | ("INBOX.junk" "^Subject:.*MAKE MONEY") | ||
| 18188 | ("INBOX.private" ""))) | ||
| 18189 | @end lisp | ||
| 18190 | |||
| 18191 | This will put all articles from the nnimap mailing list into mailbox | ||
| 18192 | INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line | ||
| 18193 | into INBOX.junk and everything else in INBOX.private. | ||
| 18194 | |||
| 18195 | The first string may contain @samp{\\1} forms, like the ones used by | ||
| 18196 | replace-match to insert sub-expressions from the matched text. For | ||
| 18197 | instance: | ||
| 18198 | |||
| 18199 | @lisp | ||
| 18200 | ("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@") | ||
| 18201 | @end lisp | ||
| 18202 | |||
| 18203 | The first element can also be the symbol @code{junk} to indicate that | ||
| 18204 | matching messages should simply be deleted. Use with care. | ||
| 18205 | |||
| 18206 | The second element can also be a function. In that case, it will be | ||
| 18207 | called with the first element of the rule as the argument, in a buffer | ||
| 18208 | containing the headers of the article. It should return a | ||
| 18209 | non-@code{nil} value if it thinks that the mail belongs in that group. | ||
| 18210 | |||
| 18211 | Nnmail users might recollect that the last regexp had to be empty to | ||
| 18212 | match all articles (like in the example above). This is not required in | ||
| 18213 | nnimap. Articles not matching any of the regexps will not be moved out | ||
| 18214 | of your inbox. (This might affect performance if you keep lots of | ||
| 18215 | unread articles in your inbox, since the splitting code would go over | ||
| 18216 | them every time you fetch new mail.) | ||
| 18217 | |||
| 18218 | These rules are processed from the beginning of the alist toward the | ||
| 18219 | end. The first rule to make a match will ``win'', unless you have | ||
| 18220 | crossposting enabled. In that case, all matching rules will ``win''. | ||
| 18221 | |||
| 18222 | This variable can also have a function as its value, the function will | ||
| 18223 | be called with the headers narrowed and should return a group where it | ||
| 18224 | thinks the article should be split to. See @code{nnimap-split-fancy}. | ||
| 18225 | |||
| 18226 | The splitting code tries to create mailboxes if it needs to. | ||
| 18227 | |||
| 18228 | To allow for different split rules on different virtual servers, and | ||
| 18229 | even different split rules in different inboxes on the same server, | ||
| 18230 | the syntax of this variable have been extended along the lines of: | ||
| 18231 | |||
| 18232 | @lisp | ||
| 18233 | (setq nnimap-split-rule | ||
| 18234 | '(("my1server" (".*" (("ding" "ding@@gnus.org") | ||
| 18235 | ("junk" "From:.*Simon")))) | ||
| 18236 | ("my2server" ("INBOX" nnimap-split-fancy)) | ||
| 18237 | ("my[34]server" (".*" (("private" "To:.*Simon") | ||
| 18238 | ("junk" my-junk-func)))))) | ||
| 18239 | @end lisp | ||
| 18240 | |||
| 18241 | The virtual server name is in fact a regexp, so that the same rules | ||
| 18242 | may apply to several servers. In the example, the servers | ||
| 18243 | @code{my3server} and @code{my4server} both use the same rules. | ||
| 18244 | Similarly, the inbox string is also a regexp. The actual splitting | ||
| 18245 | rules are as before, either a function, or a list with group/regexp or | ||
| 18246 | group/function elements. | ||
| 18247 | |||
| 18248 | Nnmail equivalent: @code{nnmail-split-methods}. | ||
| 18249 | |||
| 18250 | @item nnimap-split-predicate | ||
| 18251 | @cindex splitting | ||
| 18252 | @vindex nnimap-split-predicate | ||
| 18253 | |||
| 18254 | Mail matching this predicate in @code{nnimap-split-inbox} will be | ||
| 18255 | split, it is a string and the default is @samp{UNSEEN UNDELETED}. | ||
| 18256 | |||
| 18257 | This might be useful if you use another @acronym{IMAP} client to read mail in | ||
| 18258 | your inbox but would like Gnus to split all articles in the inbox | ||
| 18259 | regardless of readedness. Then you might change this to | ||
| 18260 | @samp{UNDELETED}. | ||
| 18261 | |||
| 18262 | @item nnimap-split-fancy | ||
| 18263 | @cindex splitting, fancy | ||
| 18264 | @findex nnimap-split-fancy | ||
| 18265 | @vindex nnimap-split-fancy | ||
| 18266 | |||
| 18267 | It's possible to set @code{nnimap-split-rule} to | ||
| 18268 | @code{nnmail-split-fancy} if you want to use fancy | ||
| 18269 | splitting. @xref{Fancy Mail Splitting}. | ||
| 18270 | |||
| 18271 | However, to be able to have different fancy split rules for nnmail and | ||
| 18272 | nnimap back ends you can set @code{nnimap-split-rule} to | ||
| 18273 | @code{nnimap-split-fancy} and define the nnimap specific fancy split | ||
| 18274 | rule in @code{nnimap-split-fancy}. | ||
| 18275 | |||
| 18276 | Example: | ||
| 18277 | |||
| 18278 | @lisp | ||
| 18279 | (setq nnimap-split-rule 'nnimap-split-fancy | ||
| 18280 | nnimap-split-fancy ...) | ||
| 18281 | @end lisp | ||
| 18282 | |||
| 18283 | Nnmail equivalent: @code{nnmail-split-fancy}. | ||
| 18284 | |||
| 18285 | @item nnimap-split-download-body | ||
| 18286 | @findex nnimap-split-download-body | ||
| 18287 | @vindex nnimap-split-download-body | ||
| 18288 | |||
| 18289 | Set to non-@code{nil} to download entire articles during splitting. | ||
| 18290 | This is generally not required, and will slow things down | ||
| 18291 | considerably. You may need it if you want to use an advanced | ||
| 18292 | splitting function that analyzes the body to split the article. | ||
| 18293 | |||
| 18294 | @end table | ||
| 18295 | |||
| 18296 | @node Expiring in IMAP | ||
| 18297 | @subsection Expiring in IMAP | ||
| 18298 | @cindex expiring @acronym{IMAP} mail | ||
| 18299 | |||
| 18300 | Even though @code{nnimap} is not a proper @code{nnmail} derived back | ||
| 18301 | end, it supports most features in regular expiring (@pxref{Expiring | ||
| 18302 | Mail}). Unlike splitting in @acronym{IMAP} (@pxref{Splitting in | ||
| 18303 | IMAP}) it does not clone the @code{nnmail} variables (i.e., creating | ||
| 18304 | @var{nnimap-expiry-wait}) but reuse the @code{nnmail} variables. What | ||
| 18305 | follows below are the variables used by the @code{nnimap} expiry | ||
| 18306 | process. | ||
| 18307 | |||
| 18308 | A note on how the expire mark is stored on the @acronym{IMAP} server is | ||
| 18309 | appropriate here as well. The expire mark is translated into a | ||
| 18310 | @code{imap} client specific mark, @code{gnus-expire}, and stored on the | ||
| 18311 | message. This means that likely only Gnus will understand and treat | ||
| 18312 | the @code{gnus-expire} mark properly, although other clients may allow | ||
| 18313 | you to view client specific flags on the message. It also means that | ||
| 18314 | your server must support permanent storage of client specific flags on | ||
| 18315 | messages. Most do, fortunately. | ||
| 18316 | |||
| 18317 | If expiring @acronym{IMAP} mail seems very slow, try setting the server | ||
| 18318 | variable @code{nnimap-search-uids-not-since-is-evil}. | ||
| 18319 | |||
| 18320 | @table @code | ||
| 18321 | |||
| 18322 | @item nnmail-expiry-wait | ||
| 18323 | @item nnmail-expiry-wait-function | ||
| 18324 | |||
| 18325 | These variables are fully supported. The expire value can be a | ||
| 18326 | number, the symbol @code{immediate} or @code{never}. | ||
| 18327 | |||
| 18328 | @item nnmail-expiry-target | ||
| 18329 | |||
| 18330 | This variable is supported, and internally implemented by calling the | ||
| 18331 | @code{nnmail} functions that handle this. It contains an optimization | ||
| 18332 | that if the destination is a @acronym{IMAP} group on the same server, the | ||
| 18333 | article is copied instead of appended (that is, uploaded again). | ||
| 18334 | |||
| 18335 | @end table | ||
| 18336 | |||
| 18337 | @node Editing IMAP ACLs | ||
| 18338 | @subsection Editing IMAP ACLs | ||
| 18339 | @cindex editing imap acls | ||
| 18340 | @cindex Access Control Lists | ||
| 18341 | @cindex Editing @acronym{IMAP} ACLs | ||
| 18342 | @kindex G l (Group) | ||
| 18343 | @findex gnus-group-nnimap-edit-acl | ||
| 18344 | |||
| 18345 | ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for | ||
| 18346 | limiting (or enabling) other users access to your mail boxes. Not all | ||
| 18347 | @acronym{IMAP} servers support this, this function will give an error if it | ||
| 18348 | doesn't. | ||
| 18349 | |||
| 18350 | To edit an ACL for a mailbox, type @kbd{G l} | ||
| 18351 | (@code{gnus-group-edit-nnimap-acl}) and you'll be presented with an ACL | ||
| 18352 | editing window with detailed instructions. | ||
| 18353 | |||
| 18354 | Some possible uses: | ||
| 18355 | |||
| 18356 | @itemize @bullet | ||
| 18357 | @item | ||
| 18358 | Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags) | ||
| 18359 | on your mailing list mailboxes enables other users on the same server to | ||
| 18360 | follow the list without subscribing to it. | ||
| 18361 | @item | ||
| 18362 | At least with the Cyrus server, you are required to give the user | ||
| 18363 | ``anyone'' posting ("p") capabilities to have ``plussing'' work (that is, | ||
| 18364 | mail sent to user+mailbox@@domain ending up in the @acronym{IMAP} mailbox | ||
| 18365 | INBOX.mailbox). | ||
| 18366 | @end itemize | ||
| 18367 | |||
| 18368 | @node Expunging mailboxes | ||
| 18369 | @subsection Expunging mailboxes | ||
| 18370 | @cindex expunging | ||
| 18371 | |||
| 18372 | @cindex expunge | ||
| 18373 | @cindex manual expunging | ||
| 18374 | @kindex G x (Group) | ||
| 18375 | @findex gnus-group-expunge-group | ||
| 18376 | |||
| 18377 | If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, | ||
| 18378 | you may want the option of expunging all deleted articles in a mailbox | ||
| 18379 | manually. This is exactly what @kbd{G x} does. | ||
| 18380 | |||
| 18381 | Currently there is no way of showing deleted articles, you can just | ||
| 18382 | delete them. | ||
| 18383 | |||
| 18384 | @node A note on namespaces | ||
| 18385 | @subsection A note on namespaces | ||
| 18386 | @cindex IMAP namespace | ||
| 18387 | @cindex namespaces | ||
| 18388 | |||
| 18389 | The @acronym{IMAP} protocol has a concept called namespaces, described | ||
| 18390 | by the following text in the RFC2060: | ||
| 18391 | |||
| 18392 | @display | ||
| 18393 | 5.1.2. Mailbox Namespace Naming Convention | ||
| 18394 | |||
| 18395 | By convention, the first hierarchical element of any mailbox name | ||
| 18396 | which begins with "#" identifies the "namespace" of the remainder of | ||
| 18397 | the name. This makes it possible to disambiguate between different | ||
| 18398 | types of mailbox stores, each of which have their own namespaces. | ||
| 18399 | |||
| 18400 | For example, implementations which offer access to USENET | ||
| 18401 | newsgroups MAY use the "#news" namespace to partition the USENET | ||
| 18402 | newsgroup namespace from that of other mailboxes. Thus, the | ||
| 18403 | comp.mail.misc newsgroup would have an mailbox name of | ||
| 18404 | "#news.comp.mail.misc", and the name "comp.mail.misc" could refer | ||
| 18405 | to a different object (e.g. a user's private mailbox). | ||
| 18406 | @end display | ||
| 18407 | |||
| 18408 | While there is nothing in this text that warrants concern for the | ||
| 18409 | @acronym{IMAP} implementation in Gnus, some servers use namespace | ||
| 18410 | prefixes in a way that does not work with how Gnus uses mailbox names. | ||
| 18411 | |||
| 18412 | Specifically, University of Washington's @acronym{IMAP} server uses | ||
| 18413 | mailbox names like @code{#driver.mbx/read-mail} which are valid only | ||
| 18414 | in the @sc{create} and @sc{append} commands. After the mailbox is | ||
| 18415 | created (or a messages is appended to a mailbox), it must be accessed | ||
| 18416 | without the namespace prefix, i.e. @code{read-mail}. Since Gnus do | ||
| 18417 | not make it possible for the user to guarantee that user entered | ||
| 18418 | mailbox names will only be used with the CREATE and APPEND commands, | ||
| 18419 | you should simply not use the namespace prefixed mailbox names in | ||
| 18420 | Gnus. | ||
| 18421 | |||
| 18422 | See the UoW IMAPD documentation for the @code{#driver.*/} prefix | ||
| 18423 | for more information on how to use the prefixes. They are a power | ||
| 18424 | tool and should be used only if you are sure what the effects are. | ||
| 18425 | |||
| 18426 | @node Debugging IMAP | ||
| 18427 | @subsection Debugging IMAP | ||
| 18428 | @cindex IMAP debugging | ||
| 18429 | @cindex protocol dump (IMAP) | ||
| 18430 | |||
| 18431 | @acronym{IMAP} is a complex protocol, more so than @acronym{NNTP} or | ||
| 18432 | @acronym{POP3}. Implementation bugs are not unlikely, and we do our | ||
| 18433 | best to fix them right away. If you encounter odd behavior, chances | ||
| 18434 | are that either the server or Gnus is buggy. | ||
| 18435 | |||
| 18436 | If you are familiar with network protocols in general, you will | ||
| 18437 | probably be able to extract some clues from the protocol dump of the | ||
| 18438 | exchanges between Gnus and the server. Even if you are not familiar | ||
| 18439 | with network protocols, when you include the protocol dump in | ||
| 18440 | @acronym{IMAP}-related bug reports you are helping us with data | ||
| 18441 | critical to solving the problem. Therefore, we strongly encourage you | ||
| 18442 | to include the protocol dump when reporting IMAP bugs in Gnus. | ||
| 18443 | |||
| 18444 | |||
| 18445 | @vindex imap-log | ||
| 18446 | Because the protocol dump, when enabled, generates lots of data, it is | ||
| 18447 | disabled by default. You can enable it by setting @code{imap-log} as | ||
| 18448 | follows: | ||
| 18449 | |||
| 18450 | @lisp | ||
| 18451 | (setq imap-log t) | ||
| 18452 | @end lisp | ||
| 18453 | |||
| 18454 | This instructs the @code{imap.el} package to log any exchanges with | ||
| 18455 | the server. The log is stored in the buffer @samp{*imap-log*}. Look | ||
| 18456 | for error messages, which sometimes are tagged with the keyword | ||
| 18457 | @code{BAD}---but when submitting a bug, make sure to include all the | ||
| 18458 | data. | ||
| 18459 | |||
| 18460 | @node Other Sources | 17822 | @node Other Sources |
| 18461 | @section Other Sources | 17823 | @section Other Sources |
| 18462 | 17824 | ||
| @@ -22369,7 +21731,6 @@ four days, Gnus will decay the scores four times, for instance. | |||
| 22369 | * Highlighting and Menus:: Making buffers look all nice and cozy. | 21731 | * Highlighting and Menus:: Making buffers look all nice and cozy. |
| 22370 | * Buttons:: Get tendinitis in ten easy steps! | 21732 | * Buttons:: Get tendinitis in ten easy steps! |
| 22371 | * Daemons:: Gnus can do things behind your back. | 21733 | * Daemons:: Gnus can do things behind your back. |
| 22372 | * NoCeM:: How to avoid spam and other fatty foods. | ||
| 22373 | * Undo:: Some actions can be undone. | 21734 | * Undo:: Some actions can be undone. |
| 22374 | * Predicate Specifiers:: Specifying predicates. | 21735 | * Predicate Specifiers:: Specifying predicates. |
| 22375 | * Moderation:: What to do if you're a moderator. | 21736 | * Moderation:: What to do if you're a moderator. |
| @@ -23388,13 +22749,12 @@ your @file{~/.gnus.el} file: | |||
| 23388 | (gnus-demon-add-handler 'gnus-demon-close-connections 30 t) | 22749 | (gnus-demon-add-handler 'gnus-demon-close-connections 30 t) |
| 23389 | @end lisp | 22750 | @end lisp |
| 23390 | 22751 | ||
| 23391 | @findex gnus-demon-add-nocem | ||
| 23392 | @findex gnus-demon-add-scanmail | 22752 | @findex gnus-demon-add-scanmail |
| 23393 | @findex gnus-demon-add-rescan | 22753 | @findex gnus-demon-add-rescan |
| 23394 | @findex gnus-demon-add-scan-timestamps | 22754 | @findex gnus-demon-add-scan-timestamps |
| 23395 | @findex gnus-demon-add-disconnection | 22755 | @findex gnus-demon-add-disconnection |
| 23396 | Some ready-made functions to do this have been created: | 22756 | Some ready-made functions to do this have been created: |
| 23397 | @code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection}, | 22757 | @code{gnus-demon-add-disconnection}, |
| 23398 | @code{gnus-demon-add-nntp-close-connection}, | 22758 | @code{gnus-demon-add-nntp-close-connection}, |
| 23399 | @code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and | 22759 | @code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and |
| 23400 | @code{gnus-demon-add-scanmail}. Just put those functions in your | 22760 | @code{gnus-demon-add-scanmail}. Just put those functions in your |
| @@ -23413,152 +22773,6 @@ is a sure-fire way of getting booted off any respectable system. So | |||
| 23413 | behave. | 22773 | behave. |
| 23414 | 22774 | ||
| 23415 | 22775 | ||
| 23416 | @node NoCeM | ||
| 23417 | @section NoCeM | ||
| 23418 | @cindex nocem | ||
| 23419 | @cindex spam | ||
| 23420 | |||
| 23421 | @dfn{Spamming} is posting the same article lots and lots of times. | ||
| 23422 | Spamming is bad. Spamming is evil. | ||
| 23423 | |||
| 23424 | Spamming is usually canceled within a day or so by various anti-spamming | ||
| 23425 | agencies. These agencies usually also send out @dfn{NoCeM} messages. | ||
| 23426 | NoCeM is pronounced ``no see-'em'', and means what the name | ||
| 23427 | implies---these are messages that make the offending articles, like, go | ||
| 23428 | away. | ||
| 23429 | |||
| 23430 | What use are these NoCeM messages if the articles are canceled anyway? | ||
| 23431 | Some sites do not honor cancel messages and some sites just honor cancels | ||
| 23432 | from a select few people. Then you may wish to make use of the NoCeM | ||
| 23433 | messages, which are distributed in the newsgroups | ||
| 23434 | @samp{news.lists.filters}, @samp{alt.nocem.misc}, etc. | ||
| 23435 | |||
| 23436 | Gnus can read and parse the messages in this group automatically, and | ||
| 23437 | this will make spam disappear. | ||
| 23438 | |||
| 23439 | There are some variables to customize, of course: | ||
| 23440 | |||
| 23441 | @table @code | ||
| 23442 | @item gnus-use-nocem | ||
| 23443 | @vindex gnus-use-nocem | ||
| 23444 | Set this variable to @code{t} to set the ball rolling. It is @code{nil} | ||
| 23445 | by default. | ||
| 23446 | |||
| 23447 | You can also set this variable to a positive number as a group level. | ||
| 23448 | In that case, Gnus scans NoCeM messages when checking new news if this | ||
| 23449 | value is not exceeding a group level that you specify as the prefix | ||
| 23450 | argument to some commands, e.g. @code{gnus}, | ||
| 23451 | @code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan | ||
| 23452 | NoCeM messages if you specify a group level that is smaller than this | ||
| 23453 | value to those commands. For example, if you use 1 or 2 on the mail | ||
| 23454 | groups and the levels on the news groups remain the default, 3 is the | ||
| 23455 | best choice. | ||
| 23456 | |||
| 23457 | @item gnus-nocem-groups | ||
| 23458 | @vindex gnus-nocem-groups | ||
| 23459 | Gnus will look for NoCeM messages in the groups in this list. The | ||
| 23460 | default is | ||
| 23461 | @lisp | ||
| 23462 | ("news.lists.filters" "alt.nocem.misc") | ||
| 23463 | @end lisp | ||
| 23464 | |||
| 23465 | @item gnus-nocem-issuers | ||
| 23466 | @vindex gnus-nocem-issuers | ||
| 23467 | There are many people issuing NoCeM messages. This list says what | ||
| 23468 | people you want to listen to. The default is: | ||
| 23469 | |||
| 23470 | @lisp | ||
| 23471 | ("Adri Verhoef" | ||
| 23472 | "alba-nocem@@albasani.net" | ||
| 23473 | "bleachbot@@httrack.com" | ||
| 23474 | "news@@arcor-online.net" | ||
| 23475 | "news@@uni-berlin.de" | ||
| 23476 | "nocem@@arcor.de" | ||
| 23477 | "pgpmoose@@killfile.org" | ||
| 23478 | "xjsppl@@gmx.de") | ||
| 23479 | @end lisp | ||
| 23480 | |||
| 23481 | Known despammers that you can put in this list are listed at@* | ||
| 23482 | @uref{http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html}. | ||
| 23483 | |||
| 23484 | You do not have to heed NoCeM messages from all these people---just the | ||
| 23485 | ones you want to listen to. You also don't have to accept all NoCeM | ||
| 23486 | messages from the people you like. Each NoCeM message has a @dfn{type} | ||
| 23487 | header that gives the message a (more or less, usually less) rigorous | ||
| 23488 | definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf}, | ||
| 23489 | @samp{binary}, and @samp{troll}. To specify this, you have to use | ||
| 23490 | @code{(@var{issuer} @var{conditions} @dots{})} elements in the list. | ||
| 23491 | Each condition is either a string (which is a regexp that matches types | ||
| 23492 | you want to use) or a list on the form @code{(not @var{string})}, where | ||
| 23493 | @var{string} is a regexp that matches types you don't want to use. | ||
| 23494 | |||
| 23495 | For instance, if you want all NoCeM messages from Chris Lewis except his | ||
| 23496 | @samp{troll} messages, you'd say: | ||
| 23497 | |||
| 23498 | @lisp | ||
| 23499 | ("clewis@@ferret.ocunix.on.ca" ".*" (not "troll")) | ||
| 23500 | @end lisp | ||
| 23501 | |||
| 23502 | On the other hand, if you just want nothing but his @samp{spam} and | ||
| 23503 | @samp{spew} messages, you'd say: | ||
| 23504 | |||
| 23505 | @lisp | ||
| 23506 | ("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam") | ||
| 23507 | @end lisp | ||
| 23508 | |||
| 23509 | The specs are applied left-to-right. | ||
| 23510 | |||
| 23511 | |||
| 23512 | @item gnus-nocem-verifyer | ||
| 23513 | @vindex gnus-nocem-verifyer | ||
| 23514 | @findex gnus-nocem-epg-verify | ||
| 23515 | @findex pgg-verify | ||
| 23516 | This should be a function for verifying that the NoCeM issuer is who she | ||
| 23517 | says she is. This variable defaults to @code{gnus-nocem-epg-verify} if | ||
| 23518 | EasyPG is available, otherwise defaults to @code{pgg-verify}. The | ||
| 23519 | function should return non-@code{nil} if the verification is successful, | ||
| 23520 | otherwise (including the case the NoCeM message was not signed) should | ||
| 23521 | return @code{nil}. If this is too slow and you don't care for | ||
| 23522 | verification (which may be dangerous), you can set this variable to | ||
| 23523 | @code{nil}. | ||
| 23524 | |||
| 23525 | Formerly the default was @code{mc-verify}, which is a Mailcrypt | ||
| 23526 | function. While you can still use it, you can change it into | ||
| 23527 | @code{gnus-nocem-epg-verify} or @code{pgg-verify} running with GnuPG if | ||
| 23528 | you are willing to add the @acronym{PGP} public keys to GnuPG's keyring. | ||
| 23529 | |||
| 23530 | @item gnus-nocem-directory | ||
| 23531 | @vindex gnus-nocem-directory | ||
| 23532 | This is where Gnus will store its NoCeM cache files. The default is@* | ||
| 23533 | @file{~/News/NoCeM/}. | ||
| 23534 | |||
| 23535 | @item gnus-nocem-expiry-wait | ||
| 23536 | @vindex gnus-nocem-expiry-wait | ||
| 23537 | The number of days before removing old NoCeM entries from the cache. | ||
| 23538 | The default is 15. If you make it shorter Gnus will be faster, but you | ||
| 23539 | might then see old spam. | ||
| 23540 | |||
| 23541 | @item gnus-nocem-check-from | ||
| 23542 | @vindex gnus-nocem-check-from | ||
| 23543 | Non-@code{nil} means check for valid issuers in message bodies. | ||
| 23544 | Otherwise don't bother fetching articles unless their author matches a | ||
| 23545 | valid issuer; that is much faster if you are selective about the | ||
| 23546 | issuers. | ||
| 23547 | |||
| 23548 | @item gnus-nocem-check-article-limit | ||
| 23549 | @vindex gnus-nocem-check-article-limit | ||
| 23550 | If non-@code{nil}, the maximum number of articles to check in any NoCeM | ||
| 23551 | group. @code{nil} means no restriction. NoCeM groups can be huge and | ||
| 23552 | very slow to process. | ||
| 23553 | |||
| 23554 | @end table | ||
| 23555 | |||
| 23556 | Using NoCeM could potentially be a memory hog. If you have many living | ||
| 23557 | (i. e., subscribed or unsubscribed groups), your Emacs process will grow | ||
| 23558 | big. If this is a problem, you should kill off all (or most) of your | ||
| 23559 | unsubscribed groups (@pxref{Subscription Commands}). | ||
| 23560 | |||
| 23561 | |||
| 23562 | @node Undo | 22776 | @node Undo |
| 23563 | @section Undo | 22777 | @section Undo |
| 23564 | @cindex undo | 22778 | @cindex undo |
| @@ -24398,7 +23612,7 @@ call the external tools during splitting. Example fancy split method: | |||
| 24398 | Note that with the nnimap back end, message bodies will not be | 23612 | Note that with the nnimap back end, message bodies will not be |
| 24399 | downloaded by default. You need to set | 23613 | downloaded by default. You need to set |
| 24400 | @code{nnimap-split-download-body} to @code{t} to do that | 23614 | @code{nnimap-split-download-body} to @code{t} to do that |
| 24401 | (@pxref{Splitting in IMAP}). | 23615 | (@pxref{Client-Side @acronym{IMAP} Splitting}). |
| 24402 | 23616 | ||
| 24403 | That is about it. As some spam is likely to get through anyway, you | 23617 | That is about it. As some spam is likely to get through anyway, you |
| 24404 | might want to have a nifty function to call when you happen to read | 23618 | might want to have a nifty function to call when you happen to read |
| @@ -24680,14 +23894,14 @@ the value @samp{spam} means @samp{nnimap+your-server:spam}. The value | |||
| 24680 | @vindex nnimap-split-download-body | 23894 | @vindex nnimap-split-download-body |
| 24681 | Note for IMAP users: if you use the @code{spam-check-bogofilter}, | 23895 | Note for IMAP users: if you use the @code{spam-check-bogofilter}, |
| 24682 | @code{spam-check-ifile}, and @code{spam-check-stat} spam back ends, | 23896 | @code{spam-check-ifile}, and @code{spam-check-stat} spam back ends, |
| 24683 | you should also set the variable @code{nnimap-split-download-body} | 23897 | you should also set the variable @code{nnimap-split-download-body} to |
| 24684 | to @code{t}. These spam back ends are most useful when they can | 23898 | @code{t}. These spam back ends are most useful when they can ``scan'' |
| 24685 | ``scan'' the full message body. By default, the nnimap back end only | 23899 | the full message body. By default, the nnimap back end only retrieves |
| 24686 | retrieves the message headers; @code{nnimap-split-download-body} tells | 23900 | the message headers; @code{nnimap-split-download-body} tells it to |
| 24687 | it to retrieve the message bodies as well. We don't set this by | 23901 | retrieve the message bodies as well. We don't set this by default |
| 24688 | default because it will slow @acronym{IMAP} down, and that is not an | 23902 | because it will slow @acronym{IMAP} down, and that is not an |
| 24689 | appropriate decision to make on behalf of the user. @xref{Splitting | 23903 | appropriate decision to make on behalf of the user. @xref{Client-Side |
| 24690 | in IMAP}. | 23904 | @acronym{IMAP} Splitting}. |
| 24691 | 23905 | ||
| 24692 | You have to specify one or more spam back ends for @code{spam-split} | 23906 | You have to specify one or more spam back ends for @code{spam-split} |
| 24693 | to use, by setting the @code{spam-use-*} variables. @xref{Spam Back | 23907 | to use, by setting the @code{spam-use-*} variables. @xref{Spam Back |
| @@ -27604,13 +26818,6 @@ Mail can be re-scanned by a daemonic process (@pxref{Daemons}). | |||
| 27604 | @end iftex | 26818 | @end iftex |
| 27605 | 26819 | ||
| 27606 | @item | 26820 | @item |
| 27607 | Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}). | ||
| 27608 | |||
| 27609 | @lisp | ||
| 27610 | (setq gnus-use-nocem t) | ||
| 27611 | @end lisp | ||
| 27612 | |||
| 27613 | @item | ||
| 27614 | Groups can be made permanently visible (@pxref{Listing Groups}). | 26821 | Groups can be made permanently visible (@pxref{Listing Groups}). |
| 27615 | 26822 | ||
| 27616 | @lisp | 26823 | @lisp |
diff --git a/lisp/gnus/earcon.el b/lisp/gnus/earcon.el deleted file mode 100644 index 2086f86c417..00000000000 --- a/lisp/gnus/earcon.el +++ /dev/null | |||
| @@ -1,230 +0,0 @@ | |||
| 1 | ;;; earcon.el --- Sound effects for messages | ||
| 2 | |||
| 3 | ;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Steven L. Baur <steve@miranova.com> | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | ;; This file provides access to sound effects in Gnus. | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile (require 'cl)) | ||
| 29 | (require 'gnus) | ||
| 30 | (require 'gnus-audio) | ||
| 31 | (require 'gnus-art) | ||
| 32 | |||
| 33 | (defgroup earcon nil | ||
| 34 | "Turn ** sounds ** into noise." | ||
| 35 | :group 'gnus-visual) | ||
| 36 | |||
| 37 | (defcustom earcon-prefix "**" | ||
| 38 | "*String denoting the start of an earcon." | ||
| 39 | :type 'string | ||
| 40 | :group 'earcon) | ||
| 41 | |||
| 42 | (defcustom earcon-suffix "**" | ||
| 43 | "String denoting the end of an earcon." | ||
| 44 | :type 'string | ||
| 45 | :group 'earcon) | ||
| 46 | |||
| 47 | (defcustom earcon-regexp-alist | ||
| 48 | '(("boring" 1 "Boring.au") | ||
| 49 | ("evil[ \t]+laugh" 1 "Evil_Laugh.au") | ||
| 50 | ("gag\\|puke" 1 "Puke.au") | ||
| 51 | ("snicker" 1 "Snicker.au") | ||
| 52 | ("meow" 1 "catmeow.wav") | ||
| 53 | ("sob\\|boohoo" 1 "cry.wav") | ||
| 54 | ("drum[ \t]*roll" 1 "drumroll.au") | ||
| 55 | ("blast" 1 "explosion.au") | ||
| 56 | ("flush\\|plonk!*" 1 "flush.au") | ||
| 57 | ("kiss" 1 "kiss.wav") | ||
| 58 | ("tee[ \t]*hee" 1 "laugh.au") | ||
| 59 | ("shoot" 1 "shotgun.wav") | ||
| 60 | ("yawn" 1 "snore.wav") | ||
| 61 | ("cackle" 1 "witch.au") | ||
| 62 | ("yell\\|roar" 1 "yell2.au") | ||
| 63 | ("whoop-de-doo" 1 "whistle.au")) | ||
| 64 | "*A list of regexps to map earcons to real sounds." | ||
| 65 | :type '(repeat (list regexp | ||
| 66 | (integer :tag "Match") | ||
| 67 | (string :tag "Sound"))) | ||
| 68 | :group 'earcon) | ||
| 69 | (defvar earcon-button-marker-list nil) | ||
| 70 | (make-variable-buffer-local 'earcon-button-marker-list) | ||
| 71 | |||
| 72 | ;;; FIXME!! clone of code from gnus-vis.el FIXME!! | ||
| 73 | (defun earcon-article-push-button (event) | ||
| 74 | "Check text under the mouse pointer for a callback function. | ||
| 75 | If the text under the mouse pointer has a `earcon-callback' property, | ||
| 76 | call it with the value of the `earcon-data' text property." | ||
| 77 | (interactive "e") | ||
| 78 | (set-buffer (window-buffer (posn-window (event-start event)))) | ||
| 79 | (let* ((pos (posn-point (event-start event))) | ||
| 80 | (data (get-text-property pos 'earcon-data)) | ||
| 81 | (fun (get-text-property pos 'earcon-callback))) | ||
| 82 | (if fun (funcall fun data)))) | ||
| 83 | |||
| 84 | (defun earcon-article-press-button () | ||
| 85 | "Check text at point for a callback function. | ||
| 86 | If the text at point has a `earcon-callback' property, | ||
| 87 | call it with the value of the `earcon-data' text property." | ||
| 88 | (interactive) | ||
| 89 | (let* ((data (get-text-property (point) 'earcon-data)) | ||
| 90 | (fun (get-text-property (point) 'earcon-callback))) | ||
| 91 | (if fun (funcall fun data)))) | ||
| 92 | |||
| 93 | (defun earcon-article-prev-button (n) | ||
| 94 | "Move point to N buttons backward. | ||
| 95 | If N is negative, move forward instead." | ||
| 96 | (interactive "p") | ||
| 97 | (earcon-article-next-button (- n))) | ||
| 98 | |||
| 99 | (defun earcon-article-next-button (n) | ||
| 100 | "Move point to N buttons forward. | ||
| 101 | If N is negative, move backward instead." | ||
| 102 | (interactive "p") | ||
| 103 | (let ((function (if (< n 0) 'previous-single-property-change | ||
| 104 | 'next-single-property-change)) | ||
| 105 | (inhibit-point-motion-hooks t) | ||
| 106 | (backward (< n 0)) | ||
| 107 | (limit (if (< n 0) (point-min) (point-max)))) | ||
| 108 | (setq n (abs n)) | ||
| 109 | (while (and (not (= limit (point))) | ||
| 110 | (> n 0)) | ||
| 111 | ;; Skip past the current button. | ||
| 112 | (when (get-text-property (point) 'earcon-callback) | ||
| 113 | (goto-char (funcall function (point) 'earcon-callback nil limit))) | ||
| 114 | ;; Go to the next (or previous) button. | ||
| 115 | (gnus-goto-char (funcall function (point) 'earcon-callback nil limit)) | ||
| 116 | ;; Put point at the start of the button. | ||
| 117 | (when (and backward (not (get-text-property (point) 'earcon-callback))) | ||
| 118 | (goto-char (funcall function (point) 'earcon-callback nil limit))) | ||
| 119 | ;; Skip past intangible buttons. | ||
| 120 | (when (get-text-property (point) 'intangible) | ||
| 121 | (incf n)) | ||
| 122 | (decf n)) | ||
| 123 | (unless (zerop n) | ||
| 124 | (gnus-message 5 "No more buttons")) | ||
| 125 | n)) | ||
| 126 | |||
| 127 | (defun earcon-article-add-button (from to fun &optional data) | ||
| 128 | "Create a button between FROM and TO with callback FUN and data DATA." | ||
| 129 | (and (boundp gnus-article-button-face) | ||
| 130 | gnus-article-button-face | ||
| 131 | (gnus-overlay-put (gnus-make-overlay from to) | ||
| 132 | 'face gnus-article-button-face)) | ||
| 133 | (gnus-add-text-properties | ||
| 134 | from to | ||
| 135 | (nconc (and gnus-article-mouse-face | ||
| 136 | (list gnus-mouse-face-prop gnus-article-mouse-face)) | ||
| 137 | (list 'gnus-callback fun) | ||
| 138 | (and data (list 'gnus-data data))))) | ||
| 139 | |||
| 140 | (defun earcon-button-entry () | ||
| 141 | ;; Return the first entry in `gnus-button-alist' matching this place. | ||
| 142 | (let ((alist earcon-regexp-alist) | ||
| 143 | (case-fold-search t) | ||
| 144 | (entry nil)) | ||
| 145 | (while alist | ||
| 146 | (setq entry (pop alist)) | ||
| 147 | (if (looking-at (car entry)) | ||
| 148 | (setq alist nil) | ||
| 149 | (setq entry nil))) | ||
| 150 | entry)) | ||
| 151 | |||
| 152 | (defun earcon-button-push (marker) | ||
| 153 | ;; Push button starting at MARKER. | ||
| 154 | (with-current-buffer gnus-article-buffer | ||
| 155 | (goto-char marker) | ||
| 156 | (let* ((entry (earcon-button-entry)) | ||
| 157 | (inhibit-point-motion-hooks t) | ||
| 158 | (fun 'gnus-audio-play) | ||
| 159 | (args (list (nth 2 entry)))) | ||
| 160 | (cond | ||
| 161 | ((fboundp fun) | ||
| 162 | (apply fun args)) | ||
| 163 | ((and (boundp fun) | ||
| 164 | (fboundp (symbol-value fun))) | ||
| 165 | (apply (symbol-value fun) args)) | ||
| 166 | (t | ||
| 167 | (gnus-message 1 "You must define `%S' to use this button" | ||
| 168 | (cons fun args))))))) | ||
| 169 | |||
| 170 | ;;; FIXME!! clone of code from gnus-vis.el FIXME!! | ||
| 171 | |||
| 172 | ;;;###interactive | ||
| 173 | (defun earcon-region (beg end) | ||
| 174 | "Play Sounds in the region between point and mark." | ||
| 175 | (interactive "r") | ||
| 176 | (earcon-buffer (current-buffer) beg end)) | ||
| 177 | |||
| 178 | ;;;###interactive | ||
| 179 | (defun earcon-buffer (&optional buffer st nd) | ||
| 180 | (interactive) | ||
| 181 | (save-excursion | ||
| 182 | ;; clear old markers. | ||
| 183 | (if (boundp 'earcon-button-marker-list) | ||
| 184 | (while earcon-button-marker-list | ||
| 185 | (set-marker (pop earcon-button-marker-list) nil)) | ||
| 186 | (setq earcon-button-marker-list nil)) | ||
| 187 | (and buffer (set-buffer buffer)) | ||
| 188 | (let ((buffer-read-only nil) | ||
| 189 | (inhibit-point-motion-hooks t) | ||
| 190 | (case-fold-search t) | ||
| 191 | (alist earcon-regexp-alist) | ||
| 192 | beg entry regexp) | ||
| 193 | (goto-char (point-min)) | ||
| 194 | (setq beg (point)) | ||
| 195 | (while (setq entry (pop alist)) | ||
| 196 | (setq regexp (concat (regexp-quote earcon-prefix) | ||
| 197 | ".*\\(" | ||
| 198 | (car entry) | ||
| 199 | "\\).*" | ||
| 200 | (regexp-quote earcon-suffix))) | ||
| 201 | (goto-char beg) | ||
| 202 | (while (re-search-forward regexp nil t) | ||
| 203 | (let* ((start (and entry (match-beginning 1))) | ||
| 204 | (end (and entry (match-end 1))) | ||
| 205 | (from (match-beginning 1))) | ||
| 206 | (earcon-article-add-button | ||
| 207 | start end 'earcon-button-push | ||
| 208 | (car (push (set-marker (make-marker) from) | ||
| 209 | earcon-button-marker-list))) | ||
| 210 | (gnus-audio-play (caddr entry)))))))) | ||
| 211 | |||
| 212 | ;;;###autoload | ||
| 213 | (defun gnus-earcon-display () | ||
| 214 | "Play sounds in message buffers." | ||
| 215 | (interactive) | ||
| 216 | (with-current-buffer gnus-article-buffer | ||
| 217 | (goto-char (point-min)) | ||
| 218 | ;; Skip headers | ||
| 219 | (unless (search-forward "\n\n" nil t) | ||
| 220 | (goto-char (point-max))) | ||
| 221 | (sit-for 0) | ||
| 222 | (earcon-buffer (current-buffer) (point)))) | ||
| 223 | |||
| 224 | ;;;*** | ||
| 225 | |||
| 226 | (provide 'earcon) | ||
| 227 | |||
| 228 | (run-hooks 'earcon-load-hook) | ||
| 229 | |||
| 230 | ;;; earcon.el ends here | ||
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index fd6957d9aac..8a0f0a3c388 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -257,6 +257,22 @@ This can also be a list of the above values." | |||
| 257 | (regexp :value ".*")) | 257 | (regexp :value ".*")) |
| 258 | :group 'gnus-article-signature) | 258 | :group 'gnus-article-signature) |
| 259 | 259 | ||
| 260 | (defcustom gnus-fetch-partial-articles nil | ||
| 261 | "If non-nil, Gnus will fetch partial articles. | ||
| 262 | If t, nnimap will fetch only the first part. If a string, it | ||
| 263 | will fetch all parts that have types that match that string. A | ||
| 264 | likely value would be \"text/\" to automatically fetch all | ||
| 265 | textual parts. | ||
| 266 | |||
| 267 | Currently only the nnimap backend actually supports partial | ||
| 268 | article fetching. If the backend doesn't support it, it has no | ||
| 269 | effect." | ||
| 270 | :version "24.1" | ||
| 271 | :type '(choice (const nil) | ||
| 272 | (const t) | ||
| 273 | (regexp)) | ||
| 274 | :group 'gnus-article) | ||
| 275 | |||
| 260 | (defcustom gnus-hidden-properties '(invisible t intangible t) | 276 | (defcustom gnus-hidden-properties '(invisible t intangible t) |
| 261 | "Property list to use for hiding text." | 277 | "Property list to use for hiding text." |
| 262 | :type 'sexp | 278 | :type 'sexp |
| @@ -1598,15 +1614,6 @@ predicate. See Info node `(gnus)Customizing Articles'." | |||
| 1598 | :link '(custom-manual "(gnus)Customizing Articles") | 1614 | :link '(custom-manual "(gnus)Customizing Articles") |
| 1599 | :type gnus-article-treat-custom) | 1615 | :type gnus-article-treat-custom) |
| 1600 | 1616 | ||
| 1601 | (defcustom gnus-treat-play-sounds nil | ||
| 1602 | "Play sounds. | ||
| 1603 | Valid values are nil, t, `head', `first', `last', an integer or a | ||
| 1604 | predicate. See Info node `(gnus)Customizing Articles'." | ||
| 1605 | :version "21.1" | ||
| 1606 | :group 'gnus-article-treat | ||
| 1607 | :link '(custom-manual "(gnus)Customizing Articles") | ||
| 1608 | :type gnus-article-treat-custom) | ||
| 1609 | |||
| 1610 | (defcustom gnus-treat-x-pgp-sig nil | 1617 | (defcustom gnus-treat-x-pgp-sig nil |
| 1611 | "Verify X-PGP-Sig. | 1618 | "Verify X-PGP-Sig. |
| 1612 | To automatically treat X-PGP-Sig, set it to head. | 1619 | To automatically treat X-PGP-Sig, set it to head. |
| @@ -1711,8 +1718,7 @@ This requires GNU Libidn, and by default only enabled if it is found." | |||
| 1711 | (gnus-treat-hide-citation gnus-article-hide-citation) | 1718 | (gnus-treat-hide-citation gnus-article-hide-citation) |
| 1712 | (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) | 1719 | (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) |
| 1713 | (gnus-treat-highlight-citation gnus-article-highlight-citation) | 1720 | (gnus-treat-highlight-citation gnus-article-highlight-citation) |
| 1714 | (gnus-treat-body-boundary gnus-article-treat-body-boundary) | 1721 | (gnus-treat-body-boundary gnus-article-treat-body-boundary))) |
| 1715 | (gnus-treat-play-sounds gnus-earcon-display))) | ||
| 1716 | 1722 | ||
| 1717 | (defvar gnus-article-mime-handle-alist nil) | 1723 | (defvar gnus-article-mime-handle-alist nil) |
| 1718 | (defvar article-lapsed-timer nil) | 1724 | (defvar article-lapsed-timer nil) |
| @@ -5075,7 +5081,10 @@ Deleting parts may malfunction or destroy the article; continue? ")) | |||
| 5075 | "|\n" | 5081 | "|\n" |
| 5076 | "| Type: " type "\n" | 5082 | "| Type: " type "\n" |
| 5077 | "| Filename: " filename "\n" | 5083 | "| Filename: " filename "\n" |
| 5078 | "| Size (encoded): " bsize " Byte\n" | 5084 | "| Size (encoded): " bsize (format " byte%s\n" |
| 5085 | (if (= bsize 1) | ||
| 5086 | "" | ||
| 5087 | "s")) | ||
| 5079 | (when description | 5088 | (when description |
| 5080 | (concat "| Description: " description "\n")) | 5089 | (concat "| Description: " description "\n")) |
| 5081 | "`----\n")) | 5090 | "`----\n")) |
| @@ -7030,9 +7039,7 @@ groups." | |||
| 7030 | (gnus-backlog-remove-article | 7039 | (gnus-backlog-remove-article |
| 7031 | (car gnus-article-current) (cdr gnus-article-current))) | 7040 | (car gnus-article-current) (cdr gnus-article-current))) |
| 7032 | ;; Flush original article as well. | 7041 | ;; Flush original article as well. |
| 7033 | (when (get-buffer gnus-original-article-buffer) | 7042 | (gnus-flush-original-article-buffer) |
| 7034 | (with-current-buffer gnus-original-article-buffer | ||
| 7035 | (setq gnus-original-article nil))) | ||
| 7036 | (when gnus-use-cache | 7043 | (when gnus-use-cache |
| 7037 | (gnus-cache-update-article | 7044 | (gnus-cache-update-article |
| 7038 | (car gnus-article-current) (cdr gnus-article-current))) | 7045 | (car gnus-article-current) (cdr gnus-article-current))) |
| @@ -7046,6 +7053,11 @@ groups." | |||
| 7046 | (set-window-point (get-buffer-window buf) (point))) | 7053 | (set-window-point (get-buffer-window buf) (point))) |
| 7047 | (gnus-summary-show-article)) | 7054 | (gnus-summary-show-article)) |
| 7048 | 7055 | ||
| 7056 | (defun gnus-flush-original-article-buffer () | ||
| 7057 | (when (get-buffer gnus-original-article-buffer) | ||
| 7058 | (with-current-buffer gnus-original-article-buffer | ||
| 7059 | (setq gnus-original-article nil)))) | ||
| 7060 | |||
| 7049 | (defun gnus-article-edit-exit () | 7061 | (defun gnus-article-edit-exit () |
| 7050 | "Exit the article editing without updating." | 7062 | "Exit the article editing without updating." |
| 7051 | (interactive) | 7063 | (interactive) |
| @@ -7134,46 +7146,6 @@ man page." | |||
| 7134 | (function :tag "Other")) | 7146 | (function :tag "Other")) |
| 7135 | :group 'gnus-article-buttons) | 7147 | :group 'gnus-article-buttons) |
| 7136 | 7148 | ||
| 7137 | (defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" | ||
| 7138 | "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. | ||
| 7139 | If the default site is too slow, try to find a CTAN mirror, see | ||
| 7140 | <URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also | ||
| 7141 | the variable `gnus-button-handle-ctan'." | ||
| 7142 | :version "22.1" | ||
| 7143 | :group 'gnus-article-buttons | ||
| 7144 | :link '(custom-manual "(gnus)Group Parameters") | ||
| 7145 | :type '(choice (const "http://www.tex.ac.uk/tex-archive/") | ||
| 7146 | (const "http://tug.ctan.org/tex-archive/") | ||
| 7147 | (const "http://www.dante.de/CTAN/") | ||
| 7148 | (string :tag "Other"))) | ||
| 7149 | |||
| 7150 | (defcustom gnus-button-ctan-handler 'browse-url | ||
| 7151 | "Function to use for displaying CTAN links. | ||
| 7152 | The function must take one argument, the string naming the URL." | ||
| 7153 | :version "22.1" | ||
| 7154 | :type '(choice (function-item :tag "Browse Url" browse-url) | ||
| 7155 | (function :tag "Other")) | ||
| 7156 | :group 'gnus-article-buttons) | ||
| 7157 | |||
| 7158 | (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" | ||
| 7159 | "Bogus strings removed from CTAN URLs." | ||
| 7160 | :version "22.1" | ||
| 7161 | :group 'gnus-article-buttons | ||
| 7162 | :type '(choice (const "^/?tex-archive/\\|/") | ||
| 7163 | (regexp :tag "Other"))) | ||
| 7164 | |||
| 7165 | (defcustom gnus-button-ctan-directory-regexp | ||
| 7166 | (regexp-opt | ||
| 7167 | (list "archive-tools" "biblio" "bibliography" "digests" "documentation" | ||
| 7168 | "dviware" "fonts" "graphics" "help" "indexing" "info" "language" | ||
| 7169 | "languages" "macros" "nonfree" "obsolete" "support" "systems" | ||
| 7170 | "tds" "tools" "usergrps" "web") t) | ||
| 7171 | "Regular expression for ctan directories. | ||
| 7172 | It should match all directories in the top level of `gnus-ctan-url'." | ||
| 7173 | :version "22.1" | ||
| 7174 | :group 'gnus-article-buttons | ||
| 7175 | :type 'regexp) | ||
| 7176 | |||
| 7177 | (defcustom gnus-button-mid-or-mail-regexp | 7149 | (defcustom gnus-button-mid-or-mail-regexp |
| 7178 | (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@" | 7150 | (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@" |
| 7179 | gnus-button-valid-fqdn-regexp | 7151 | gnus-button-valid-fqdn-regexp |
| @@ -7431,26 +7403,6 @@ Calls `describe-variable' or `describe-function'." | |||
| 7431 | (gnus-message 1 "Cannot locale library `%s'." url) | 7403 | (gnus-message 1 "Cannot locale library `%s'." url) |
| 7432 | (find-file-read-only file)))) | 7404 | (find-file-read-only file)))) |
| 7433 | 7405 | ||
| 7434 | (defun gnus-button-handle-ctan (url) | ||
| 7435 | "Call `browse-url' when pushing a CTAN URL button." | ||
| 7436 | (funcall | ||
| 7437 | gnus-button-ctan-handler | ||
| 7438 | (concat | ||
| 7439 | gnus-ctan-url | ||
| 7440 | (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) | ||
| 7441 | |||
| 7442 | (defcustom gnus-button-tex-level 5 | ||
| 7443 | "*Integer that says how many TeX-related buttons Gnus will show. | ||
| 7444 | The higher the number, the more buttons will appear and the more false | ||
| 7445 | positives are possible. Note that you can set this variable local to | ||
| 7446 | specific groups. Setting it higher in TeX groups is probably a good idea. | ||
| 7447 | See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on | ||
| 7448 | how to set variables in specific groups." | ||
| 7449 | :version "22.1" | ||
| 7450 | :group 'gnus-article-buttons | ||
| 7451 | :link '(custom-manual "(gnus)Group Parameters") | ||
| 7452 | :type 'integer) | ||
| 7453 | |||
| 7454 | (defcustom gnus-button-man-level 5 | 7406 | (defcustom gnus-button-man-level 5 |
| 7455 | "*Integer that says how many man-related buttons Gnus will show. | 7407 | "*Integer that says how many man-related buttons Gnus will show. |
| 7456 | The higher the number, the more buttons will appear and the more false | 7408 | The higher the number, the more buttons will appear and the more false |
| @@ -7517,20 +7469,6 @@ positives are possible." | |||
| 7517 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) | 7469 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
| 7518 | ("\\bmailto:\\([^ \n\t]+\\)" | 7470 | ("\\bmailto:\\([^ \n\t]+\\)" |
| 7519 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) | 7471 | 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
| 7520 | ;; CTAN | ||
| 7521 | ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" | ||
| 7522 | gnus-button-ctan-directory-regexp | ||
| 7523 | "[^][>)!;:,'\n\t ]+\\)") | ||
| 7524 | 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) | ||
| 7525 | ((concat "\\btex-archive/\\(" | ||
| 7526 | gnus-button-ctan-directory-regexp | ||
| 7527 | "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") | ||
| 7528 | 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) | ||
| 7529 | ((concat | ||
| 7530 | "\\b\\(" | ||
| 7531 | gnus-button-ctan-directory-regexp | ||
| 7532 | "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") | ||
| 7533 | 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) | ||
| 7534 | ;; Info Konqueror style <info:/foo/bar baz>. | 7472 | ;; Info Konqueror style <info:/foo/bar baz>. |
| 7535 | ;; Must come before " Gnus home-grown style". | 7473 | ;; Must come before " Gnus home-grown style". |
| 7536 | ("\\binfo://?\\([^'\">\n\t]+\\)" | 7474 | ("\\binfo://?\\([^'\">\n\t]+\\)" |
| @@ -8512,9 +8450,7 @@ For example: | |||
| 8512 | (when gnus-keep-backlog | 8450 | (when gnus-keep-backlog |
| 8513 | (gnus-backlog-remove-article | 8451 | (gnus-backlog-remove-article |
| 8514 | (car gnus-article-current) (cdr gnus-article-current))) | 8452 | (car gnus-article-current) (cdr gnus-article-current))) |
| 8515 | (when (get-buffer gnus-original-article-buffer) | 8453 | (gnus-flush-original-article-buffer) |
| 8516 | (with-current-buffer gnus-original-article-buffer | ||
| 8517 | (setq gnus-original-article nil))) | ||
| 8518 | (when gnus-use-cache | 8454 | (when gnus-use-cache |
| 8519 | (gnus-cache-update-article | 8455 | (gnus-cache-update-article |
| 8520 | (car gnus-article-current) (cdr gnus-article-current)))))))) | 8456 | (car gnus-article-current) (cdr gnus-article-current)))))))) |
diff --git a/lisp/gnus/gnus-audio.el b/lisp/gnus/gnus-audio.el deleted file mode 100644 index cc198176f10..00000000000 --- a/lisp/gnus/gnus-audio.el +++ /dev/null | |||
| @@ -1,149 +0,0 @@ | |||
| 1 | ;;; gnus-audio.el --- Sound effects for Gnus | ||
| 2 | |||
| 3 | ;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Steven L. Baur <steve@miranova.com> | ||
| 7 | ;; Keywords: news, mail, multimedia | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;; This file provides access to sound effects in Gnus. | ||
| 27 | ;; This file is partially stripped to support earcons.el. | ||
| 28 | |||
| 29 | ;;; Code: | ||
| 30 | |||
| 31 | (require 'nnheader) | ||
| 32 | |||
| 33 | (defgroup gnus-audio nil | ||
| 34 | "Playing sound in Gnus." | ||
| 35 | :version "21.1" | ||
| 36 | :group 'gnus-visual | ||
| 37 | :group 'multimedia) | ||
| 38 | |||
| 39 | (defvar gnus-audio-inline-sound | ||
| 40 | (or (if (fboundp 'device-sound-enabled-p) | ||
| 41 | (device-sound-enabled-p)) ; XEmacs | ||
| 42 | (fboundp 'play-sound)) ; Emacs | ||
| 43 | "Non-nil means try to play sounds without using an external program.") | ||
| 44 | |||
| 45 | (defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds") | ||
| 46 | "The directory containing the Sound Files." | ||
| 47 | :type '(choice directory (const nil)) | ||
| 48 | :group 'gnus-audio) | ||
| 49 | |||
| 50 | (defcustom gnus-audio-au-player (executable-find "play") | ||
| 51 | "Executable program for playing sun AU format sound files." | ||
| 52 | :group 'gnus-audio | ||
| 53 | :type '(choice file (const nil))) | ||
| 54 | |||
| 55 | (defcustom gnus-audio-wav-player (executable-find "play") | ||
| 56 | "Executable program for playing WAV files." | ||
| 57 | :group 'gnus-audio | ||
| 58 | :type '(choice file (const nil))) | ||
| 59 | |||
| 60 | ;;; The following isn't implemented yet. Wait for Millennium Gnus. | ||
| 61 | ;;(defvar gnus-audio-effects-enabled t | ||
| 62 | ;; "When t, Gnus will use sound effects.") | ||
| 63 | ;;(defvar gnus-audio-enable-hooks nil | ||
| 64 | ;; "Functions run when enabling sound effects.") | ||
| 65 | ;;(defvar gnus-audio-disable-hooks nil | ||
| 66 | ;; "Functions run when disabling sound effects.") | ||
| 67 | ;;(defvar gnus-audio-theme-song nil | ||
| 68 | ;; "Theme song for Gnus.") | ||
| 69 | ;;(defvar gnus-audio-enter-group nil | ||
| 70 | ;; "Sound effect played when selecting a group.") | ||
| 71 | ;;(defvar gnus-audio-exit-group nil | ||
| 72 | ;; "Sound effect played when exiting a group.") | ||
| 73 | ;;(defvar gnus-audio-score-group nil | ||
| 74 | ;; "Sound effect played when scoring a group.") | ||
| 75 | ;;(defvar gnus-audio-busy-sound nil | ||
| 76 | ;; "Sound effect played when going into a ... sequence.") | ||
| 77 | |||
| 78 | |||
| 79 | ;;;###autoload | ||
| 80 | ;;(defun gnus-audio-enable-sound () | ||
| 81 | ;; "Enable Sound Effects for Gnus." | ||
| 82 | ;; (interactive) | ||
| 83 | ;; (setq gnus-audio-effects-enabled t) | ||
| 84 | ;; (gnus-run-hooks gnus-audio-enable-hooks)) | ||
| 85 | |||
| 86 | ;;;###autoload | ||
| 87 | ;(defun gnus-audio-disable-sound () | ||
| 88 | ;; "Disable Sound Effects for Gnus." | ||
| 89 | ;; (interactive) | ||
| 90 | ;; (setq gnus-audio-effects-enabled nil) | ||
| 91 | ;; (gnus-run-hooks gnus-audio-disable-hooks)) | ||
| 92 | |||
| 93 | ;;;###autoload | ||
| 94 | (defun gnus-audio-play (file) | ||
| 95 | "Play a sound FILE through the speaker." | ||
| 96 | (interactive "fSound file name: ") | ||
| 97 | (let ((sound-file (if (file-exists-p file) | ||
| 98 | file | ||
| 99 | (expand-file-name file gnus-audio-directory)))) | ||
| 100 | (when (file-exists-p sound-file) | ||
| 101 | (cond ((and gnus-audio-inline-sound | ||
| 102 | (condition-case nil | ||
| 103 | ;; Even if we have audio, we may fail with the | ||
| 104 | ;; wrong sort of sound file. | ||
| 105 | (progn (play-sound-file sound-file) | ||
| 106 | t) | ||
| 107 | (error nil)))) | ||
| 108 | ;; If we don't have built-in sound, or playing it failed, | ||
| 109 | ;; try with external program. | ||
| 110 | ((equal "wav" (file-name-extension sound-file)) | ||
| 111 | (call-process gnus-audio-wav-player | ||
| 112 | sound-file | ||
| 113 | 0 | ||
| 114 | nil | ||
| 115 | sound-file)) | ||
| 116 | ((equal "au" (file-name-extension sound-file)) | ||
| 117 | (call-process gnus-audio-au-player | ||
| 118 | sound-file | ||
| 119 | 0 | ||
| 120 | nil | ||
| 121 | sound-file)))))) | ||
| 122 | |||
| 123 | |||
| 124 | ;;; The following isn't implemented yet, wait for Red Gnus | ||
| 125 | ;;(defun gnus-audio-startrek-sounds () | ||
| 126 | ;; "Enable sounds from Star Trek the original series." | ||
| 127 | ;; (interactive) | ||
| 128 | ;; (setq gnus-audio-busy-sound "working.au") | ||
| 129 | ;; (setq gnus-audio-enter-group "bulkhead_door.au") | ||
| 130 | ;; (setq gnus-audio-exit-group "bulkhead_door.au") | ||
| 131 | ;; (setq gnus-audio-score-group "ST_laser.au") | ||
| 132 | ;; (setq gnus-audio-theme-song "startrek.au") | ||
| 133 | ;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) | ||
| 134 | ;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) | ||
| 135 | ;;;*** | ||
| 136 | |||
| 137 | (defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" | ||
| 138 | "Name of the Gnus startup jingle file.") | ||
| 139 | |||
| 140 | (defun gnus-play-jingle () | ||
| 141 | "Play the Gnus startup jingle, unless that's inhibited." | ||
| 142 | (interactive) | ||
| 143 | (gnus-audio-play gnus-startup-jingle)) | ||
| 144 | |||
| 145 | (provide 'gnus-audio) | ||
| 146 | |||
| 147 | (run-hooks 'gnus-audio-load-hook) | ||
| 148 | |||
| 149 | ;;; gnus-audio.el ends here | ||
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index 838150d1146..6da91bdc266 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el | |||
| @@ -865,11 +865,6 @@ This can be changed using the `\\[gnus-score-change-score-file]' command." | |||
| 865 | Check the [ ] for the entries you want to apply to this score file, then | 865 | Check the [ ] for the entries you want to apply to this score file, then |
| 866 | edit the value to suit your taste. Don't forget to mark the checkbox, | 866 | edit the value to suit your taste. Don't forget to mark the checkbox, |
| 867 | if you do all your changes will be lost. ") | 867 | if you do all your changes will be lost. ") |
| 868 | (widget-create 'push-button | ||
| 869 | :action (lambda (&rest ignore) | ||
| 870 | (require 'gnus-audio) | ||
| 871 | (gnus-audio-play "Evil_Laugh.au")) | ||
| 872 | "Bhahahah!") | ||
| 873 | (widget-insert "\n\n") | 868 | (widget-insert "\n\n") |
| 874 | (make-local-variable 'gnus-custom-scores) | 869 | (make-local-variable 'gnus-custom-scores) |
| 875 | (setq gnus-custom-scores | 870 | (setq gnus-custom-scores |
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 67c1c8ba3bc..c4e439c3bf4 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el | |||
| @@ -240,15 +240,6 @@ time Emacs has been idle for IDLE `gnus-demon-timestep's." | |||
| 240 | ;; this idle-cycle. | 240 | ;; this idle-cycle. |
| 241 | (push (car handler) gnus-demon-idle-has-been-called))))))))) | 241 | (push (car handler) gnus-demon-idle-has-been-called))))))))) |
| 242 | 242 | ||
| 243 | (defun gnus-demon-add-nocem () | ||
| 244 | "Add daemonic NoCeM handling to Gnus." | ||
| 245 | (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) | ||
| 246 | |||
| 247 | (defun gnus-demon-scan-nocem () | ||
| 248 | "Scan NoCeM groups for NoCeM messages." | ||
| 249 | (save-window-excursion | ||
| 250 | (gnus-nocem-scan-groups))) | ||
| 251 | |||
| 252 | (defun gnus-demon-add-disconnection () | 243 | (defun gnus-demon-add-disconnection () |
| 253 | "Add daemonic server disconnection to Gnus." | 244 | "Add daemonic server disconnection to Gnus." |
| 254 | (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) | 245 | (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 5a25d513a57..7dddb9b6f70 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -2418,6 +2418,14 @@ the bug number, and browsing the URL must return mbox output." | |||
| 2418 | (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) | 2418 | (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) |
| 2419 | (with-temp-file tmpfile | 2419 | (with-temp-file tmpfile |
| 2420 | (url-insert-file-contents (format mbox-url number)) | 2420 | (url-insert-file-contents (format mbox-url number)) |
| 2421 | (goto-char (point-min)) | ||
| 2422 | ;; Add the debbugs address so that we can respond to reports easily. | ||
| 2423 | (while (re-search-forward "^To: " nil t) | ||
| 2424 | (end-of-line) | ||
| 2425 | (insert (format ", %s@%s" number | ||
| 2426 | (replace-regexp-in-string | ||
| 2427 | "/.*$" "" | ||
| 2428 | (replace-regexp-in-string "^http://" "" mbox-url))))) | ||
| 2421 | (write-region (point-min) (point-max) tmpfile) | 2429 | (write-region (point-min) (point-max) tmpfile) |
| 2422 | (gnus-group-read-ephemeral-group | 2430 | (gnus-group-read-ephemeral-group |
| 2423 | "gnus-read-ephemeral-bug" | 2431 | "gnus-read-ephemeral-bug" |
| @@ -3946,14 +3954,6 @@ re-scanning. If ARG is non-nil and not a number, this will force | |||
| 3946 | (unless gnus-slave | 3954 | (unless gnus-slave |
| 3947 | (gnus-master-read-slave-newsrc)) | 3955 | (gnus-master-read-slave-newsrc)) |
| 3948 | 3956 | ||
| 3949 | ;; We might read in new NoCeM messages here. | ||
| 3950 | (when (and gnus-use-nocem | ||
| 3951 | (or (and (numberp gnus-use-nocem) | ||
| 3952 | (numberp arg) | ||
| 3953 | (>= arg gnus-use-nocem)) | ||
| 3954 | (not arg))) | ||
| 3955 | (gnus-nocem-scan-groups)) | ||
| 3956 | |||
| 3957 | (gnus-get-unread-articles arg) | 3957 | (gnus-get-unread-articles arg) |
| 3958 | 3958 | ||
| 3959 | ;; If the user wants it, we scan for new groups. | 3959 | ;; If the user wants it, we scan for new groups. |
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 5199f7dfd5f..cb5d3c6e30b 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el | |||
| @@ -104,7 +104,12 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." | |||
| 104 | (match-string 0 encoded-text))) | 104 | (match-string 0 encoded-text))) |
| 105 | t t encoded-text) | 105 | t t encoded-text) |
| 106 | s (1+ s))) | 106 | s (1+ s))) |
| 107 | encoded-text))))) | 107 | encoded-text)))) |
| 108 | ;; XEmacs does not have window-inside-pixel-edges | ||
| 109 | (defalias 'gnus-window-inside-pixel-edges | ||
| 110 | (if (fboundp 'window-inside-pixel-edges) | ||
| 111 | 'window-inside-pixel-edges | ||
| 112 | 'window-pixel-edges))) | ||
| 108 | 113 | ||
| 109 | (defun gnus-html-encode-url (url) | 114 | (defun gnus-html-encode-url (url) |
| 110 | "Encode URL." | 115 | "Encode URL." |
| @@ -450,7 +455,7 @@ Return a string with image data." | |||
| 450 | image | 455 | image |
| 451 | (let* ((width (car size)) | 456 | (let* ((width (car size)) |
| 452 | (height (cdr size)) | 457 | (height (cdr size)) |
| 453 | (edges (window-pixel-edges (get-buffer-window (current-buffer)))) | 458 | (edges (gnus-window-inside-pixel-edges (get-buffer-window (current-buffer)))) |
| 454 | (window-width (truncate (* gnus-max-image-proportion | 459 | (window-width (truncate (* gnus-max-image-proportion |
| 455 | (- (nth 2 edges) (nth 0 edges))))) | 460 | (- (nth 2 edges) (nth 0 edges))))) |
| 456 | (window-height (truncate (* gnus-max-image-proportion | 461 | (window-height (truncate (* gnus-max-image-proportion |
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 395f47daf35..3245b16997b 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el | |||
| @@ -181,10 +181,15 @@ If it is down, start it up (again)." | |||
| 181 | (prog1 | 181 | (prog1 |
| 182 | (setq result (gnus-open-server method)) | 182 | (setq result (gnus-open-server method)) |
| 183 | (unless silent | 183 | (unless silent |
| 184 | (gnus-message 5 "Opening %s server%s...%s" (car method) | 184 | (gnus-message |
| 185 | (if (equal (nth 1 method) "") "" | 185 | (if result 5 3) |
| 186 | (format " on %s" (nth 1 method))) | 186 | "Opening %s server%s...%s" (car method) |
| 187 | (if result "done" "failed"))))))) | 187 | (if (equal (nth 1 method) "") "" |
| 188 | (format " on %s" (nth 1 method))) | ||
| 189 | (if result | ||
| 190 | "done" | ||
| 191 | (format "failed: %s" | ||
| 192 | (nnheader-get-report-string (car method)))))))))) | ||
| 188 | 193 | ||
| 189 | (defun gnus-get-function (method function &optional noerror) | 194 | (defun gnus-get-function (method function &optional noerror) |
| 190 | "Return a function symbol based on METHOD and FUNCTION." | 195 | "Return a function symbol based on METHOD and FUNCTION." |
| @@ -265,36 +270,31 @@ If it is down, start it up (again)." | |||
| 265 | (setq elem (list gnus-command-method nil) | 270 | (setq elem (list gnus-command-method nil) |
| 266 | gnus-opened-servers (cons elem gnus-opened-servers))) | 271 | gnus-opened-servers (cons elem gnus-opened-servers))) |
| 267 | ;; Set the status of this server. | 272 | ;; Set the status of this server. |
| 268 | (setcar (cdr elem) | 273 | (setcar |
| 269 | (cond (result | 274 | (cdr elem) |
| 270 | (if (eq open-server-function #'nnagent-open-server) | 275 | (cond (result |
| 271 | ;; The agent's backend has a "special" status | 276 | (if (eq open-server-function #'nnagent-open-server) |
| 272 | 'offline | 277 | ;; The agent's backend has a "special" status |
| 273 | 'ok)) | 278 | 'offline |
| 274 | ((and gnus-agent | 279 | 'ok)) |
| 275 | (gnus-agent-method-p gnus-command-method)) | 280 | ((and gnus-agent |
| 276 | (cond (gnus-server-unopen-status | 281 | (gnus-agent-method-p gnus-command-method)) |
| 277 | ;; Set the server's status to the unopen | 282 | (cond |
| 278 | ;; status. If that status is offline, | 283 | (gnus-server-unopen-status |
| 279 | ;; recurse to open the agent's backend. | 284 | ;; Set the server's status to the unopen |
| 280 | (setq open-offline (eq gnus-server-unopen-status 'offline)) | 285 | ;; status. If that status is offline, |
| 281 | gnus-server-unopen-status) | 286 | ;; recurse to open the agent's backend. |
| 282 | ((and | 287 | (setq open-offline (eq gnus-server-unopen-status 'offline)) |
| 283 | (not gnus-batch-mode) | 288 | gnus-server-unopen-status) |
| 284 | (gnus-y-or-n-p | 289 | ((not gnus-batch-mode) |
| 285 | (format | 290 | (setq open-offline t) |
| 286 | "Unable to open server %s (%s), go offline? " | 291 | 'offline) |
| 287 | server | 292 | (t |
| 288 | (nnheader-get-report | 293 | ;; This agentized server was still denied |
| 289 | (car gnus-command-method))))) | 294 | 'denied))) |
| 290 | (setq open-offline t) | 295 | (t |
| 291 | 'offline) | 296 | ;; This unagentized server must be denied |
| 292 | (t | 297 | 'denied))) |
| 293 | ;; This agentized server was still denied | ||
| 294 | 'denied))) | ||
| 295 | (t | ||
| 296 | ;; This unagentized server must be denied | ||
| 297 | 'denied))) | ||
| 298 | 298 | ||
| 299 | ;; NOTE: I MUST set the server's status to offline before this | 299 | ;; NOTE: I MUST set the server's status to offline before this |
| 300 | ;; recursive call as this status will drive the | 300 | ;; recursive call as this status will drive the |
diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el deleted file mode 100644 index 0364c963a27..00000000000 --- a/lisp/gnus/gnus-nocem.el +++ /dev/null | |||
| @@ -1,452 +0,0 @@ | |||
| 1 | ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment | ||
| 2 | |||
| 3 | ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: news | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (eval-when-compile (require 'cl)) | ||
| 29 | |||
| 30 | (require 'gnus) | ||
| 31 | (require 'nnmail) | ||
| 32 | (require 'gnus-art) | ||
| 33 | (require 'gnus-sum) | ||
| 34 | (require 'gnus-range) | ||
| 35 | |||
| 36 | (defgroup gnus-nocem nil | ||
| 37 | "NoCeM pseudo-cancellation treatment." | ||
| 38 | :group 'gnus-score) | ||
| 39 | |||
| 40 | (defcustom gnus-nocem-groups | ||
| 41 | '("news.lists.filters" "alt.nocem.misc") | ||
| 42 | "*List of groups that will be searched for NoCeM messages." | ||
| 43 | :group 'gnus-nocem | ||
| 44 | :version "23.1" | ||
| 45 | :type '(repeat (string :tag "Group"))) | ||
| 46 | |||
| 47 | (defcustom gnus-nocem-issuers | ||
| 48 | '("Adri Verhoef" | ||
| 49 | "alba-nocem@albasani.net" | ||
| 50 | "bleachbot@httrack.com" | ||
| 51 | "news@arcor-online.net" | ||
| 52 | "news@uni-berlin.de" | ||
| 53 | "nocem@arcor.de" | ||
| 54 | "pgpmoose@killfile.org" | ||
| 55 | "xjsppl@gmx.de") | ||
| 56 | "*List of NoCeM issuers to pay attention to. | ||
| 57 | |||
| 58 | This can also be a list of `(ISSUER CONDITION ...)' elements. | ||
| 59 | |||
| 60 | See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an | ||
| 61 | issuer registry." | ||
| 62 | :group 'gnus-nocem | ||
| 63 | :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") | ||
| 64 | :version "23.1" | ||
| 65 | :type '(repeat (cons :format "%v" (string :tag "Issuer") | ||
| 66 | (repeat :tag "Condition" | ||
| 67 | (group (checklist :inline t (const not)) | ||
| 68 | (regexp :tag "Type" :value ".*"))))) | ||
| 69 | :get (lambda (symbol) | ||
| 70 | (mapcar (lambda (elem) | ||
| 71 | (if (consp elem) | ||
| 72 | (cons (car elem) | ||
| 73 | (mapcar (lambda (elt) | ||
| 74 | (if (consp elt) elt (list elt))) | ||
| 75 | (cdr elem))) | ||
| 76 | (list elem))) | ||
| 77 | (default-value symbol))) | ||
| 78 | :set (lambda (symbol value) | ||
| 79 | (custom-set-default | ||
| 80 | symbol | ||
| 81 | (mapcar (lambda (elem) | ||
| 82 | (if (consp elem) | ||
| 83 | (if (cdr elem) | ||
| 84 | (mapcar (lambda (elt) | ||
| 85 | (if (consp elt) | ||
| 86 | (if (cdr elt) elt (car elt)) | ||
| 87 | elt)) | ||
| 88 | elem) | ||
| 89 | (car elem)) | ||
| 90 | elem)) | ||
| 91 | value)))) | ||
| 92 | |||
| 93 | (defcustom gnus-nocem-directory | ||
| 94 | (nnheader-concat gnus-article-save-directory "NoCeM/") | ||
| 95 | "*Directory where NoCeM files will be stored." | ||
| 96 | :group 'gnus-nocem | ||
| 97 | :type 'directory) | ||
| 98 | |||
| 99 | (defcustom gnus-nocem-expiry-wait 15 | ||
| 100 | "*Number of days to keep NoCeM headers in the cache." | ||
| 101 | :group 'gnus-nocem | ||
| 102 | :type 'integer) | ||
| 103 | |||
| 104 | (defcustom gnus-nocem-verifyer (if (locate-library "epg") | ||
| 105 | 'gnus-nocem-epg-verify | ||
| 106 | 'pgg-verify) | ||
| 107 | "*Function called to verify that the NoCeM message is valid. | ||
| 108 | If the function in this variable isn't bound, the message will be used | ||
| 109 | unconditionally." | ||
| 110 | :group 'gnus-nocem | ||
| 111 | :version "23.1" | ||
| 112 | :type '(radio (function-item gnus-nocem-epg-verify) | ||
| 113 | (function-item pgg-verify) | ||
| 114 | (function-item mc-verify) | ||
| 115 | (function :tag "other")) | ||
| 116 | :set (lambda (symbol value) | ||
| 117 | (custom-set-default symbol | ||
| 118 | (if (and (eq value 'gnus-nocem-epg-verify) | ||
| 119 | (not (locate-library "epg"))) | ||
| 120 | 'pgg-verify | ||
| 121 | value)))) | ||
| 122 | |||
| 123 | (defcustom gnus-nocem-liberal-fetch nil | ||
| 124 | "*If t try to fetch all messages which have @@NCM in the subject. | ||
| 125 | Otherwise don't fetch messages which have references or whose message-id | ||
| 126 | matches a previously scanned and verified nocem message." | ||
| 127 | :group 'gnus-nocem | ||
| 128 | :type 'boolean) | ||
| 129 | |||
| 130 | (defcustom gnus-nocem-check-article-limit 500 | ||
| 131 | "*If non-nil, the maximum number of articles to check in any NoCeM group." | ||
| 132 | :group 'gnus-nocem | ||
| 133 | :version "21.1" | ||
| 134 | :type '(choice (const :tag "unlimited" nil) | ||
| 135 | (integer 1000))) | ||
| 136 | |||
| 137 | (defcustom gnus-nocem-check-from t | ||
| 138 | "Non-nil means check for valid issuers in message bodies. | ||
| 139 | Otherwise don't bother fetching articles unless their author matches a | ||
| 140 | valid issuer, which is much faster if you are selective about the issuers." | ||
| 141 | :group 'gnus-nocem | ||
| 142 | :version "21.1" | ||
| 143 | :type 'boolean) | ||
| 144 | |||
| 145 | ;;; Internal variables | ||
| 146 | |||
| 147 | (defvar gnus-nocem-active nil) | ||
| 148 | (defvar gnus-nocem-alist nil) | ||
| 149 | (defvar gnus-nocem-touched-alist nil) | ||
| 150 | (defvar gnus-nocem-hashtb nil) | ||
| 151 | (defvar gnus-nocem-seen-message-ids nil) | ||
| 152 | |||
| 153 | ;;; Functions | ||
| 154 | |||
| 155 | (defun gnus-nocem-active-file () | ||
| 156 | (concat (file-name-as-directory gnus-nocem-directory) "active")) | ||
| 157 | |||
| 158 | (defun gnus-nocem-cache-file () | ||
| 159 | (concat (file-name-as-directory gnus-nocem-directory) "cache")) | ||
| 160 | |||
| 161 | ;; | ||
| 162 | ;; faster lookups for group names: | ||
| 163 | ;; | ||
| 164 | |||
| 165 | (defvar gnus-nocem-real-group-hashtb nil | ||
| 166 | "Real-name mappings of subscribed groups.") | ||
| 167 | |||
| 168 | (defun gnus-fill-real-hashtb () | ||
| 169 | "Fill up a hash table with the real-name mappings from the user's active file." | ||
| 170 | (if (hash-table-p gnus-nocem-real-group-hashtb) | ||
| 171 | (clrhash gnus-nocem-real-group-hashtb) | ||
| 172 | (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) | ||
| 173 | (mapcar (lambda (group) | ||
| 174 | (setq group (gnus-group-real-name (car group))) | ||
| 175 | (puthash group t gnus-nocem-real-group-hashtb)) | ||
| 176 | gnus-newsrc-alist)) | ||
| 177 | |||
| 178 | ;;;###autoload | ||
| 179 | (defun gnus-nocem-scan-groups () | ||
| 180 | "Scan all NoCeM groups for new NoCeM messages." | ||
| 181 | (interactive) | ||
| 182 | (let ((groups gnus-nocem-groups) | ||
| 183 | (gnus-inhibit-demon t) | ||
| 184 | group active gactive articles check-headers) | ||
| 185 | (gnus-make-directory gnus-nocem-directory) | ||
| 186 | ;; Load any previous NoCeM headers. | ||
| 187 | (gnus-nocem-load-cache) | ||
| 188 | ;; Get the group name mappings: | ||
| 189 | (gnus-fill-real-hashtb) | ||
| 190 | ;; Read the active file if it hasn't been read yet. | ||
| 191 | (and (file-exists-p (gnus-nocem-active-file)) | ||
| 192 | (not gnus-nocem-active) | ||
| 193 | (ignore-errors | ||
| 194 | (load (gnus-nocem-active-file) t t t))) | ||
| 195 | ;; Go through all groups and see whether new articles have | ||
| 196 | ;; arrived. | ||
| 197 | (while (setq group (pop groups)) | ||
| 198 | (if (not (setq gactive (gnus-activate-group group))) | ||
| 199 | () ; This group doesn't exist. | ||
| 200 | (setq active (nth 1 (assoc group gnus-nocem-active))) | ||
| 201 | (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. | ||
| 202 | (or (not active) | ||
| 203 | (< (cdr active) (cdr gactive)))) | ||
| 204 | ;; Ok, there are new articles in this group, se we fetch the | ||
| 205 | ;; headers. | ||
| 206 | (save-excursion | ||
| 207 | (let ((dependencies (make-vector 10 nil)) | ||
| 208 | headers header) | ||
| 209 | (with-temp-buffer | ||
| 210 | (setq headers | ||
| 211 | (if (eq 'nov | ||
| 212 | (gnus-retrieve-headers | ||
| 213 | (setq articles | ||
| 214 | (gnus-uncompress-range | ||
| 215 | (cons | ||
| 216 | (if active (1+ (cdr active)) | ||
| 217 | (car gactive)) | ||
| 218 | (cdr gactive)))) | ||
| 219 | group)) | ||
| 220 | (gnus-get-newsgroup-headers-xover | ||
| 221 | articles nil dependencies) | ||
| 222 | (gnus-get-newsgroup-headers dependencies))) | ||
| 223 | (while (setq header (pop headers)) | ||
| 224 | ;; We take a closer look on all articles that have | ||
| 225 | ;; "@@NCM" in the subject. Unless we already read | ||
| 226 | ;; this cross posted message. Nocem messages | ||
| 227 | ;; are not allowed to have references, so we can | ||
| 228 | ;; ignore scanning followups. | ||
| 229 | (and (string-match "@@NCM" (mail-header-subject header)) | ||
| 230 | (and gnus-nocem-check-from | ||
| 231 | (let ((case-fold-search t)) | ||
| 232 | (catch 'ok | ||
| 233 | (mapc | ||
| 234 | (lambda (author) | ||
| 235 | (if (consp author) | ||
| 236 | (setq author (car author))) | ||
| 237 | (if (string-match | ||
| 238 | author (mail-header-from header)) | ||
| 239 | (throw 'ok t))) | ||
| 240 | gnus-nocem-issuers) | ||
| 241 | nil))) | ||
| 242 | (or gnus-nocem-liberal-fetch | ||
| 243 | (and (or (string= "" (mail-header-references | ||
| 244 | header)) | ||
| 245 | (null (mail-header-references header))) | ||
| 246 | (not (member (mail-header-message-id header) | ||
| 247 | gnus-nocem-seen-message-ids)))) | ||
| 248 | (push header check-headers))) | ||
| 249 | (setq check-headers (last (nreverse check-headers) | ||
| 250 | gnus-nocem-check-article-limit)) | ||
| 251 | (let ((i 0) | ||
| 252 | (len (length check-headers))) | ||
| 253 | (dolist (h check-headers) | ||
| 254 | (gnus-message | ||
| 255 | 7 "Checking article %d in %s for NoCeM (%d of %d)..." | ||
| 256 | (mail-header-number h) group (incf i) len) | ||
| 257 | (gnus-nocem-check-article group h))))))) | ||
| 258 | (setq gnus-nocem-active | ||
| 259 | (cons (list group gactive) | ||
| 260 | (delq (assoc group gnus-nocem-active) | ||
| 261 | gnus-nocem-active))))) | ||
| 262 | ;; Save the results, if any. | ||
| 263 | (gnus-nocem-save-cache) | ||
| 264 | (gnus-nocem-save-active))) | ||
| 265 | |||
| 266 | (defun gnus-nocem-check-article (group header) | ||
| 267 | "Check whether the current article is an NCM article and that we want it." | ||
| 268 | ;; Get the article. | ||
| 269 | (let ((date (mail-header-date header)) | ||
| 270 | (gnus-newsgroup-name group) | ||
| 271 | issuer b e type) | ||
| 272 | (when (or (not date) | ||
| 273 | (time-less-p | ||
| 274 | (time-since (date-to-time date)) | ||
| 275 | (days-to-time gnus-nocem-expiry-wait))) | ||
| 276 | (gnus-request-article-this-buffer (mail-header-number header) group) | ||
| 277 | (goto-char (point-min)) | ||
| 278 | (when (re-search-forward | ||
| 279 | "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----" | ||
| 280 | nil t) | ||
| 281 | (delete-region (point-min) (match-beginning 0))) | ||
| 282 | (when (re-search-forward | ||
| 283 | "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?" | ||
| 284 | nil t) | ||
| 285 | (delete-region (match-end 0) (point-max))) | ||
| 286 | (goto-char (point-min)) | ||
| 287 | ;; The article has to have proper NoCeM headers. | ||
| 288 | (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) | ||
| 289 | (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) | ||
| 290 | ;; We get the name of the issuer. | ||
| 291 | (narrow-to-region b e) | ||
| 292 | (setq issuer (mail-fetch-field "issuer") | ||
| 293 | type (mail-fetch-field "type")) | ||
| 294 | (widen) | ||
| 295 | (if (not (gnus-nocem-message-wanted-p issuer type)) | ||
| 296 | (message "invalid NoCeM issuer: %s" issuer) | ||
| 297 | (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. | ||
| 298 | (gnus-nocem-enter-article) ; We gobble the message. | ||
| 299 | (push (mail-header-message-id header) ; But don't come back for | ||
| 300 | gnus-nocem-seen-message-ids))))))) ; second helpings. | ||
| 301 | |||
| 302 | (defun gnus-nocem-message-wanted-p (issuer type) | ||
| 303 | (let ((issuers gnus-nocem-issuers) | ||
| 304 | wanted conditions condition) | ||
| 305 | (cond | ||
| 306 | ;; Do the quick check first. | ||
| 307 | ((member issuer issuers) | ||
| 308 | t) | ||
| 309 | ((setq conditions (cdr (assoc issuer issuers))) | ||
| 310 | ;; Check whether we want this type. | ||
| 311 | (while (setq condition (pop conditions)) | ||
| 312 | (cond | ||
| 313 | ((stringp condition) | ||
| 314 | (when (string-match condition type) | ||
| 315 | (setq wanted t))) | ||
| 316 | ((and (consp condition) | ||
| 317 | (eq (car condition) 'not) | ||
| 318 | (stringp (cadr condition))) | ||
| 319 | (when (string-match (cadr condition) type) | ||
| 320 | (setq wanted nil))) | ||
| 321 | (t | ||
| 322 | (error "Invalid NoCeM condition: %S" condition)))) | ||
| 323 | wanted)))) | ||
| 324 | |||
| 325 | (defun gnus-nocem-verify-issuer (person) | ||
| 326 | "Verify using PGP that the canceler is who she says she is." | ||
| 327 | (if (functionp gnus-nocem-verifyer) | ||
| 328 | (ignore-errors | ||
| 329 | (funcall gnus-nocem-verifyer)) | ||
| 330 | ;; If we don't have Mailcrypt, then we use the message anyway. | ||
| 331 | t)) | ||
| 332 | |||
| 333 | (defun gnus-nocem-enter-article () | ||
| 334 | "Enter the current article into the NoCeM cache." | ||
| 335 | (goto-char (point-min)) | ||
| 336 | (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) | ||
| 337 | (e (search-forward "\n@@END NCM BODY\n" nil t)) | ||
| 338 | (buf (current-buffer)) | ||
| 339 | ncm id group) | ||
| 340 | (when (and b e) | ||
| 341 | (narrow-to-region b (1+ (match-beginning 0))) | ||
| 342 | (goto-char (point-min)) | ||
| 343 | (while (search-forward "\t" nil t) | ||
| 344 | (cond | ||
| 345 | ((not (ignore-errors | ||
| 346 | (setq group (gnus-group-real-name (symbol-name (read buf)))) | ||
| 347 | (gethash group gnus-nocem-real-group-hashtb))) | ||
| 348 | ;; An error. | ||
| 349 | ) | ||
| 350 | (t | ||
| 351 | ;; Valid group. | ||
| 352 | (beginning-of-line) | ||
| 353 | (while (eq (char-after) ?\t) | ||
| 354 | (forward-line -1)) | ||
| 355 | (setq id (buffer-substring (point) (1- (search-forward "\t")))) | ||
| 356 | (unless (if (hash-table-p gnus-nocem-hashtb) | ||
| 357 | (gethash id gnus-nocem-hashtb) | ||
| 358 | (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) | ||
| 359 | nil) | ||
| 360 | ;; only store if not already present | ||
| 361 | (puthash id t gnus-nocem-hashtb) | ||
| 362 | (push id ncm)) | ||
| 363 | (forward-line 1) | ||
| 364 | (while (eq (char-after) ?\t) | ||
| 365 | (forward-line 1))))) | ||
| 366 | (when ncm | ||
| 367 | (setq gnus-nocem-touched-alist t) | ||
| 368 | (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) | ||
| 369 | ncm) | ||
| 370 | gnus-nocem-alist)) | ||
| 371 | t))) | ||
| 372 | |||
| 373 | ;;;###autoload | ||
| 374 | (defun gnus-nocem-load-cache () | ||
| 375 | "Load the NoCeM cache." | ||
| 376 | (interactive) | ||
| 377 | (unless gnus-nocem-alist | ||
| 378 | ;; The buffer doesn't exist, so we create it and load the NoCeM | ||
| 379 | ;; cache. | ||
| 380 | (when (file-exists-p (gnus-nocem-cache-file)) | ||
| 381 | (load (gnus-nocem-cache-file) t t t) | ||
| 382 | (gnus-nocem-alist-to-hashtb)))) | ||
| 383 | |||
| 384 | (defun gnus-nocem-save-cache () | ||
| 385 | "Save the NoCeM cache." | ||
| 386 | (when (and gnus-nocem-alist | ||
| 387 | gnus-nocem-touched-alist) | ||
| 388 | (with-temp-file (gnus-nocem-cache-file) | ||
| 389 | (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) | ||
| 390 | (setq gnus-nocem-touched-alist nil))) | ||
| 391 | |||
| 392 | (defun gnus-nocem-save-active () | ||
| 393 | "Save the NoCeM active file." | ||
| 394 | (with-temp-file (gnus-nocem-active-file) | ||
| 395 | (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) | ||
| 396 | |||
| 397 | (defun gnus-nocem-alist-to-hashtb () | ||
| 398 | "Create a hashtable from the Message-IDs we have." | ||
| 399 | (let* ((alist gnus-nocem-alist) | ||
| 400 | (pprev (cons nil alist)) | ||
| 401 | (prev pprev) | ||
| 402 | (expiry (days-to-time gnus-nocem-expiry-wait)) | ||
| 403 | entry) | ||
| 404 | (if (hash-table-p gnus-nocem-hashtb) | ||
| 405 | (clrhash gnus-nocem-hashtb) | ||
| 406 | (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) | ||
| 407 | (while (setq entry (car alist)) | ||
| 408 | (if (not (time-less-p (time-since (car entry)) expiry)) | ||
| 409 | ;; This entry has expired, so we remove it. | ||
| 410 | (setcdr prev (cdr alist)) | ||
| 411 | (setq prev alist) | ||
| 412 | ;; This is ok, so we enter it into the hashtable. | ||
| 413 | (setq entry (cdr entry)) | ||
| 414 | (while entry | ||
| 415 | (puthash (car entry) t gnus-nocem-hashtb) | ||
| 416 | (setq entry (cdr entry)))) | ||
| 417 | (setq alist (cdr alist))))) | ||
| 418 | |||
| 419 | (gnus-add-shutdown 'gnus-nocem-close 'gnus) | ||
| 420 | |||
| 421 | (defun gnus-nocem-close () | ||
| 422 | "Clear internal NoCeM variables." | ||
| 423 | (setq gnus-nocem-alist nil | ||
| 424 | gnus-nocem-hashtb nil | ||
| 425 | gnus-nocem-active nil | ||
| 426 | gnus-nocem-touched-alist nil | ||
| 427 | gnus-nocem-seen-message-ids nil | ||
| 428 | gnus-nocem-real-group-hashtb nil)) | ||
| 429 | |||
| 430 | (defun gnus-nocem-unwanted-article-p (id) | ||
| 431 | "Say whether article ID in the current group is wanted." | ||
| 432 | (and gnus-nocem-hashtb | ||
| 433 | (gethash id gnus-nocem-hashtb))) | ||
| 434 | |||
| 435 | (autoload 'epg-make-context "epg") | ||
| 436 | (eval-when-compile | ||
| 437 | (autoload 'epg-verify-string "epg") | ||
| 438 | (autoload 'epg-context-result-for "epg") | ||
| 439 | (autoload 'epg-signature-status "epg")) | ||
| 440 | |||
| 441 | (defun gnus-nocem-epg-verify () | ||
| 442 | "Return t if EasyPG verifies a signed message in the current buffer." | ||
| 443 | (let ((context (epg-make-context 'OpenPGP)) | ||
| 444 | result) | ||
| 445 | (epg-verify-string context (buffer-string)) | ||
| 446 | (and (setq result (epg-context-result-for context 'verify)) | ||
| 447 | (not (cdr result)) | ||
| 448 | (eq (epg-signature-status (car result)) 'good)))) | ||
| 449 | |||
| 450 | (provide 'gnus-nocem) | ||
| 451 | |||
| 452 | ;;; gnus-nocem.el ends here | ||
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 2966212de69..11164a8df6c 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el | |||
| @@ -28,6 +28,7 @@ | |||
| 28 | (eval-when-compile (require 'cl)) | 28 | (eval-when-compile (require 'cl)) |
| 29 | 29 | ||
| 30 | (require 'gnus) | 30 | (require 'gnus) |
| 31 | (require 'gnus-start) | ||
| 31 | (require 'gnus-spec) | 32 | (require 'gnus-spec) |
| 32 | (require 'gnus-group) | 33 | (require 'gnus-group) |
| 33 | (require 'gnus-int) | 34 | (require 'gnus-int) |
| @@ -547,6 +548,7 @@ The following commands are available: | |||
| 547 | (gnus-server-list-servers)) | 548 | (gnus-server-list-servers)) |
| 548 | 549 | ||
| 549 | (defun gnus-server-copy-server (from to) | 550 | (defun gnus-server-copy-server (from to) |
| 551 | "Copy a server definiton to a new name." | ||
| 550 | (interactive | 552 | (interactive |
| 551 | (list | 553 | (list |
| 552 | (or (gnus-server-server-name) | 554 | (or (gnus-server-server-name) |
| @@ -643,6 +645,30 @@ The following commands are available: | |||
| 643 | (defvar gnus-browse-menu-hook nil | 645 | (defvar gnus-browse-menu-hook nil |
| 644 | "*Hook run after the creation of the browse mode menu.") | 646 | "*Hook run after the creation of the browse mode menu.") |
| 645 | 647 | ||
| 648 | (defcustom gnus-browse-subscribe-newsgroup-method | ||
| 649 | 'gnus-subscribe-alphabetically | ||
| 650 | "Function(s) called when subscribing groups in the Browse Server Buffer | ||
| 651 | A few pre-made functions are supplied: `gnus-subscribe-randomly' | ||
| 652 | inserts new groups at the beginning of the list of groups; | ||
| 653 | `gnus-subscribe-alphabetically' inserts new groups in strict | ||
| 654 | alphabetic order; `gnus-subscribe-hierarchically' inserts new groups | ||
| 655 | in hierarchical newsgroup order; `gnus-subscribe-interactively' asks | ||
| 656 | for your decision; `gnus-subscribe-killed' kills all new groups; | ||
| 657 | `gnus-subscribe-zombies' will make all new groups into zombies; | ||
| 658 | `gnus-subscribe-topics' will enter groups into the topics that | ||
| 659 | claim them." | ||
| 660 | :version "24.1" | ||
| 661 | :group 'gnus-server | ||
| 662 | :type '(radio (function-item gnus-subscribe-randomly) | ||
| 663 | (function-item gnus-subscribe-alphabetically) | ||
| 664 | (function-item gnus-subscribe-hierarchically) | ||
| 665 | (function-item gnus-subscribe-interactively) | ||
| 666 | (function-item gnus-subscribe-killed) | ||
| 667 | (function-item gnus-subscribe-zombies) | ||
| 668 | (function-item gnus-subscribe-topics) | ||
| 669 | function | ||
| 670 | (repeat function))) | ||
| 671 | |||
| 646 | (defvar gnus-browse-mode-hook nil) | 672 | (defvar gnus-browse-mode-hook nil) |
| 647 | (defvar gnus-browse-mode-map nil) | 673 | (defvar gnus-browse-mode-map nil) |
| 648 | (put 'gnus-browse-mode 'mode-class 'special) | 674 | (put 'gnus-browse-mode 'mode-class 'special) |
| @@ -890,7 +916,9 @@ If NUMBER, fetch this number of articles." | |||
| 890 | (gnus-browse-next-group (- n))) | 916 | (gnus-browse-next-group (- n))) |
| 891 | 917 | ||
| 892 | (defun gnus-browse-unsubscribe-current-group (arg) | 918 | (defun gnus-browse-unsubscribe-current-group (arg) |
| 893 | "(Un)subscribe to the next ARG groups." | 919 | "(Un)subscribe to the next ARG groups. |
| 920 | The variable `gnus-browse-subscribe-newsgroup-method' determines | ||
| 921 | how new groups will be entered into the group buffer." | ||
| 894 | (interactive "p") | 922 | (interactive "p") |
| 895 | (when (eobp) | 923 | (when (eobp) |
| 896 | (error "No group at current line")) | 924 | (error "No group at current line")) |
| @@ -939,22 +967,24 @@ If NUMBER, fetch this number of articles." | |||
| 939 | ;; subscribe to it. | 967 | ;; subscribe to it. |
| 940 | (if (gnus-ephemeral-group-p group) | 968 | (if (gnus-ephemeral-group-p group) |
| 941 | (gnus-kill-ephemeral-group group)) | 969 | (gnus-kill-ephemeral-group group)) |
| 942 | ;; We need to discern between killed/zombie groups and | 970 | (let ((entry (gnus-group-entry group))) |
| 943 | ;; just unsubscribed ones. | 971 | (if entry |
| 944 | (gnus-group-change-level | 972 | ;; Just change the subscription level if it is an |
| 945 | (or (gnus-group-entry group) | 973 | ;; unsubscribed group. |
| 946 | (list t group gnus-level-default-subscribed | 974 | (gnus-group-change-level entry |
| 947 | nil nil (if (gnus-server-equal | 975 | gnus-level-default-subscribed) |
| 948 | gnus-browse-current-method "native") | 976 | ;; If it is a killed group or a zombie, feed it to the |
| 949 | nil | 977 | ;; mechanism for new group subscription. |
| 950 | (gnus-method-simplify | 978 | (gnus-call-subscribe-functions |
| 951 | gnus-browse-current-method)))) | 979 | gnus-browse-subscribe-newsgroup-method |
| 952 | gnus-level-default-subscribed (gnus-group-level group) | 980 | group))) |
| 953 | (and (car (nth 1 gnus-newsrc-alist)) | ||
| 954 | (gnus-group-entry (car (nth 1 gnus-newsrc-alist)))) | ||
| 955 | (null (gnus-group-entry group))) | ||
| 956 | (delete-char 1) | 981 | (delete-char 1) |
| 957 | (insert ? )) | 982 | (insert (let ((lvl (gnus-group-level group))) |
| 983 | (cond | ||
| 984 | ((< lvl gnus-level-unsubscribed) ? ) | ||
| 985 | ((< lvl gnus-level-zombie) ?U) | ||
| 986 | ((< lvl gnus-level-killed) ?Z) | ||
| 987 | (t ?K))))) | ||
| 958 | (gnus-group-change-level | 988 | (gnus-group-change-level |
| 959 | group gnus-level-unsubscribed gnus-level-default-subscribed) | 989 | group gnus-level-unsubscribed gnus-level-default-subscribed) |
| 960 | (delete-char 1) | 990 | (delete-char 1) |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 5aec3e7b729..68f26ea143b 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -1063,15 +1063,6 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." | |||
| 1063 | (gnus-server-opened gnus-select-method)) | 1063 | (gnus-server-opened gnus-select-method)) |
| 1064 | (gnus-check-bogus-newsgroups)) | 1064 | (gnus-check-bogus-newsgroups)) |
| 1065 | 1065 | ||
| 1066 | ;; We might read in new NoCeM messages here. | ||
| 1067 | (when (and (not dont-connect) | ||
| 1068 | gnus-use-nocem | ||
| 1069 | (or (and (numberp gnus-use-nocem) | ||
| 1070 | (numberp level) | ||
| 1071 | (>= level gnus-use-nocem)) | ||
| 1072 | (not level))) | ||
| 1073 | (gnus-nocem-scan-groups)) | ||
| 1074 | |||
| 1075 | ;; Read any slave files. | 1066 | ;; Read any slave files. |
| 1076 | (gnus-master-read-slave-newsrc) | 1067 | (gnus-master-read-slave-newsrc) |
| 1077 | 1068 | ||
| @@ -1767,8 +1758,10 @@ If SCAN, request a scan of that group as well." | |||
| 1767 | (not (gnus-method-denied-p method))) | 1758 | (not (gnus-method-denied-p method))) |
| 1768 | (unless (gnus-server-opened method) | 1759 | (unless (gnus-server-opened method) |
| 1769 | (gnus-open-server method)) | 1760 | (gnus-open-server method)) |
| 1770 | (when (gnus-check-backend-function | 1761 | (when (and |
| 1771 | 'retrieve-group-data-early (car method)) | 1762 | (gnus-server-opened method) |
| 1763 | (gnus-check-backend-function | ||
| 1764 | 'retrieve-group-data-early (car method))) | ||
| 1772 | (when (gnus-check-backend-function 'request-scan (car method)) | 1765 | (when (gnus-check-backend-function 'request-scan (car method)) |
| 1773 | (gnus-request-scan nil method)) | 1766 | (gnus-request-scan nil method)) |
| 1774 | (setcar (nthcdr 3 elem) | 1767 | (setcar (nthcdr 3 elem) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 0af75829bd3..195c7249778 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -2047,6 +2047,7 @@ increase the score of each group you read." | |||
| 2047 | "e" gnus-summary-end-of-article | 2047 | "e" gnus-summary-end-of-article |
| 2048 | "^" gnus-summary-refer-parent-article | 2048 | "^" gnus-summary-refer-parent-article |
| 2049 | "r" gnus-summary-refer-parent-article | 2049 | "r" gnus-summary-refer-parent-article |
| 2050 | "C" gnus-summary-show-complete-article | ||
| 2050 | "D" gnus-summary-enter-digest-group | 2051 | "D" gnus-summary-enter-digest-group |
| 2051 | "R" gnus-summary-refer-references | 2052 | "R" gnus-summary-refer-references |
| 2052 | "T" gnus-summary-refer-thread | 2053 | "T" gnus-summary-refer-thread |
| @@ -8645,8 +8646,7 @@ fetch-old-headers verbiage, and so on." | |||
| 8645 | (null gnus-summary-expunge-below) | 8646 | (null gnus-summary-expunge-below) |
| 8646 | (not (eq gnus-build-sparse-threads 'some)) | 8647 | (not (eq gnus-build-sparse-threads 'some)) |
| 8647 | (not (eq gnus-build-sparse-threads 'more)) | 8648 | (not (eq gnus-build-sparse-threads 'more)) |
| 8648 | (null gnus-thread-expunge-below) | 8649 | (null gnus-thread-expunge-below))) |
| 8649 | (not gnus-use-nocem))) | ||
| 8650 | (push gnus-newsgroup-limit gnus-newsgroup-limits) | 8650 | (push gnus-newsgroup-limit gnus-newsgroup-limits) |
| 8651 | (setq gnus-newsgroup-limit nil) | 8651 | (setq gnus-newsgroup-limit nil) |
| 8652 | (mapatoms | 8652 | (mapatoms |
| @@ -8729,14 +8729,7 @@ fetch-old-headers verbiage, and so on." | |||
| 8729 | t) | 8729 | t) |
| 8730 | ;; Do the `display' group parameter. | 8730 | ;; Do the `display' group parameter. |
| 8731 | (and gnus-newsgroup-display | 8731 | (and gnus-newsgroup-display |
| 8732 | (not (funcall gnus-newsgroup-display))) | 8732 | (not (funcall gnus-newsgroup-display))))) |
| 8733 | ;; Check NoCeM things. | ||
| 8734 | (when (and gnus-use-nocem | ||
| 8735 | (gnus-nocem-unwanted-article-p | ||
| 8736 | (mail-header-id (car thread)))) | ||
| 8737 | (setq gnus-newsgroup-unreads | ||
| 8738 | (delq number gnus-newsgroup-unreads)) | ||
| 8739 | t))) | ||
| 8740 | ;; Nope, invisible article. | 8733 | ;; Nope, invisible article. |
| 8741 | 0 | 8734 | 0 |
| 8742 | ;; Ok, this article is to be visible, so we add it to the limit | 8735 | ;; Ok, this article is to be visible, so we add it to the limit |
| @@ -9357,6 +9350,18 @@ to save in." | |||
| 9357 | (ps-spool-buffer))))) | 9350 | (ps-spool-buffer))))) |
| 9358 | (kill-buffer buffer)))) | 9351 | (kill-buffer buffer)))) |
| 9359 | 9352 | ||
| 9353 | (defun gnus-summary-show-complete-article () | ||
| 9354 | "Show a complete version of the current article. | ||
| 9355 | This is only useful if you're looking at a partial version of the | ||
| 9356 | article currently." | ||
| 9357 | (interactive) | ||
| 9358 | (let ((gnus-keep-backlog nil) | ||
| 9359 | (gnus-use-cache nil) | ||
| 9360 | (gnus-agent nil) | ||
| 9361 | (gnus-fetch-partial-articles nil)) | ||
| 9362 | (gnus-flush-original-article-buffer) | ||
| 9363 | (gnus-summary-show-article))) | ||
| 9364 | |||
| 9360 | (defun gnus-summary-show-article (&optional arg) | 9365 | (defun gnus-summary-show-article (&optional arg) |
| 9361 | "Force redisplaying of the current article. | 9366 | "Force redisplaying of the current article. |
| 9362 | If ARG (the prefix) is a number, show the article with the charset | 9367 | If ARG (the prefix) is a number, show the article with the charset |
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index c3bf47b9533..0c01d599cfc 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -308,11 +308,6 @@ be set in `.emacs' instead." | |||
| 308 | :group 'gnus-start | 308 | :group 'gnus-start |
| 309 | :type 'boolean) | 309 | :type 'boolean) |
| 310 | 310 | ||
| 311 | (defcustom gnus-play-startup-jingle nil | ||
| 312 | "If non-nil, play the Gnus jingle at startup." | ||
| 313 | :group 'gnus-start | ||
| 314 | :type 'boolean) | ||
| 315 | |||
| 316 | (unless (fboundp 'gnus-group-remove-excess-properties) | 311 | (unless (fboundp 'gnus-group-remove-excess-properties) |
| 317 | (defalias 'gnus-group-remove-excess-properties 'ignore)) | 312 | (defalias 'gnus-group-remove-excess-properties 'ignore)) |
| 318 | 313 | ||
| @@ -960,8 +955,6 @@ be set in `.emacs' instead." | |||
| 960 | 955 | ||
| 961 | (defvar gnus-group-buffer "*Group*") | 956 | (defvar gnus-group-buffer "*Group*") |
| 962 | 957 | ||
| 963 | (autoload 'gnus-play-jingle "gnus-audio") | ||
| 964 | |||
| 965 | (defface gnus-splash | 958 | (defface gnus-splash |
| 966 | '((((class color) | 959 | '((((class color) |
| 967 | (background dark)) | 960 | (background dark)) |
| @@ -984,9 +977,7 @@ be set in `.emacs' instead." | |||
| 984 | (erase-buffer) | 977 | (erase-buffer) |
| 985 | (unless gnus-inhibit-startup-message | 978 | (unless gnus-inhibit-startup-message |
| 986 | (gnus-group-startup-message) | 979 | (gnus-group-startup-message) |
| 987 | (sit-for 0) | 980 | (sit-for 0))))) |
| 988 | (when gnus-play-startup-jingle | ||
| 989 | (gnus-play-jingle)))))) | ||
| 990 | 981 | ||
| 991 | (defun gnus-indent-rigidly (start end arg) | 982 | (defun gnus-indent-rigidly (start end arg) |
| 992 | "Indent rigidly using only spaces and no tabs." | 983 | "Indent rigidly using only spaces and no tabs." |
| @@ -1580,25 +1571,6 @@ articles. This is not a good idea." | |||
| 1580 | (sexp :format "all" | 1571 | (sexp :format "all" |
| 1581 | :value t))) | 1572 | :value t))) |
| 1582 | 1573 | ||
| 1583 | (defcustom gnus-use-nocem nil | ||
| 1584 | "*If non-nil, Gnus will read NoCeM cancel messages. | ||
| 1585 | You can also set this variable to a positive number as a group level. | ||
| 1586 | In that case, Gnus scans NoCeM messages when checking new news if this | ||
| 1587 | value is not exceeding a group level that you specify as the prefix | ||
| 1588 | argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. | ||
| 1589 | Otherwise, Gnus does not scan NoCeM messages if you specify a group | ||
| 1590 | level to those commands." | ||
| 1591 | :group 'gnus-meta | ||
| 1592 | :type '(choice | ||
| 1593 | (const :tag "off" nil) | ||
| 1594 | (const :tag "on" t) | ||
| 1595 | (list :convert-widget | ||
| 1596 | (lambda (widget) | ||
| 1597 | (list 'integer :tag "group level" | ||
| 1598 | :value (if (boundp 'gnus-level-default-subscribed) | ||
| 1599 | gnus-level-default-subscribed | ||
| 1600 | 3)))))) | ||
| 1601 | |||
| 1602 | (defcustom gnus-suppress-duplicates nil | 1574 | (defcustom gnus-suppress-duplicates nil |
| 1603 | "*If non-nil, Gnus will mark duplicate copies of the same article as read." | 1575 | "*If non-nil, Gnus will mark duplicate copies of the same article as read." |
| 1604 | :group 'gnus-meta | 1576 | :group 'gnus-meta |
| @@ -2813,13 +2785,12 @@ gnus-registry.el will populate this if it's loaded.") | |||
| 2813 | rmail-summary-exists rmail-select-summary) | 2785 | rmail-summary-exists rmail-select-summary) |
| 2814 | ;; Only used in gnus-util, which has an autoload. | 2786 | ;; Only used in gnus-util, which has an autoload. |
| 2815 | ("rmailsum" rmail-update-summary) | 2787 | ("rmailsum" rmail-update-summary) |
| 2816 | ("gnus-audio" :interactive t gnus-audio-play) | ||
| 2817 | ("gnus-xmas" gnus-xmas-splash) | 2788 | ("gnus-xmas" gnus-xmas-splash) |
| 2818 | ("score-mode" :interactive t gnus-score-mode) | 2789 | ("score-mode" :interactive t gnus-score-mode) |
| 2819 | ("gnus-mh" gnus-summary-save-article-folder | 2790 | ("gnus-mh" gnus-summary-save-article-folder |
| 2820 | gnus-Folder-save-name gnus-folder-save-name) | 2791 | gnus-Folder-save-name gnus-folder-save-name) |
| 2821 | ("gnus-mh" :interactive t gnus-summary-save-in-folder) | 2792 | ("gnus-mh" :interactive t gnus-summary-save-in-folder) |
| 2822 | ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail | 2793 | ("gnus-demon" gnus-demon-add-scanmail |
| 2823 | gnus-demon-add-rescan gnus-demon-add-scan-timestamps | 2794 | gnus-demon-add-rescan gnus-demon-add-scan-timestamps |
| 2824 | gnus-demon-add-disconnection gnus-demon-add-handler | 2795 | gnus-demon-add-disconnection gnus-demon-add-handler |
| 2825 | gnus-demon-remove-handler) | 2796 | gnus-demon-remove-handler) |
| @@ -2830,8 +2801,6 @@ gnus-registry.el will populate this if it's loaded.") | |||
| 2830 | gnus-face-from-file) | 2801 | gnus-face-from-file) |
| 2831 | ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree | 2802 | ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree |
| 2832 | gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) | 2803 | gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) |
| 2833 | ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close | ||
| 2834 | gnus-nocem-unwanted-article-p) | ||
| 2835 | ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info | 2804 | ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info |
| 2836 | gnus-server-server-name) | 2805 | gnus-server-server-name) |
| 2837 | ("gnus-srvr" gnus-browse-foreign-server) | 2806 | ("gnus-srvr" gnus-browse-foreign-server) |
| @@ -4395,7 +4364,7 @@ prompt the user for the name of an NNTP server to use." | |||
| 4395 | ;; When using the development version of Gnus, load the gnus-load | 4364 | ;; When using the development version of Gnus, load the gnus-load |
| 4396 | ;; file. | 4365 | ;; file. |
| 4397 | (unless (string-match "^Gnus" gnus-version) | 4366 | (unless (string-match "^Gnus" gnus-version) |
| 4398 | (load "gnus-load")) | 4367 | (load "gnus-load" nil t)) |
| 4399 | (unless (byte-code-function-p (symbol-function 'gnus)) | 4368 | (unless (byte-code-function-p (symbol-function 'gnus)) |
| 4400 | (message "You should byte-compile Gnus") | 4369 | (message "You should byte-compile Gnus") |
| 4401 | (sit-for 2)) | 4370 | (sit-for 2)) |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 948fc08135d..f773c2fea68 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -1147,13 +1147,15 @@ in HANDLE." | |||
| 1147 | ;; time to adjust it, since we know at this point that it should | 1147 | ;; time to adjust it, since we know at this point that it should |
| 1148 | ;; be unibyte. | 1148 | ;; be unibyte. |
| 1149 | `(let* ((handle ,handle)) | 1149 | `(let* ((handle ,handle)) |
| 1150 | (with-temp-buffer | 1150 | (when (and (mm-handle-buffer handle) |
| 1151 | (mm-disable-multibyte) | 1151 | (buffer-name (mm-handle-buffer handle))) |
| 1152 | (insert-buffer-substring (mm-handle-buffer handle)) | 1152 | (with-temp-buffer |
| 1153 | (mm-decode-content-transfer-encoding | 1153 | (mm-disable-multibyte) |
| 1154 | (mm-handle-encoding handle) | 1154 | (insert-buffer-substring (mm-handle-buffer handle)) |
| 1155 | (mm-handle-media-type handle)) | 1155 | (mm-decode-content-transfer-encoding |
| 1156 | ,@forms))) | 1156 | (mm-handle-encoding handle) |
| 1157 | (mm-handle-media-type handle)) | ||
| 1158 | ,@forms)))) | ||
| 1157 | (put 'mm-with-part 'lisp-indent-function 1) | 1159 | (put 'mm-with-part 'lisp-indent-function 1) |
| 1158 | (put 'mm-with-part 'edebug-form-spec '(body)) | 1160 | (put 'mm-with-part 'edebug-form-spec '(body)) |
| 1159 | 1161 | ||
| @@ -1246,9 +1248,13 @@ PROMPT overrides the default one used to ask user for a file name." | |||
| 1246 | (setq filename (gnus-map-function mm-file-name-rewrite-functions | 1248 | (setq filename (gnus-map-function mm-file-name-rewrite-functions |
| 1247 | (file-name-nondirectory filename)))) | 1249 | (file-name-nondirectory filename)))) |
| 1248 | (setq file | 1250 | (setq file |
| 1249 | (read-file-name (or prompt "Save MIME part to: ") | 1251 | (read-file-name (or prompt |
| 1252 | (format "Save MIME part to (default %s): " | ||
| 1253 | (or filename ""))) | ||
| 1250 | (or mm-default-directory default-directory) | 1254 | (or mm-default-directory default-directory) |
| 1251 | nil nil (or filename ""))) | 1255 | (or filename ""))) |
| 1256 | (when (file-directory-p file) | ||
| 1257 | (setq file (expand-file-name filename file))) | ||
| 1252 | (setq mm-default-directory (file-name-directory file)) | 1258 | (setq mm-default-directory (file-name-directory file)) |
| 1253 | (and (or (not (file-exists-p file)) | 1259 | (and (or (not (file-exists-p file)) |
| 1254 | (yes-or-no-p (format "File %s already exists; overwrite? " | 1260 | (yes-or-no-p (format "File %s already exists; overwrite? " |
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index b73162ff131..22eb7b66829 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el | |||
| @@ -57,8 +57,6 @@ | |||
| 57 | (defvar mml1991-function-alist | 57 | (defvar mml1991-function-alist |
| 58 | '((mailcrypt mml1991-mailcrypt-sign | 58 | '((mailcrypt mml1991-mailcrypt-sign |
| 59 | mml1991-mailcrypt-encrypt) | 59 | mml1991-mailcrypt-encrypt) |
| 60 | (gpg mml1991-gpg-sign | ||
| 61 | mml1991-gpg-encrypt) | ||
| 62 | (pgg mml1991-pgg-sign | 60 | (pgg mml1991-pgg-sign |
| 63 | mml1991-pgg-encrypt) | 61 | mml1991-pgg-encrypt) |
| 64 | (epg mml1991-epg-sign | 62 | (epg mml1991-epg-sign |
| @@ -168,99 +166,6 @@ Whether the passphrase is cached at all is controlled by | |||
| 168 | (insert-buffer-substring cipher) | 166 | (insert-buffer-substring cipher) |
| 169 | (goto-char (point-max)))))) | 167 | (goto-char (point-max)))))) |
| 170 | 168 | ||
| 171 | ;;; gpg wrapper | ||
| 172 | |||
| 173 | (autoload 'gpg-sign-cleartext "gpg") | ||
| 174 | |||
| 175 | (declare-function gpg-sign-encrypt "ext:gpg" | ||
| 176 | (plaintext ciphertext result recipients &optional | ||
| 177 | passphrase sign-with-key armor textmode)) | ||
| 178 | (declare-function gpg-encrypt "ext:gpg" | ||
| 179 | (plaintext ciphertext result recipients &optional | ||
| 180 | passphrase armor textmode)) | ||
| 181 | |||
| 182 | (defun mml1991-gpg-sign (cont) | ||
| 183 | (let ((text (current-buffer)) | ||
| 184 | headers signature | ||
| 185 | (result-buffer (get-buffer-create "*GPG Result*"))) | ||
| 186 | ;; Save MIME Content[^ ]+: headers from signing | ||
| 187 | (goto-char (point-min)) | ||
| 188 | (while (looking-at "^Content[^ ]+:") (forward-line)) | ||
| 189 | (unless (bobp) | ||
| 190 | (setq headers (buffer-string)) | ||
| 191 | (delete-region (point-min) (point))) | ||
| 192 | (goto-char (point-max)) | ||
| 193 | (unless (bolp) | ||
| 194 | (insert "\n")) | ||
| 195 | (quoted-printable-decode-region (point-min) (point-max)) | ||
| 196 | (with-temp-buffer | ||
| 197 | (unless (gpg-sign-cleartext text (setq signature (current-buffer)) | ||
| 198 | result-buffer | ||
| 199 | nil | ||
| 200 | (message-options-get 'message-sender)) | ||
| 201 | (unless (> (point-max) (point-min)) | ||
| 202 | (pop-to-buffer result-buffer) | ||
| 203 | (error "Sign error"))) | ||
| 204 | (goto-char (point-min)) | ||
| 205 | (while (re-search-forward "\r+$" nil t) | ||
| 206 | (replace-match "" t t)) | ||
| 207 | (quoted-printable-encode-region (point-min) (point-max)) | ||
| 208 | (set-buffer text) | ||
| 209 | (delete-region (point-min) (point-max)) | ||
| 210 | (if headers (insert headers)) | ||
| 211 | (insert "\n") | ||
| 212 | (insert-buffer-substring signature) | ||
| 213 | (goto-char (point-max))))) | ||
| 214 | |||
| 215 | (defun mml1991-gpg-encrypt (cont &optional sign) | ||
| 216 | (let ((text (current-buffer)) | ||
| 217 | cipher | ||
| 218 | (result-buffer (get-buffer-create "*GPG Result*"))) | ||
| 219 | ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMORED | ||
| 220 | (goto-char (point-min)) | ||
| 221 | (while (looking-at "^Content[^ ]+:") (forward-line)) | ||
| 222 | (unless (bobp) | ||
| 223 | (delete-region (point-min) (point))) | ||
| 224 | (mm-with-unibyte-current-buffer | ||
| 225 | (with-temp-buffer | ||
| 226 | (inline (mm-disable-multibyte)) | ||
| 227 | (flet ((gpg-encrypt-func | ||
| 228 | (sign plaintext ciphertext result recipients &optional | ||
| 229 | passphrase sign-with-key armor textmode) | ||
| 230 | (if sign | ||
| 231 | (gpg-sign-encrypt | ||
| 232 | plaintext ciphertext result recipients passphrase | ||
| 233 | sign-with-key armor textmode) | ||
| 234 | (gpg-encrypt | ||
| 235 | plaintext ciphertext result recipients passphrase | ||
| 236 | armor textmode)))) | ||
| 237 | (unless (gpg-encrypt-func | ||
| 238 | sign | ||
| 239 | text (setq cipher (current-buffer)) | ||
| 240 | result-buffer | ||
| 241 | (split-string | ||
| 242 | (or | ||
| 243 | (message-options-get 'message-recipients) | ||
| 244 | (message-options-set 'message-recipients | ||
| 245 | (read-string "Recipients: "))) | ||
| 246 | "[ \f\t\n\r\v,]+") | ||
| 247 | nil | ||
| 248 | (message-options-get 'message-sender) | ||
| 249 | t t) ; armor & textmode | ||
| 250 | (unless (> (point-max) (point-min)) | ||
| 251 | (pop-to-buffer result-buffer) | ||
| 252 | (error "Encrypt error")))) | ||
| 253 | (goto-char (point-min)) | ||
| 254 | (while (re-search-forward "\r+$" nil t) | ||
| 255 | (replace-match "" t t)) | ||
| 256 | (set-buffer text) | ||
| 257 | (delete-region (point-min) (point-max)) | ||
| 258 | ;;(insert "Content-Type: application/pgp-encrypted\n\n") | ||
| 259 | ;;(insert "Version: 1\n\n") | ||
| 260 | (insert "\n") | ||
| 261 | (insert-buffer-substring cipher) | ||
| 262 | (goto-char (point-max)))))) | ||
| 263 | |||
| 264 | ;; pgg wrapper | 169 | ;; pgg wrapper |
| 265 | 170 | ||
| 266 | (defvar pgg-default-user-id) | 171 | (defvar pgg-default-user-id) |
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 1002f24ea82..391517f38ba 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el | |||
| @@ -63,11 +63,6 @@ | |||
| 63 | (require 'pgg))) | 63 | (require 'pgg))) |
| 64 | (and (fboundp 'pgg-sign-region) | 64 | (and (fboundp 'pgg-sign-region) |
| 65 | 'pgg)) | 65 | 'pgg)) |
| 66 | (progn | ||
| 67 | (ignore-errors | ||
| 68 | (require 'gpg)) | ||
| 69 | (and (fboundp 'gpg-sign-detached) | ||
| 70 | 'gpg)) | ||
| 71 | (progn (ignore-errors | 66 | (progn (ignore-errors |
| 72 | (load "mc-toplev")) | 67 | (load "mc-toplev")) |
| 73 | (and (fboundp 'mc-encrypt-generic) | 68 | (and (fboundp 'mc-encrypt-generic) |
| @@ -75,7 +70,7 @@ | |||
| 75 | (fboundp 'mc-cleanup-recipient-headers) | 70 | (fboundp 'mc-cleanup-recipient-headers) |
| 76 | 'mailcrypt))) | 71 | 'mailcrypt))) |
| 77 | "The package used for PGP/MIME. | 72 | "The package used for PGP/MIME. |
| 78 | Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") | 73 | Valid packages include `epg', `pgg' and `mailcrypt'.") |
| 79 | 74 | ||
| 80 | ;; Something is not RFC2015. | 75 | ;; Something is not RFC2015. |
| 81 | (defvar mml2015-function-alist | 76 | (defvar mml2015-function-alist |
| @@ -85,24 +80,18 @@ Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") | |||
| 85 | mml2015-mailcrypt-decrypt | 80 | mml2015-mailcrypt-decrypt |
| 86 | mml2015-mailcrypt-clear-verify | 81 | mml2015-mailcrypt-clear-verify |
| 87 | mml2015-mailcrypt-clear-decrypt) | 82 | mml2015-mailcrypt-clear-decrypt) |
| 88 | (gpg mml2015-gpg-sign | 83 | (pgg mml2015-pgg-sign |
| 89 | mml2015-gpg-encrypt | 84 | mml2015-pgg-encrypt |
| 90 | mml2015-gpg-verify | 85 | mml2015-pgg-verify |
| 91 | mml2015-gpg-decrypt | 86 | mml2015-pgg-decrypt |
| 92 | mml2015-gpg-clear-verify | 87 | mml2015-pgg-clear-verify |
| 93 | mml2015-gpg-clear-decrypt) | 88 | mml2015-pgg-clear-decrypt) |
| 94 | (pgg mml2015-pgg-sign | 89 | (epg mml2015-epg-sign |
| 95 | mml2015-pgg-encrypt | 90 | mml2015-epg-encrypt |
| 96 | mml2015-pgg-verify | 91 | mml2015-epg-verify |
| 97 | mml2015-pgg-decrypt | 92 | mml2015-epg-decrypt |
| 98 | mml2015-pgg-clear-verify | 93 | mml2015-epg-clear-verify |
| 99 | mml2015-pgg-clear-decrypt) | 94 | mml2015-epg-clear-decrypt)) |
| 100 | (epg mml2015-epg-sign | ||
| 101 | mml2015-epg-encrypt | ||
| 102 | mml2015-epg-verify | ||
| 103 | mml2015-epg-decrypt | ||
| 104 | mml2015-epg-clear-verify | ||
| 105 | mml2015-epg-clear-decrypt)) | ||
| 106 | "Alist of PGP/MIME functions.") | 95 | "Alist of PGP/MIME functions.") |
| 107 | 96 | ||
| 108 | (defvar mml2015-result-buffer nil) | 97 | (defvar mml2015-result-buffer nil) |
| @@ -148,7 +137,7 @@ Whether the passphrase is cached at all is controlled by | |||
| 148 | 137 | ||
| 149 | ;; Extract plaintext from cleartext signature. IMO, this kind of task | 138 | ;; Extract plaintext from cleartext signature. IMO, this kind of task |
| 150 | ;; should be done by GnuPG rather than Elisp, but older PGP backends | 139 | ;; should be done by GnuPG rather than Elisp, but older PGP backends |
| 151 | ;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. | 140 | ;; (such as Mailcrypt, and PGG) discard the output from GnuPG. |
| 152 | (defun mml2015-extract-cleartext-signature () | 141 | (defun mml2015-extract-cleartext-signature () |
| 153 | ;; Daiki Ueno in | 142 | ;; Daiki Ueno in |
| 154 | ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still | 143 | ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still |
| @@ -234,6 +223,58 @@ Whether the passphrase is cached at all is controlled by | |||
| 234 | handles | 223 | handles |
| 235 | (list handles))))) | 224 | (list handles))))) |
| 236 | 225 | ||
| 226 | (defun mml2015-gpg-pretty-print-fpr (fingerprint) | ||
| 227 | (let* ((result "") | ||
| 228 | (fpr-length (string-width fingerprint)) | ||
| 229 | (n-slice 0) | ||
| 230 | slice) | ||
| 231 | (setq fingerprint (string-to-list fingerprint)) | ||
| 232 | (while fingerprint | ||
| 233 | (setq fpr-length (- fpr-length 4)) | ||
| 234 | (setq slice (butlast fingerprint fpr-length)) | ||
| 235 | (setq fingerprint (nthcdr 4 fingerprint)) | ||
| 236 | (setq n-slice (1+ n-slice)) | ||
| 237 | (setq result | ||
| 238 | (concat | ||
| 239 | result | ||
| 240 | (case n-slice | ||
| 241 | (1 slice) | ||
| 242 | (otherwise (concat " " slice)))))) | ||
| 243 | result)) | ||
| 244 | |||
| 245 | (defun mml2015-gpg-extract-signature-details () | ||
| 246 | (goto-char (point-min)) | ||
| 247 | (let* ((expired (re-search-forward | ||
| 248 | "^\\[GNUPG:\\] SIGEXPIRED$" | ||
| 249 | nil t)) | ||
| 250 | (signer (and (re-search-forward | ||
| 251 | "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" | ||
| 252 | nil t) | ||
| 253 | (cons (match-string 1) (match-string 2)))) | ||
| 254 | (fprint (and (re-search-forward | ||
| 255 | "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " | ||
| 256 | nil t) | ||
| 257 | (match-string 1))) | ||
| 258 | (trust (and (re-search-forward | ||
| 259 | "^\\[GNUPG:\\] \\(TRUST_.*\\)$" | ||
| 260 | nil t) | ||
| 261 | (match-string 1))) | ||
| 262 | (trust-good-enough-p | ||
| 263 | (cdr (assoc trust mml2015-unabbrev-trust-alist)))) | ||
| 264 | (cond ((and signer fprint) | ||
| 265 | (concat (cdr signer) | ||
| 266 | (unless trust-good-enough-p | ||
| 267 | (concat "\nUntrusted, Fingerprint: " | ||
| 268 | (mml2015-gpg-pretty-print-fpr fprint))) | ||
| 269 | (when expired | ||
| 270 | (format "\nWARNING: Signature from expired key (%s)" | ||
| 271 | (car signer))))) | ||
| 272 | ((re-search-forward | ||
| 273 | "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) | ||
| 274 | (match-string 2)) | ||
| 275 | (t | ||
| 276 | "From unknown user")))) | ||
| 277 | |||
| 237 | (defun mml2015-mailcrypt-clear-decrypt () | 278 | (defun mml2015-mailcrypt-clear-decrypt () |
| 238 | (let (result) | 279 | (let (result) |
| 239 | (setq result | 280 | (setq result |
| @@ -446,280 +487,6 @@ Whether the passphrase is cached at all is controlled by | |||
| 446 | (insert (format "--%s--\n" boundary)) | 487 | (insert (format "--%s--\n" boundary)) |
| 447 | (goto-char (point-max)))) | 488 | (goto-char (point-max)))) |
| 448 | 489 | ||
| 449 | ;;; gpg wrapper | ||
| 450 | |||
| 451 | (autoload 'gpg-decrypt "gpg") | ||
| 452 | (autoload 'gpg-verify "gpg") | ||
| 453 | (autoload 'gpg-verify-cleartext "gpg") | ||
| 454 | (autoload 'gpg-sign-detached "gpg") | ||
| 455 | (autoload 'gpg-sign-encrypt "gpg") | ||
| 456 | (autoload 'gpg-encrypt "gpg") | ||
| 457 | (autoload 'gpg-passphrase-read "gpg") | ||
| 458 | |||
| 459 | (defun mml2015-gpg-passphrase () | ||
| 460 | (or (message-options-get 'gpg-passphrase) | ||
| 461 | (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) | ||
| 462 | |||
| 463 | (defun mml2015-gpg-decrypt-1 () | ||
| 464 | (let ((cipher (current-buffer)) plain result) | ||
| 465 | (if (with-temp-buffer | ||
| 466 | (prog1 | ||
| 467 | (gpg-decrypt cipher (setq plain (current-buffer)) | ||
| 468 | mml2015-result-buffer nil) | ||
| 469 | (mm-set-handle-multipart-parameter | ||
| 470 | mm-security-handle 'gnus-details | ||
| 471 | (with-current-buffer mml2015-result-buffer | ||
| 472 | (buffer-string))) | ||
| 473 | (set-buffer cipher) | ||
| 474 | (erase-buffer) | ||
| 475 | (insert-buffer-substring plain) | ||
| 476 | (goto-char (point-min)) | ||
| 477 | (while (search-forward "\r\n" nil t) | ||
| 478 | (replace-match "\n" t t)))) | ||
| 479 | '(t) | ||
| 480 | ;; Some wrong with the return value, check plain text buffer. | ||
| 481 | (if (> (point-max) (point-min)) | ||
| 482 | '(t) | ||
| 483 | nil)))) | ||
| 484 | |||
| 485 | (defun mml2015-gpg-decrypt (handle ctl) | ||
| 486 | (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) | ||
| 487 | (mml2015-mailcrypt-decrypt handle ctl))) | ||
| 488 | |||
| 489 | (defun mml2015-gpg-clear-decrypt () | ||
| 490 | (let (result) | ||
| 491 | (setq result (mml2015-gpg-decrypt-1)) | ||
| 492 | (if (car result) | ||
| 493 | (mm-set-handle-multipart-parameter | ||
| 494 | mm-security-handle 'gnus-info "OK") | ||
| 495 | (mm-set-handle-multipart-parameter | ||
| 496 | mm-security-handle 'gnus-info "Failed")))) | ||
| 497 | |||
| 498 | (defun mml2015-gpg-pretty-print-fpr (fingerprint) | ||
| 499 | (let* ((result "") | ||
| 500 | (fpr-length (string-width fingerprint)) | ||
| 501 | (n-slice 0) | ||
| 502 | slice) | ||
| 503 | (setq fingerprint (string-to-list fingerprint)) | ||
| 504 | (while fingerprint | ||
| 505 | (setq fpr-length (- fpr-length 4)) | ||
| 506 | (setq slice (butlast fingerprint fpr-length)) | ||
| 507 | (setq fingerprint (nthcdr 4 fingerprint)) | ||
| 508 | (setq n-slice (1+ n-slice)) | ||
| 509 | (setq result | ||
| 510 | (concat | ||
| 511 | result | ||
| 512 | (case n-slice | ||
| 513 | (1 slice) | ||
| 514 | (otherwise (concat " " slice)))))) | ||
| 515 | result)) | ||
| 516 | |||
| 517 | (defun mml2015-gpg-extract-signature-details () | ||
| 518 | (goto-char (point-min)) | ||
| 519 | (let* ((expired (re-search-forward | ||
| 520 | "^\\[GNUPG:\\] SIGEXPIRED$" | ||
| 521 | nil t)) | ||
| 522 | (signer (and (re-search-forward | ||
| 523 | "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" | ||
| 524 | nil t) | ||
| 525 | (cons (match-string 1) (match-string 2)))) | ||
| 526 | (fprint (and (re-search-forward | ||
| 527 | "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " | ||
| 528 | nil t) | ||
| 529 | (match-string 1))) | ||
| 530 | (trust (and (re-search-forward | ||
| 531 | "^\\[GNUPG:\\] \\(TRUST_.*\\)$" | ||
| 532 | nil t) | ||
| 533 | (match-string 1))) | ||
| 534 | (trust-good-enough-p | ||
| 535 | (cdr (assoc trust mml2015-unabbrev-trust-alist)))) | ||
| 536 | (cond ((and signer fprint) | ||
| 537 | (concat (cdr signer) | ||
| 538 | (unless trust-good-enough-p | ||
| 539 | (concat "\nUntrusted, Fingerprint: " | ||
| 540 | (mml2015-gpg-pretty-print-fpr fprint))) | ||
| 541 | (when expired | ||
| 542 | (format "\nWARNING: Signature from expired key (%s)" | ||
| 543 | (car signer))))) | ||
| 544 | ((re-search-forward | ||
| 545 | "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) | ||
| 546 | (match-string 2)) | ||
| 547 | (t | ||
| 548 | "From unknown user")))) | ||
| 549 | |||
| 550 | (defun mml2015-gpg-verify (handle ctl) | ||
| 551 | (catch 'error | ||
| 552 | (let (part message signature info-is-set-p) | ||
| 553 | (unless (setq part (mm-find-raw-part-by-type | ||
| 554 | ctl (or (mm-handle-multipart-ctl-parameter | ||
| 555 | ctl 'protocol) | ||
| 556 | "application/pgp-signature") | ||
| 557 | t)) | ||
| 558 | (mm-set-handle-multipart-parameter | ||
| 559 | mm-security-handle 'gnus-info "Corrupted") | ||
| 560 | (throw 'error handle)) | ||
| 561 | (with-temp-buffer | ||
| 562 | (setq message (current-buffer)) | ||
| 563 | (insert part) | ||
| 564 | ;; Convert <LF> to <CR><LF> in signed text. If --textmode is | ||
| 565 | ;; specified when signing, the conversion is not necessary. | ||
| 566 | (goto-char (point-min)) | ||
| 567 | (end-of-line) | ||
| 568 | (while (not (eobp)) | ||
| 569 | (unless (eq (char-before) ?\r) | ||
| 570 | (insert "\r")) | ||
| 571 | (forward-line) | ||
| 572 | (end-of-line)) | ||
| 573 | (with-temp-buffer | ||
| 574 | (setq signature (current-buffer)) | ||
| 575 | (unless (setq part (mm-find-part-by-type | ||
| 576 | (cdr handle) "application/pgp-signature" nil t)) | ||
| 577 | (mm-set-handle-multipart-parameter | ||
| 578 | mm-security-handle 'gnus-info "Corrupted") | ||
| 579 | (throw 'error handle)) | ||
| 580 | (mm-insert-part part) | ||
| 581 | (unless (condition-case err | ||
| 582 | (prog1 | ||
| 583 | (gpg-verify message signature mml2015-result-buffer) | ||
| 584 | (mm-set-handle-multipart-parameter | ||
| 585 | mm-security-handle 'gnus-details | ||
| 586 | (with-current-buffer mml2015-result-buffer | ||
| 587 | (buffer-string)))) | ||
| 588 | (error | ||
| 589 | (mm-set-handle-multipart-parameter | ||
| 590 | mm-security-handle 'gnus-details (mml2015-format-error err)) | ||
| 591 | (mm-set-handle-multipart-parameter | ||
| 592 | mm-security-handle 'gnus-info "Error.") | ||
| 593 | (setq info-is-set-p t) | ||
| 594 | nil) | ||
| 595 | (quit | ||
| 596 | (mm-set-handle-multipart-parameter | ||
| 597 | mm-security-handle 'gnus-details "Quit.") | ||
| 598 | (mm-set-handle-multipart-parameter | ||
| 599 | mm-security-handle 'gnus-info "Quit.") | ||
| 600 | (setq info-is-set-p t) | ||
| 601 | nil)) | ||
| 602 | (unless info-is-set-p | ||
| 603 | (mm-set-handle-multipart-parameter | ||
| 604 | mm-security-handle 'gnus-info "Failed")) | ||
| 605 | (throw 'error handle))) | ||
| 606 | (mm-set-handle-multipart-parameter | ||
| 607 | mm-security-handle 'gnus-info | ||
| 608 | (with-current-buffer mml2015-result-buffer | ||
| 609 | (mml2015-gpg-extract-signature-details)))) | ||
| 610 | handle))) | ||
| 611 | |||
| 612 | (defun mml2015-gpg-clear-verify () | ||
| 613 | (if (condition-case err | ||
| 614 | (prog1 | ||
| 615 | (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) | ||
| 616 | (mm-set-handle-multipart-parameter | ||
| 617 | mm-security-handle 'gnus-details | ||
| 618 | (with-current-buffer mml2015-result-buffer | ||
| 619 | (buffer-string)))) | ||
| 620 | (error | ||
| 621 | (mm-set-handle-multipart-parameter | ||
| 622 | mm-security-handle 'gnus-details (mml2015-format-error err)) | ||
| 623 | nil) | ||
| 624 | (quit | ||
| 625 | (mm-set-handle-multipart-parameter | ||
| 626 | mm-security-handle 'gnus-details "Quit.") | ||
| 627 | nil)) | ||
| 628 | (mm-set-handle-multipart-parameter | ||
| 629 | mm-security-handle 'gnus-info | ||
| 630 | (with-current-buffer mml2015-result-buffer | ||
| 631 | (mml2015-gpg-extract-signature-details))) | ||
| 632 | (mm-set-handle-multipart-parameter | ||
| 633 | mm-security-handle 'gnus-info "Failed")) | ||
| 634 | (mml2015-extract-cleartext-signature)) | ||
| 635 | |||
| 636 | (defun mml2015-gpg-sign (cont) | ||
| 637 | (let ((boundary (mml-compute-boundary cont)) | ||
| 638 | (text (current-buffer)) signature) | ||
| 639 | (goto-char (point-max)) | ||
| 640 | (unless (bolp) | ||
| 641 | (insert "\n")) | ||
| 642 | (with-temp-buffer | ||
| 643 | (unless (gpg-sign-detached text (setq signature (current-buffer)) | ||
| 644 | mml2015-result-buffer | ||
| 645 | nil | ||
| 646 | (message-options-get 'message-sender) | ||
| 647 | t t) ; armor & textmode | ||
| 648 | (unless (> (point-max) (point-min)) | ||
| 649 | (pop-to-buffer mml2015-result-buffer) | ||
| 650 | (error "Sign error"))) | ||
| 651 | (goto-char (point-min)) | ||
| 652 | (while (re-search-forward "\r+$" nil t) | ||
| 653 | (replace-match "" t t)) | ||
| 654 | (set-buffer text) | ||
| 655 | (goto-char (point-min)) | ||
| 656 | (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" | ||
| 657 | boundary)) | ||
| 658 | ;;; FIXME: what is the micalg? | ||
| 659 | (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") | ||
| 660 | (insert (format "\n--%s\n" boundary)) | ||
| 661 | (goto-char (point-max)) | ||
| 662 | (insert (format "\n--%s\n" boundary)) | ||
| 663 | (insert "Content-Type: application/pgp-signature\n\n") | ||
| 664 | (insert-buffer-substring signature) | ||
| 665 | (goto-char (point-max)) | ||
| 666 | (insert (format "--%s--\n" boundary)) | ||
| 667 | (goto-char (point-max))))) | ||
| 668 | |||
| 669 | (defun mml2015-gpg-encrypt (cont &optional sign) | ||
| 670 | (let ((boundary (mml-compute-boundary cont)) | ||
| 671 | (text (current-buffer)) | ||
| 672 | cipher) | ||
| 673 | (mm-with-unibyte-current-buffer | ||
| 674 | (with-temp-buffer | ||
| 675 | (mm-disable-multibyte) | ||
| 676 | ;; set up a function to call the correct gpg encrypt routine | ||
| 677 | ;; with the right arguments. (FIXME: this should be done | ||
| 678 | ;; differently.) | ||
| 679 | (flet ((gpg-encrypt-func | ||
| 680 | (sign plaintext ciphertext result recipients &optional | ||
| 681 | passphrase sign-with-key armor textmode) | ||
| 682 | (if sign | ||
| 683 | (gpg-sign-encrypt | ||
| 684 | plaintext ciphertext result recipients passphrase | ||
| 685 | sign-with-key armor textmode) | ||
| 686 | (gpg-encrypt | ||
| 687 | plaintext ciphertext result recipients passphrase | ||
| 688 | armor textmode)))) | ||
| 689 | (unless (gpg-encrypt-func | ||
| 690 | sign ; passed in when using signencrypt | ||
| 691 | text (setq cipher (current-buffer)) | ||
| 692 | mml2015-result-buffer | ||
| 693 | (split-string | ||
| 694 | (or | ||
| 695 | (message-options-get 'message-recipients) | ||
| 696 | (message-options-set 'message-recipients | ||
| 697 | (read-string "Recipients: "))) | ||
| 698 | "[ \f\t\n\r\v,]+") | ||
| 699 | nil | ||
| 700 | (message-options-get 'message-sender) | ||
| 701 | t t) ; armor & textmode | ||
| 702 | (unless (> (point-max) (point-min)) | ||
| 703 | (pop-to-buffer mml2015-result-buffer) | ||
| 704 | (error "Encrypt error")))) | ||
| 705 | (goto-char (point-min)) | ||
| 706 | (while (re-search-forward "\r+$" nil t) | ||
| 707 | (replace-match "" t t)) | ||
| 708 | (set-buffer text) | ||
| 709 | (delete-region (point-min) (point-max)) | ||
| 710 | (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" | ||
| 711 | boundary)) | ||
| 712 | (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") | ||
| 713 | (insert (format "--%s\n" boundary)) | ||
| 714 | (insert "Content-Type: application/pgp-encrypted\n\n") | ||
| 715 | (insert "Version: 1\n\n") | ||
| 716 | (insert (format "--%s\n" boundary)) | ||
| 717 | (insert "Content-Type: application/octet-stream\n\n") | ||
| 718 | (insert-buffer-substring cipher) | ||
| 719 | (goto-char (point-max)) | ||
| 720 | (insert (format "--%s--\n" boundary)) | ||
| 721 | (goto-char (point-max)))))) | ||
| 722 | |||
| 723 | ;;; pgg wrapper | 490 | ;;; pgg wrapper |
| 724 | 491 | ||
| 725 | (defvar pgg-default-user-id) | 492 | (defvar pgg-default-user-id) |
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index d6d455f078f..2eeaeba0512 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el | |||
| @@ -64,9 +64,6 @@ from the document.") | |||
| 64 | (body-end . "") | 64 | (body-end . "") |
| 65 | (file-end . "") | 65 | (file-end . "") |
| 66 | (subtype digest guess)) | 66 | (subtype digest guess)) |
| 67 | (mime-parts | ||
| 68 | (generate-head-function . nndoc-generate-mime-parts-head) | ||
| 69 | (article-transform-function . nndoc-transform-mime-parts)) | ||
| 70 | (nsmail | 67 | (nsmail |
| 71 | (article-begin . "^From - ")) | 68 | (article-begin . "^From - ")) |
| 72 | (news | 69 | (news |
| @@ -77,6 +74,9 @@ from the document.") | |||
| 77 | (mbox | 74 | (mbox |
| 78 | (article-begin-function . nndoc-mbox-article-begin) | 75 | (article-begin-function . nndoc-mbox-article-begin) |
| 79 | (body-end-function . nndoc-mbox-body-end)) | 76 | (body-end-function . nndoc-mbox-body-end)) |
| 77 | (mime-parts | ||
| 78 | (generate-head-function . nndoc-generate-mime-parts-head) | ||
| 79 | (article-transform-function . nndoc-transform-mime-parts)) | ||
| 80 | (babyl | 80 | (babyl |
| 81 | (article-begin . "\^_\^L *\n") | 81 | (article-begin . "\^_\^L *\n") |
| 82 | (body-end . "\^_") | 82 | (body-end . "\^_") |
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 9d22080cc75..b97fe5f8079 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el | |||
| @@ -822,12 +822,16 @@ The first string in ARGS can be a format string." | |||
| 822 | (apply 'format args))) | 822 | (apply 'format args))) |
| 823 | nil) | 823 | nil) |
| 824 | 824 | ||
| 825 | (defun nnheader-get-report (backend) | 825 | (defun nnheader-get-report-string (backend) |
| 826 | "Get the most recent report from BACKEND." | 826 | "Get the most recent report from BACKEND." |
| 827 | (condition-case () | 827 | (condition-case () |
| 828 | (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" | 828 | (format "%s" (symbol-value (intern (format "%s-status-string" |
| 829 | backend)))) | 829 | backend)))) |
| 830 | (error (nnheader-message 5 "")))) | 830 | (error ""))) |
| 831 | |||
| 832 | (defun nnheader-get-report (backend) | ||
| 833 | "Get the most recent report from BACKEND." | ||
| 834 | (nnheader-message 5 (nnheader-get-report-string backend))) | ||
| 831 | 835 | ||
| 832 | (defun nnheader-insert (format &rest args) | 836 | (defun nnheader-insert (format &rest args) |
| 833 | "Clear the communication buffer and insert FORMAT and ARGS into the buffer. | 837 | "Clear the communication buffer and insert FORMAT and ARGS into the buffer. |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 000855db8da..f3cb77f5201 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -62,22 +62,23 @@ Values are `ssl', `network', `starttls' or `shell'.") | |||
| 62 | (defvoo nnimap-inbox nil | 62 | (defvoo nnimap-inbox nil |
| 63 | "The mail box where incoming mail arrives and should be split out of.") | 63 | "The mail box where incoming mail arrives and should be split out of.") |
| 64 | 64 | ||
| 65 | (defvoo nnimap-split-methods nil | ||
| 66 | "How mail is split. | ||
| 67 | Uses the same syntax as nnmail-split-methods") | ||
| 68 | |||
| 65 | (defvoo nnimap-authenticator nil | 69 | (defvoo nnimap-authenticator nil |
| 66 | "How nnimap authenticate itself to the server. | 70 | "How nnimap authenticate itself to the server. |
| 67 | Possible choices are nil (use default methods) or `anonymous'.") | 71 | Possible choices are nil (use default methods) or `anonymous'.") |
| 68 | 72 | ||
| 69 | (defvoo nnimap-fetch-partial-articles nil | ||
| 70 | "If non-nil, nnimap will fetch partial articles. | ||
| 71 | If t, nnimap will fetch only the first part. If a string, it | ||
| 72 | will fetch all parts that have types that match that string. A | ||
| 73 | likely value would be \"text/\" to automatically fetch all | ||
| 74 | textual parts.") | ||
| 75 | |||
| 76 | (defvoo nnimap-expunge t | 73 | (defvoo nnimap-expunge t |
| 77 | "If non-nil, expunge articles after deleting them. | 74 | "If non-nil, expunge articles after deleting them. |
| 78 | This is always done if the server supports UID EXPUNGE, but it's | 75 | This is always done if the server supports UID EXPUNGE, but it's |
| 79 | not done by default on servers that doesn't support that command.") | 76 | not done by default on servers that doesn't support that command.") |
| 80 | 77 | ||
| 78 | (defvoo nnimap-streaming t | ||
| 79 | "If non-nil, try to use streaming commands with IMAP servers. | ||
| 80 | Switching this off will make nnimap slower, but it helps with | ||
| 81 | some servers.") | ||
| 81 | 82 | ||
| 82 | (defvoo nnimap-connection-alist nil) | 83 | (defvoo nnimap-connection-alist nil) |
| 83 | 84 | ||
| @@ -110,8 +111,6 @@ not done by default on servers that doesn't support that command.") | |||
| 110 | (download "gnus-download") | 111 | (download "gnus-download") |
| 111 | (forward "gnus-forward"))) | 112 | (forward "gnus-forward"))) |
| 112 | 113 | ||
| 113 | (defvar nnimap-split-methods nil) | ||
| 114 | |||
| 115 | (defun nnimap-buffer () | 114 | (defun nnimap-buffer () |
| 116 | (nnimap-find-process-buffer nntp-server-buffer)) | 115 | (nnimap-find-process-buffer nntp-server-buffer)) |
| 117 | 116 | ||
| @@ -128,8 +127,7 @@ not done by default on servers that doesn't support that command.") | |||
| 128 | (nnimap-article-ranges (gnus-compress-sequence articles)) | 127 | (nnimap-article-ranges (gnus-compress-sequence articles)) |
| 129 | (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" | 128 | (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" |
| 130 | (format | 129 | (format |
| 131 | (if (member "IMAP4REV1" | 130 | (if (nnimap-ver4-p) |
| 132 | (nnimap-capabilities nnimap-object)) | ||
| 133 | "BODY.PEEK[HEADER.FIELDS %s]" | 131 | "BODY.PEEK[HEADER.FIELDS %s]" |
| 134 | "RFC822.HEADER.LINES %s") | 132 | "RFC822.HEADER.LINES %s") |
| 135 | (append '(Subject From Date Message-Id | 133 | (append '(Subject From Date Message-Id |
| @@ -273,42 +271,50 @@ not done by default on servers that doesn't support that command.") | |||
| 273 | (with-current-buffer (nnimap-make-process-buffer buffer) | 271 | (with-current-buffer (nnimap-make-process-buffer buffer) |
| 274 | (let* ((coding-system-for-read 'binary) | 272 | (let* ((coding-system-for-read 'binary) |
| 275 | (coding-system-for-write 'binary) | 273 | (coding-system-for-write 'binary) |
| 274 | (port nil) | ||
| 276 | (ports | 275 | (ports |
| 277 | (cond | 276 | (cond |
| 278 | ((eq nnimap-stream 'network) | 277 | ((eq nnimap-stream 'network) |
| 279 | (open-network-stream | 278 | (open-network-stream |
| 280 | "*nnimap*" (current-buffer) nnimap-address | 279 | "*nnimap*" (current-buffer) nnimap-address |
| 281 | (or nnimap-server-port | 280 | (setq port |
| 282 | (if (netrc-find-service-number "imap") | 281 | (or nnimap-server-port |
| 283 | "imap" | 282 | (if (netrc-find-service-number "imap") |
| 284 | "143"))) | 283 | "imap" |
| 284 | "143")))) | ||
| 285 | '("143" "imap")) | 285 | '("143" "imap")) |
| 286 | ((eq nnimap-stream 'shell) | 286 | ((eq nnimap-stream 'shell) |
| 287 | (nnimap-open-shell-stream | 287 | (nnimap-open-shell-stream |
| 288 | "*nnimap*" (current-buffer) nnimap-address | 288 | "*nnimap*" (current-buffer) nnimap-address |
| 289 | (or nnimap-server-port "imap")) | 289 | (setq port (or nnimap-server-port "imap"))) |
| 290 | '("imap")) | 290 | '("imap")) |
| 291 | ((eq nnimap-stream 'starttls) | 291 | ((eq nnimap-stream 'starttls) |
| 292 | (starttls-open-stream | 292 | (starttls-open-stream |
| 293 | "*nnimap*" (current-buffer) nnimap-address | 293 | "*nnimap*" (current-buffer) nnimap-address |
| 294 | (or nnimap-server-port "imap")) | 294 | (setq port (or nnimap-server-port "imap"))) |
| 295 | '("imap")) | 295 | '("imap")) |
| 296 | ((eq nnimap-stream 'ssl) | 296 | ((eq nnimap-stream 'ssl) |
| 297 | (open-tls-stream | 297 | (open-tls-stream |
| 298 | "*nnimap*" (current-buffer) nnimap-address | 298 | "*nnimap*" (current-buffer) nnimap-address |
| 299 | (or nnimap-server-port | 299 | (setq port |
| 300 | (if (netrc-find-service-number "imaps") | 300 | (or nnimap-server-port |
| 301 | "imaps" | 301 | (if (netrc-find-service-number "imaps") |
| 302 | "993"))) | 302 | "imaps" |
| 303 | "993")))) | ||
| 303 | '("143" "993" "imap" "imaps")))) | 304 | '("143" "993" "imap" "imaps")))) |
| 304 | connection-result login-result credentials) | 305 | connection-result login-result credentials) |
| 305 | (setf (nnimap-process nnimap-object) | 306 | (setf (nnimap-process nnimap-object) |
| 306 | (get-buffer-process (current-buffer))) | 307 | (get-buffer-process (current-buffer))) |
| 307 | (when (and (nnimap-process nnimap-object) | 308 | (if (not (and (nnimap-process nnimap-object) |
| 308 | (memq (process-status (nnimap-process nnimap-object)) | 309 | (memq (process-status (nnimap-process nnimap-object)) |
| 309 | '(open run))) | 310 | '(open run)))) |
| 311 | (nnheader-report 'nnimap "Unable to contact %s:%s via %s" | ||
| 312 | nnimap-address port nnimap-stream) | ||
| 310 | (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) | 313 | (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) |
| 311 | (when (setq connection-result (nnimap-wait-for-connection)) | 314 | (if (not (setq connection-result (nnimap-wait-for-connection))) |
| 315 | (nnheader-report 'nnimap | ||
| 316 | "%s" (buffer-substring | ||
| 317 | (point) (line-end-position))) | ||
| 312 | (when (eq nnimap-stream 'starttls) | 318 | (when (eq nnimap-stream 'starttls) |
| 313 | (nnimap-command "STARTTLS") | 319 | (nnimap-command "STARTTLS") |
| 314 | (starttls-negotiate (nnimap-process nnimap-object))) | 320 | (starttls-negotiate (nnimap-process nnimap-object))) |
| @@ -370,7 +376,7 @@ not done by default on servers that doesn't support that command.") | |||
| 370 | (deffoo nnimap-request-article (article &optional group server to-buffer) | 376 | (deffoo nnimap-request-article (article &optional group server to-buffer) |
| 371 | (with-current-buffer nntp-server-buffer | 377 | (with-current-buffer nntp-server-buffer |
| 372 | (let ((result (nnimap-possibly-change-group group server)) | 378 | (let ((result (nnimap-possibly-change-group group server)) |
| 373 | parts) | 379 | parts structure) |
| 374 | (when (stringp article) | 380 | (when (stringp article) |
| 375 | (setq article (nnimap-find-article-by-message-id group article))) | 381 | (setq article (nnimap-find-article-by-message-id group article))) |
| 376 | (when (and result | 382 | (when (and result |
| @@ -378,36 +384,113 @@ not done by default on servers that doesn't support that command.") | |||
| 378 | (erase-buffer) | 384 | (erase-buffer) |
| 379 | (with-current-buffer (nnimap-buffer) | 385 | (with-current-buffer (nnimap-buffer) |
| 380 | (erase-buffer) | 386 | (erase-buffer) |
| 381 | (when nnimap-fetch-partial-articles | 387 | (when gnus-fetch-partial-articles |
| 382 | (if (eq nnimap-fetch-partial-articles t) | 388 | (if (eq gnus-fetch-partial-articles t) |
| 383 | (setq parts '(1)) | 389 | (setq parts '(1)) |
| 384 | (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) | 390 | (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) |
| 385 | (goto-char (point-min)) | 391 | (goto-char (point-min)) |
| 386 | (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) | 392 | (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) |
| 387 | (let ((structure (ignore-errors (read (current-buffer))))) | 393 | (setq structure (ignore-errors (read (current-buffer))) |
| 388 | (setq parts (nnimap-find-wanted-parts structure)))))) | 394 | parts (nnimap-find-wanted-parts structure))))) |
| 389 | (setq result | 395 | (when (if parts |
| 390 | (nnimap-command | 396 | (nnimap-get-partial-article article parts structure) |
| 391 | (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) | 397 | (nnimap-get-whole-article article)) |
| 392 | "UID FETCH %d BODY.PEEK[]" | 398 | (let ((buffer (current-buffer))) |
| 393 | "UID FETCH %d RFC822.PEEK") | 399 | (with-current-buffer (or to-buffer nntp-server-buffer) |
| 394 | article)) | 400 | (erase-buffer) |
| 395 | ;; Check that we really got an article. | 401 | (insert-buffer-substring buffer) |
| 396 | (goto-char (point-min)) | 402 | (nnheader-ms-strip-cr) |
| 397 | (unless (looking-at "\\* [0-9]+ FETCH") | 403 | (cons group article))))))))) |
| 398 | (setq result nil))) | 404 | |
| 399 | (let ((buffer (nnimap-find-process-buffer (current-buffer)))) | 405 | (defun nnimap-get-whole-article (article) |
| 400 | (when (car result) | 406 | (let ((result |
| 401 | (with-current-buffer (or to-buffer nntp-server-buffer) | 407 | (nnimap-command |
| 402 | (insert-buffer-substring buffer) | 408 | (if (nnimap-ver4-p) |
| 403 | (goto-char (point-min)) | 409 | "UID FETCH %d BODY.PEEK[]" |
| 404 | (let ((bytes (nnimap-get-length))) | 410 | "UID FETCH %d RFC822.PEEK") |
| 405 | (delete-region (line-beginning-position) | 411 | article))) |
| 406 | (progn (forward-line 1) (point))) | 412 | ;; Check that we really got an article. |
| 407 | (goto-char (+ (point) bytes)) | 413 | (goto-char (point-min)) |
| 408 | (delete-region (point) (point-max)) | 414 | (unless (looking-at "\\* [0-9]+ FETCH") |
| 409 | (nnheader-ms-strip-cr)) | 415 | (setq result nil)) |
| 410 | (cons group article)))))))) | 416 | (when result |
| 417 | (goto-char (point-min)) | ||
| 418 | (let ((bytes (nnimap-get-length))) | ||
| 419 | (delete-region (line-beginning-position) | ||
| 420 | (progn (forward-line 1) (point))) | ||
| 421 | (goto-char (+ (point) bytes)) | ||
| 422 | (delete-region (point) (point-max))) | ||
| 423 | t))) | ||
| 424 | |||
| 425 | (defun nnimap-ver4-p () | ||
| 426 | (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) | ||
| 427 | |||
| 428 | (defun nnimap-get-partial-article (article parts structure) | ||
| 429 | (let ((result | ||
| 430 | (nnimap-command | ||
| 431 | "UID FETCH %d (%s %s)" | ||
| 432 | article | ||
| 433 | (if (nnimap-ver4-p) | ||
| 434 | "BODY.PEEK[HEADER]" | ||
| 435 | "RFC822.HEADER") | ||
| 436 | (if (nnimap-ver4-p) | ||
| 437 | (mapconcat (lambda (part) | ||
| 438 | (format "BODY.PEEK[%s]" part)) | ||
| 439 | parts " ") | ||
| 440 | (mapconcat (lambda (part) | ||
| 441 | (format "RFC822.PEEK[%s]" part)) | ||
| 442 | parts " "))))) | ||
| 443 | (when result | ||
| 444 | (nnimap-convert-partial-article structure)))) | ||
| 445 | |||
| 446 | (defun nnimap-convert-partial-article (structure) | ||
| 447 | ;; First just skip past the headers. | ||
| 448 | (goto-char (point-min)) | ||
| 449 | (let ((bytes (nnimap-get-length)) | ||
| 450 | id parts) | ||
| 451 | ;; Delete "FETCH" line. | ||
| 452 | (delete-region (line-beginning-position) | ||
| 453 | (progn (forward-line 1) (point))) | ||
| 454 | (goto-char (+ (point) bytes)) | ||
| 455 | ;; Collect all the body parts. | ||
| 456 | (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]") | ||
| 457 | (setq id (match-string 1) | ||
| 458 | bytes (nnimap-get-length)) | ||
| 459 | (beginning-of-line) | ||
| 460 | (delete-region (point) (progn (forward-line 1) (point))) | ||
| 461 | (push (list id (buffer-substring (point) (+ (point) bytes))) | ||
| 462 | parts) | ||
| 463 | (delete-region (point) (+ (point) bytes))) | ||
| 464 | ;; Delete trailing junk. | ||
| 465 | (delete-region (point) (point-max)) | ||
| 466 | ;; Now insert all the parts again where they fit in the structure. | ||
| 467 | (nnimap-insert-partial-structure structure parts) | ||
| 468 | t)) | ||
| 469 | |||
| 470 | (defun nnimap-insert-partial-structure (structure parts &optional subp) | ||
| 471 | (let ((type (car (last structure 4))) | ||
| 472 | (boundary (cadr (member "BOUNDARY" (car (last structure 3)))))) | ||
| 473 | (when subp | ||
| 474 | (insert (format "Content-type: multipart/%s; boundary=%S\n\n" | ||
| 475 | (downcase type) boundary))) | ||
| 476 | (while (not (stringp (car structure))) | ||
| 477 | (insert "\n--" boundary "\n") | ||
| 478 | (if (consp (caar structure)) | ||
| 479 | (nnimap-insert-partial-structure (pop structure) parts t) | ||
| 480 | (let ((bit (pop structure))) | ||
| 481 | (insert (format "Content-type: %s/%s" | ||
| 482 | (downcase (nth 0 bit)) | ||
| 483 | (downcase (nth 1 bit)))) | ||
| 484 | (if (member "CHARSET" (nth 2 bit)) | ||
| 485 | (insert (format | ||
| 486 | "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit))))) | ||
| 487 | (insert "\n")) | ||
| 488 | (insert (format "Content-transfer-encoding: %s\n" | ||
| 489 | (nth 5 bit))) | ||
| 490 | (insert "\n") | ||
| 491 | (when (assoc (nth 9 bit) parts) | ||
| 492 | (insert (cadr (assoc (nth 9 bit) parts))))))) | ||
| 493 | (insert "\n--" boundary "--\n"))) | ||
| 411 | 494 | ||
| 412 | (defun nnimap-find-wanted-parts (structure) | 495 | (defun nnimap-find-wanted-parts (structure) |
| 413 | (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) | 496 | (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) |
| @@ -423,13 +506,14 @@ not done by default on servers that doesn't support that command.") | |||
| 423 | (number-to-string num) | 506 | (number-to-string num) |
| 424 | (format "%s.%s" prefix num))) | 507 | (format "%s.%s" prefix num))) |
| 425 | parts) | 508 | parts) |
| 426 | (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) | 509 | (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))) |
| 427 | (when (string-match nnimap-fetch-partial-articles type) | 510 | (id (if (string= prefix "") |
| 428 | (push (if (string= prefix "") | ||
| 429 | (number-to-string num) | 511 | (number-to-string num) |
| 430 | (format "%s.%s" prefix num)) | 512 | (format "%s.%s" prefix num)))) |
| 431 | parts))) | 513 | (setcar (nthcdr 9 sub) id) |
| 432 | (incf num)))) | 514 | (when (string-match gnus-fetch-partial-articles type) |
| 515 | (push id parts)))) | ||
| 516 | (incf num))) | ||
| 433 | (nreverse parts))) | 517 | (nreverse parts))) |
| 434 | 518 | ||
| 435 | (deffoo nnimap-request-group (group &optional server dont-check info) | 519 | (deffoo nnimap-request-group (group &optional server dont-check info) |
| @@ -777,7 +861,12 @@ not done by default on servers that doesn't support that command.") | |||
| 777 | (nnimap-send-command "UID FETCH %d:* FLAGS" start) | 861 | (nnimap-send-command "UID FETCH %d:* FLAGS" start) |
| 778 | start | 862 | start |
| 779 | (car elem)) | 863 | (car elem)) |
| 780 | sequences)))) | 864 | sequences))) |
| 865 | ;; Some servers apparently can't have many outstanding | ||
| 866 | ;; commands, so throttle them. | ||
| 867 | (when (and (not nnimap-streaming) | ||
| 868 | (car sequences)) | ||
| 869 | (nnimap-wait-for-response (caar sequences)))) | ||
| 781 | sequences)))) | 870 | sequences)))) |
| 782 | 871 | ||
| 783 | (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) | 872 | (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) |
| @@ -785,26 +874,26 @@ not done by default on servers that doesn't support that command.") | |||
| 785 | (nnimap-possibly-change-group nil server)) | 874 | (nnimap-possibly-change-group nil server)) |
| 786 | (with-current-buffer (nnimap-buffer) | 875 | (with-current-buffer (nnimap-buffer) |
| 787 | ;; Wait for the final data to trickle in. | 876 | ;; Wait for the final data to trickle in. |
| 788 | (nnimap-wait-for-response (cadar sequences)) | 877 | (when (nnimap-wait-for-response (cadar sequences)) |
| 789 | ;; Now we should have all the data we need, no matter whether | 878 | ;; Now we should have all the data we need, no matter whether |
| 790 | ;; we're QRESYNCING, fetching all the flags from scratch, or | 879 | ;; we're QRESYNCING, fetching all the flags from scratch, or |
| 791 | ;; just fetching the last 100 flags per group. | 880 | ;; just fetching the last 100 flags per group. |
| 792 | (nnimap-update-infos (nnimap-flags-to-marks | 881 | (nnimap-update-infos (nnimap-flags-to-marks |
| 793 | (nnimap-parse-flags | 882 | (nnimap-parse-flags |
| 794 | (nreverse sequences))) | 883 | (nreverse sequences))) |
| 795 | infos) | 884 | infos) |
| 796 | ;; Finally, just return something resembling an active file in | 885 | ;; Finally, just return something resembling an active file in |
| 797 | ;; the nntp buffer, so that the agent can save the info, too. | 886 | ;; the nntp buffer, so that the agent can save the info, too. |
| 798 | (with-current-buffer nntp-server-buffer | 887 | (with-current-buffer nntp-server-buffer |
| 799 | (erase-buffer) | 888 | (erase-buffer) |
| 800 | (dolist (info infos) | 889 | (dolist (info infos) |
| 801 | (let* ((group (gnus-info-group info)) | 890 | (let* ((group (gnus-info-group info)) |
| 802 | (active (gnus-active group))) | 891 | (active (gnus-active group))) |
| 803 | (when active | 892 | (when active |
| 804 | (insert (format "%S %d %d y\n" | 893 | (insert (format "%S %d %d y\n" |
| 805 | (gnus-group-real-name group) | 894 | (gnus-group-real-name group) |
| 806 | (cdr active) | 895 | (cdr active) |
| 807 | (car active)))))))))) | 896 | (car active))))))))))) |
| 808 | 897 | ||
| 809 | (defun nnimap-update-infos (flags infos) | 898 | (defun nnimap-update-infos (flags infos) |
| 810 | (dolist (info infos) | 899 | (dolist (info infos) |
| @@ -1045,17 +1134,22 @@ not done by default on servers that doesn't support that command.") | |||
| 1045 | (match-string 1)))) | 1134 | (match-string 1)))) |
| 1046 | 1135 | ||
| 1047 | (defun nnimap-wait-for-response (sequence &optional messagep) | 1136 | (defun nnimap-wait-for-response (sequence &optional messagep) |
| 1048 | (let ((process (get-buffer-process (current-buffer)))) | 1137 | (let ((process (get-buffer-process (current-buffer))) |
| 1138 | openp) | ||
| 1049 | (goto-char (point-max)) | 1139 | (goto-char (point-max)) |
| 1050 | (while (and (memq (process-status process) | 1140 | (while (and (setq openp (memq (process-status process) |
| 1051 | '(open run)) | 1141 | '(open run))) |
| 1052 | (not (re-search-backward (format "^%d .*\n" sequence) | 1142 | (not (re-search-backward |
| 1053 | (max (point-min) (- (point) 500)) | 1143 | (format "^%d .*\n" sequence) |
| 1054 | t))) | 1144 | (if nnimap-streaming |
| 1145 | (max (point-min) (- (point) 500)) | ||
| 1146 | (point-min)) | ||
| 1147 | t))) | ||
| 1055 | (when messagep | 1148 | (when messagep |
| 1056 | (message "Read %dKB" (/ (buffer-size) 1000))) | 1149 | (message "Read %dKB" (/ (buffer-size) 1000))) |
| 1057 | (nnheader-accept-process-output process) | 1150 | (nnheader-accept-process-output process) |
| 1058 | (goto-char (point-max))))) | 1151 | (goto-char (point-max))) |
| 1152 | openp)) | ||
| 1059 | 1153 | ||
| 1060 | (defun nnimap-parse-response () | 1154 | (defun nnimap-parse-response () |
| 1061 | (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) | 1155 | (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) |
| @@ -1129,8 +1223,7 @@ not done by default on servers that doesn't support that command.") | |||
| 1129 | (nnimap-article-ranges articles) | 1223 | (nnimap-article-ranges articles) |
| 1130 | (format "(UID %s%s)" | 1224 | (format "(UID %s%s)" |
| 1131 | (format | 1225 | (format |
| 1132 | (if (member "IMAP4REV1" | 1226 | (if (nnimap-ver4-p) |
| 1133 | (nnimap-capabilities nnimap-object)) | ||
| 1134 | "BODY.PEEK[HEADER] BODY.PEEK" | 1227 | "BODY.PEEK[HEADER] BODY.PEEK" |
| 1135 | "RFC822.PEEK")) | 1228 | "RFC822.PEEK")) |
| 1136 | (if nnimap-split-download-body-default | 1229 | (if nnimap-split-download-body-default |