aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGnus developers2010-09-26 04:03:19 +0000
committerKatsumi Yamaoka2010-09-26 04:03:19 +0000
commit8ccbef23ea624d892bada3c66ef2339ada342997 (patch)
treeb8baaa6929a0742ffd301529bcc27001dd08e031
parent83e245c4906513429cb56629485deb5f04a240a3 (diff)
downloademacs-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.texi12
-rw-r--r--doc/misc/gnus.texi1107
-rw-r--r--lisp/gnus/earcon.el230
-rw-r--r--lisp/gnus/gnus-art.el120
-rw-r--r--lisp/gnus/gnus-audio.el149
-rw-r--r--lisp/gnus/gnus-cus.el5
-rw-r--r--lisp/gnus/gnus-demon.el9
-rw-r--r--lisp/gnus/gnus-group.el16
-rw-r--r--lisp/gnus/gnus-html.el9
-rw-r--r--lisp/gnus/gnus-int.el68
-rw-r--r--lisp/gnus/gnus-nocem.el452
-rw-r--r--lisp/gnus/gnus-srvr.el62
-rw-r--r--lisp/gnus/gnus-start.el15
-rw-r--r--lisp/gnus/gnus-sum.el25
-rw-r--r--lisp/gnus/gnus.el37
-rw-r--r--lisp/gnus/mm-decode.el24
-rw-r--r--lisp/gnus/mml1991.el95
-rw-r--r--lisp/gnus/mml2015.el365
-rw-r--r--lisp/gnus/nndoc.el6
-rw-r--r--lisp/gnus/nnheader.el12
-rw-r--r--lisp/gnus/nnimap.el269
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
253Browse 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
336moving articles to a group that has not turned auto-expire on. 346moving 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
710Other Sources 701Other 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
1638Message displayed by Gnus when no groups are available. 1628Message displayed by Gnus when no groups are available.
1639 1629
1640@item gnus-play-startup-jingle
1641@vindex gnus-play-startup-jingle
1642If non-@code{nil}, play the Gnus jingle at startup.
1643
1644@item gnus-startup-jingle
1645@vindex gnus-startup-jingle
1646Jingle to be played if the above variable is non-@code{nil}. The
1647default 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
1651If non-@code{nil}, Gnus will store article marks both in the 1632If 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
3620Unsubscribe to the current group, or, as will be the case here, 3602Unsubscribe to the current group, or, as will be the case here,
3621subscribe to it (@code{gnus-browse-unsubscribe-current-group}). 3603subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You
3604can affect the way the new group is entered into the Group buffer
3605using 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.
10086An alist of @code{(RATE . REGEXP)} pairs used by the function 10071An 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
10093The function to use for displaying CTAN links. It must take one
10094argument, the string naming the URL.
10095
10096@item gnus-ctan-url
10097@vindex gnus-ctan-url
10098Top directory of a CTAN (Comprehensive TeX Archive Network) archive used
10099by @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
10175Controls the display of references to @TeX{} or LaTeX stuff, e.g. for CTAN
10176URLs. 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
10829be run just before printing the buffer. An alternative way to print 10794be run just before printing the buffer. An alternative way to print
10830article is to use Muttprint (@pxref{Saving Articles}). 10795article 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
10800If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will
10801fetch partial articles, if the backend it fetches them from supports
10802it. Currently only @code{nnimap} does. If you're looking at a
10803partial article, and want to see the complete article instead, then
10804the @kbd{A C} command (@code{gnus-summary-show-complete-article}) will
10805do 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
11877posted it to several groups separately. Posting the same article to 11852posted it to several groups separately. Posting the same article to
11878several groups (not cross-posting) is called @dfn{spamming}, and you are 11853several groups (not cross-posting) is called @dfn{spamming}, and you are
11879by law required to send nasty-grams to anyone who perpetrates such a 11854by law required to send nasty-grams to anyone who perpetrates such a
11880heinous crime. You may want to try NoCeM handling to filter out spam 11855heinous crime.
11881(@pxref{NoCeM}).
11882 11856
11883Remember: Cross-posting is kinda ok, but posting the same article 11857Remember: Cross-posting is kinda ok, but posting the same article
11884separately to several groups is not. Massive cross-posting (aka. 11858separately 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
12009install an OpenPGP implementation such as GnuPG. The Lisp interface 11983install an OpenPGP implementation such as GnuPG. The Lisp interface
12010to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG, 11984to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG,
12011epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg, 11985epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg,
12012PGG Manual}), Mailcrypt, and gpg.el are also supported. 11986PGG Manual}), and Mailcrypt are also supported.
12013 11987
12014@item 11988@item
12015To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6 11989To 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
12049Symbol indicating elisp interface to OpenPGP implementation for 12023Symbol 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 12025and @code{mailcrypt} are also supported although
12052deprecated. By default, Gnus uses the first available interface in 12026deprecated. By default, Gnus uses the first available interface in
12053this order. 12027this order.
12054 12028
@@ -12056,7 +12030,7 @@ this order.
12056@vindex mml2015-use 12030@vindex mml2015-use
12057Symbol indicating elisp interface to OpenPGP implementation for 12031Symbol 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
12060although deprecated. By default, Gnus uses the first available 12034although deprecated. By default, Gnus uses the first available
12061interface in this order. 12035interface 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
14141Remove all marks to whether Gnus was denied connection from any servers 14115Remove 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
14121Copy a server and give it a new name
14122(@code{gnus-server-copy-server}). This can be useful if you have a
14123complex method definition, and want to use the same definition towards
14124a 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
14794The most popular mail backend is probably @code{nnimap}, which
14795provides access to @acronym{IMAP} servers. @acronym{IMAP} servers
14796store mail remotely, so the client doesn't store anything locally.
14797This means that it's a convenient choice when you're reading your mail
14798from 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
14810Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the
14811group buffer, or (if your primary interest is reading email), say
14812something like:
14813
14814@example
14815(setq gnus-select-method
14816 '(nnimap "imap.gmail.com"))
14817@end example
14818
14819You'll be prompted for a user name and password. If you grow tired of
14820that, then add the following to your @file{~/.authinfo} file:
14821
14822@example
14823machine imap.gmail.com login <username> password <password> port imap
14824@end example
14825
14826That should basically be it for most users.
14827
14828
14829@node Customizing the @acronym{IMAP} Connection
14830@subsection Customizing the @acronym{IMAP} Connection
14831
14832Here'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
14846The address of the server, like @samp{imap.gmail.com}.
14847
14848@item nnimap-server-port
14849If the server uses a non-standard port, that can be specified here. A
14850typical port would be @samp{imap} or @samp{imaps}.
14851
14852@item nnimap-stream
14853How @code{nnimap} should connect to the server. Possible values are:
14854
14855@table @code
14856@item ssl
14857This is the default, and this uses standard
14858@acronym{TLS}/@acronym{SSL} connection.
14859
14860@item network
14861Non-encrypted and unsafe straight socket connection.
14862
14863@item starttls
14864Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port.
14865
14866@item shell
14867If you need to tunnel via other systems to connect to the server, you
14868can use this option, and customize @code{nnimap-shell-program} to be
14869what you need.
14870
14871@end table
14872
14873@item nnimap-authenticator
14874Some @acronym{IMAP} servers allow anonymous logins. In that case,
14875this should be set to @code{anonymous}.
14876
14877@item nnimap-streaming
14878Virtually all @code{IMAP} server support fast streaming of data. If
14879you 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
14887Many people prefer to do the sorting/splitting of mail into their mail
14888boxes on the @acronym{IMAP} server. That way they don't have to
14889download the mail they're not all that interested in.
14890
14891If you do want to do client-side mail splitting, then the following
14892variables are relevant:
14893
14894@table @code
14895@item nnimap-inbox
14896This is the @acronym{IMAP} mail box that will be scanned for new mail.
14897
14898@item nnimap-split-methods
14899Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting
14900Mail}).
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
15364with nnimap), for some reason or other, Gnus let you treat it similar 15461with nnimap), for some reason or other, Gnus let you treat it similar
15365to a @acronym{POP} server and fetches articles from a given 15462to 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
15368Note that for the Kerberos, GSSAPI, @acronym{TLS}/@acronym{SSL} and STARTTLS support you
15369may need external programs and libraries, @xref{IMAP}.
15370 15464
15371Keywords: 15465Keywords:
15372 15466
@@ -15835,7 +15929,7 @@ after @code{save-excursion} and @code{save-restriction} in the example
15835above. Also note that with the nnimap backend, message bodies will 15929above. Also note that with the nnimap backend, message bodies will
15836not be downloaded by default. You need to set 15930not 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})
15841If the split is a list, and the first element is @code{!}, then 15935If 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
17724follow the link. 17819follow 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{}),
17733think of it as a modernized @acronym{NNTP}. Connecting to a @acronym{IMAP}
17734server is much similar to connecting to a news server, you just
17735specify the network address of the server.
17736
17737@acronym{IMAP} has two properties. First, @acronym{IMAP} can do
17738everything that @acronym{POP} can, it can hence be viewed as a
17739@acronym{POP++}. Secondly, @acronym{IMAP} is a mail storage protocol,
17740similar to @acronym{NNTP} being a news storage protocol---however,
17741@acronym{IMAP} offers more features than @acronym{NNTP} because news
17742is more or less read-only whereas mail is read-write.
17743
17744If you want to use @acronym{IMAP} as a @acronym{POP++}, use an imap
17745entry in @code{mail-sources}. With this, Gnus will fetch mails from
17746the @acronym{IMAP} server and store them on the local disk. This is
17747not the usage described in this section---@xref{Mail Sources}.
17748
17749If you want to use @acronym{IMAP} as a mail storage protocol, use an nnimap
17750entry in @code{gnus-secondary-select-methods}. With this, Gnus will
17751manipulate mails stored on the @acronym{IMAP} server. This is the kind of
17752usage explained in this section.
17753
17754A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP}
17755servers might look something like the following. (Note that for
17756@acronym{TLS}/@acronym{SSL}, you need external programs and libraries,
17757see 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
17783After defining the new server, you can subscribe to groups on the
17784server 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
17788The following variables can be used to create a virtual @code{nnimap}
17789server:
17790
17791@table @code
17792
17793@item nnimap-address
17794@vindex nnimap-address
17795
17796The address of the remote @acronym{IMAP} server. Defaults to the virtual
17797server name if not specified.
17798
17799@item nnimap-server-port
17800@vindex nnimap-server-port
17801Port on server to contact. Defaults to port 143, or 993 for @acronym{TLS}/@acronym{SSL}.
17802
17803Note 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
17812String or list of strings of mailboxes to limit available groups to.
17813This is used when the server has very many mailboxes and you're only
17814interested 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
17818The string can also be a cons of REFERENCE and the string as above, what
17819REFERENCE is used for is server specific, but on the University of
17820Washington server it's a directory that will be concatenated with the
17821mailbox.
17822
17823Example 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
17833The type of stream used to connect to your server. By default, nnimap
17834will detect and automatically use all of the below, with the exception
17835of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over
17836@acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can
17837be automatically detected, but it's not widely deployed yet.)
17838
17839Example server specification:
17840
17841@lisp
17842(nnimap "mail.server.com"
17843 (nnimap-stream ssl))
17844@end lisp
17845
17846Please 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
17871The @samp{imtest} program is shipped with Cyrus IMAPD. If you're
17872using @samp{imtest} from Cyrus IMAPD < 2.0.14 (which includes version
178731.5.x and 1.6.x) you need to frob @code{imap-process-connection-type}
17874to make @code{imap.el} use a pty instead of a pipe when communicating
17875with @samp{imtest}. You will then suffer from a line length
17876restrictions on @acronym{IMAP} commands, which might make Gnus seem to hang
17877indefinitely if you have many articles in a mailbox. The variable
17878@code{imap-kerberos4-program} contain parameters to pass to the imtest
17879program.
17880
17881For @acronym{TLS} connection, the @code{gnutls-cli} program from GNUTLS is
17882needed. It is available from
17883@uref{http://www.gnu.org/software/gnutls/}.
17884
17885@vindex imap-gssapi-program
17886This parameter specifies a list of command lines that invoke a GSSAPI
17887authenticated @acronym{IMAP} stream in a subshell. They are tried
17888sequentially until a connection is made, or the list has been
17889exhausted. By default, @samp{gsasl} from GNU SASL, available from
17890@uref{http://www.gnu.org/software/gsasl/}, and the @samp{imtest}
17891program from Cyrus IMAPD (see @code{imap-kerberos4-program}), are
17892tried.
17893
17894@vindex imap-ssl-program
17895For @acronym{SSL} connections, the OpenSSL program is available from
17896@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay,
17897and nnimap support it too---although the most recent versions of
17898SSLeay, 0.9.x, are known to have serious bugs making it
17899useless. Earlier versions, especially 0.8.x, of SSLeay are known to
17900work. The variable @code{imap-ssl-program} contain parameters to pass
17901to OpenSSL/SSLeay.
17902
17903@vindex imap-shell-program
17904@vindex imap-shell-host
17905For @acronym{IMAP} connections using the @code{shell} stream, the
17906variable @code{imap-shell-program} specify what program to call. Make
17907sure nothing is interfering with the output of the program, e.g., don't
17908forget to redirect the error output to the void.
17909
17910@item nnimap-authenticator
17911@vindex nnimap-authenticator
17912
17913The authenticator used to connect to the server. By default, nnimap
17914will use the most secure authenticator your server is capable of.
17915
17916Example server specification:
17917
17918@lisp
17919(nnimap "mail.server.com"
17920 (nnimap-authenticator anonymous))
17921@end lisp
17922
17923Please 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
17928external 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
17934external 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
17946Unlike Parmenides the @acronym{IMAP} designers have decided things that
17947don't exist actually do exist. More specifically, @acronym{IMAP} has
17948this concept of marking articles @code{Deleted} which doesn't actually
17949delete them, and this (marking them @code{Deleted}, that is) is what
17950nnimap does when you delete an article in Gnus (with @kbd{B DEL} or
17951similar).
17952
17953Since 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
17955running in circles yet?
17956
17957Traditionally, nnimap has removed all articles marked as @code{Deleted}
17958when closing a mailbox but this is now configurable by this server
17959variable.
17960
17961The possible options are:
17962
17963@table @code
17964
17965@item always
17966The default behavior, delete all articles marked as ``Deleted'' when
17967closing a mailbox.
17968@item never
17969Never actually delete articles. Currently there is no way of showing
17970the articles marked for deletion in nnimap, but other @acronym{IMAP} clients
17971may allow you to do this. If you ever want to run the EXPUNGE command
17972manually, @xref{Expunging mailboxes}.
17973@item ask
17974When closing mailboxes, nnimap will ask if you wish to expunge deleted
17975articles or not.
17976
17977@end table
17978
17979@item nnimap-importantize-dormant
17980@vindex nnimap-importantize-dormant
17981
17982If non-@code{nil} (the default), marks dormant articles as ticked (as
17983well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will
17984naturally still (only) be marked as dormant. This is to make dormant
17985articles stand out, just like ticked articles, in other @acronym{IMAP}
17986clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP}
17987has only one.)
17988
17989Probably the only reason for frobbing this would be if you're trying
17990enable 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
17999In this case, you would not want the per-user dormant flag showing up
18000as 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
18007This variable contain the @acronym{IMAP} search command sent to server when
18008searching for articles eligible for expiring. The default is
18009@code{"UID %s NOT SINCE %s"}, where the first @code{%s} is replaced by
18010UID set and the second @code{%s} is replaced by a date.
18011
18012Probably the only useful value to change this to is
18013@code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in
18014messages instead of the internal article date. See section 6.4.4 of
18015RFC 2060 for more information on valid strings.
18016
18017However, if @code{nnimap-search-uids-not-since-is-evil}
18018is true, this variable has no effect since the search logic
18019is reversed, as described below.
18020
18021@item nnimap-authinfo-file
18022@vindex nnimap-authinfo-file
18023
18024A 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
18026variable @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
18030machine students.uio.no login larsi password geheimnis port imap
18031@end example
18032
18033Note that it should be @code{port imap}, or @code{port 143}, if you
18034use a @code{nnimap-stream} of @code{tls} or @code{ssl}, even if the
18035actual port number used is port 993 for secured IMAP. For
18036convenience, 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
18042Unselect mailboxes before looking for new mail in them. Some servers
18043seem to need this under some circumstances; it was reported that
18044Courier 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
18051Never generate or use a local @acronym{NOV} database. Defaults to the
18052value of @code{gnus-agent}.
18053
18054Using a @acronym{NOV} database usually makes header fetching much
18055faster, but it uses the @code{UID SEARCH UID} command, which is very
18056slow on some servers (notably some versions of Courier). Since the Gnus
18057Agent caches the information in the @acronym{NOV} database without using
18058the slow command, this variable defaults to true if the Agent is in use,
18059and 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
18066Avoid 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
18071When Gnus expires your mail (@pxref{Expiring Mail}), it starts with a
18072list of expirable articles and asks the IMAP server questions like ``Of
18073these articles, which ones are older than a week?'' While this seems
18074like a perfectly reasonable question, some IMAP servers take a long time
18075to answer it, since they seemingly go looking into every old article to
18076see 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
18078much faster to answer, so setting this variable causes Gnus to ask this
18079question and figure out the answer to the real question itself.
18080
18081This problem can really sneak up on you: when you first configure Gnus,
18082everything works fine, but once you accumulate a couple thousand
18083messages, you start cursing Gnus for being so slow. On the other hand,
18084if you get a lot of email within a week, setting this variable will
18085cause a lot of network traffic between Gnus and the IMAP server.
18086
18087@item nnimap-logout-timeout
18088@vindex nnimap-logout-timeout
18089
18090There is a case where a connection to a @acronym{IMAP} server is unable
18091to close, when connecting to the server via a certain kind of network,
18092e.g. @acronym{VPN}. In that case, it will be observed that a connection
18093between Emacs and the local network looks alive even if the server has
18094closed a connection for some reason (typically, a timeout).
18095Consequently, Emacs continues waiting for a response from the server for
18096the @code{LOGOUT} command that Emacs sent, or hangs in other words. If
18097you are in such a network, setting this variable to a number of seconds
18098will be helpful. If it is set, a hung connection will be closed
18099forcibly, 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
18101value will be inconvenient too. Perhaps the value 1.0 will be a good
18102candidate but it might be worth trying some other values.
18103
18104Example 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
18128Splitting is something Gnus users have loved and used for years, and now
18129the rest of the world is catching up. Yeah, dream on, not many
18130@acronym{IMAP} servers have server side splitting and those that have
18131splitting seem to use some non-standard protocol. This means that
18132@acronym{IMAP} support for Gnus has to do its own splitting.
18133
18134And it does.
18135
18136(Incidentally, people seem to have been dreaming on, and Sieve has
18137gaining a market share and is supported by several IMAP servers.
18138Fortunately, Gnus support it too, @xref{Sieve Commands}.)
18139
18140Here 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
18149If non-@code{nil}, do crossposting if several split methods match the
18150mail. If @code{nil}, the first match in @code{nnimap-split-rule}
18151found will be used.
18152
18153Nnmail equivalent: @code{nnmail-crosspost}.
18154
18155@item nnimap-split-inbox
18156@cindex splitting, inbox
18157@cindex inbox
18158@vindex nnimap-split-inbox
18159
18160A string or a list of strings that gives the name(s) of @acronym{IMAP}
18161mailboxes to split from. Defaults to @code{nil}, which means that
18162splitting is disabled!
18163
18164@lisp
18165(setq nnimap-split-inbox
18166 '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap"))
18167@end lisp
18168
18169No nnmail equivalent.
18170
18171@item nnimap-split-rule
18172@cindex splitting, rules
18173@vindex nnimap-split-rule
18174
18175New mail found in @code{nnimap-split-inbox} will be split according to
18176this variable.
18177
18178This variable contains a list of lists, where the first element in the
18179sublist gives the name of the @acronym{IMAP} mailbox to move articles
18180matching the regexp in the second element in the sublist. Got that?
18181Neither 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
18191This will put all articles from the nnimap mailing list into mailbox
18192INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line
18193into INBOX.junk and everything else in INBOX.private.
18194
18195The first string may contain @samp{\\1} forms, like the ones used by
18196replace-match to insert sub-expressions from the matched text. For
18197instance:
18198
18199@lisp
18200("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@")
18201@end lisp
18202
18203The first element can also be the symbol @code{junk} to indicate that
18204matching messages should simply be deleted. Use with care.
18205
18206The second element can also be a function. In that case, it will be
18207called with the first element of the rule as the argument, in a buffer
18208containing the headers of the article. It should return a
18209non-@code{nil} value if it thinks that the mail belongs in that group.
18210
18211Nnmail users might recollect that the last regexp had to be empty to
18212match all articles (like in the example above). This is not required in
18213nnimap. Articles not matching any of the regexps will not be moved out
18214of your inbox. (This might affect performance if you keep lots of
18215unread articles in your inbox, since the splitting code would go over
18216them every time you fetch new mail.)
18217
18218These rules are processed from the beginning of the alist toward the
18219end. The first rule to make a match will ``win'', unless you have
18220crossposting enabled. In that case, all matching rules will ``win''.
18221
18222This variable can also have a function as its value, the function will
18223be called with the headers narrowed and should return a group where it
18224thinks the article should be split to. See @code{nnimap-split-fancy}.
18225
18226The splitting code tries to create mailboxes if it needs to.
18227
18228To allow for different split rules on different virtual servers, and
18229even different split rules in different inboxes on the same server,
18230the 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
18241The virtual server name is in fact a regexp, so that the same rules
18242may apply to several servers. In the example, the servers
18243@code{my3server} and @code{my4server} both use the same rules.
18244Similarly, the inbox string is also a regexp. The actual splitting
18245rules are as before, either a function, or a list with group/regexp or
18246group/function elements.
18247
18248Nnmail equivalent: @code{nnmail-split-methods}.
18249
18250@item nnimap-split-predicate
18251@cindex splitting
18252@vindex nnimap-split-predicate
18253
18254Mail matching this predicate in @code{nnimap-split-inbox} will be
18255split, it is a string and the default is @samp{UNSEEN UNDELETED}.
18256
18257This might be useful if you use another @acronym{IMAP} client to read mail in
18258your inbox but would like Gnus to split all articles in the inbox
18259regardless 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
18267It's possible to set @code{nnimap-split-rule} to
18268@code{nnmail-split-fancy} if you want to use fancy
18269splitting. @xref{Fancy Mail Splitting}.
18270
18271However, to be able to have different fancy split rules for nnmail and
18272nnimap back ends you can set @code{nnimap-split-rule} to
18273@code{nnimap-split-fancy} and define the nnimap specific fancy split
18274rule in @code{nnimap-split-fancy}.
18275
18276Example:
18277
18278@lisp
18279(setq nnimap-split-rule 'nnimap-split-fancy
18280 nnimap-split-fancy ...)
18281@end lisp
18282
18283Nnmail 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
18289Set to non-@code{nil} to download entire articles during splitting.
18290This is generally not required, and will slow things down
18291considerably. You may need it if you want to use an advanced
18292splitting 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
18300Even though @code{nnimap} is not a proper @code{nnmail} derived back
18301end, it supports most features in regular expiring (@pxref{Expiring
18302Mail}). Unlike splitting in @acronym{IMAP} (@pxref{Splitting in
18303IMAP}) it does not clone the @code{nnmail} variables (i.e., creating
18304@var{nnimap-expiry-wait}) but reuse the @code{nnmail} variables. What
18305follows below are the variables used by the @code{nnimap} expiry
18306process.
18307
18308A note on how the expire mark is stored on the @acronym{IMAP} server is
18309appropriate here as well. The expire mark is translated into a
18310@code{imap} client specific mark, @code{gnus-expire}, and stored on the
18311message. This means that likely only Gnus will understand and treat
18312the @code{gnus-expire} mark properly, although other clients may allow
18313you to view client specific flags on the message. It also means that
18314your server must support permanent storage of client specific flags on
18315messages. Most do, fortunately.
18316
18317If expiring @acronym{IMAP} mail seems very slow, try setting the server
18318variable @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
18325These variables are fully supported. The expire value can be a
18326number, the symbol @code{immediate} or @code{never}.
18327
18328@item nnmail-expiry-target
18329
18330This variable is supported, and internally implemented by calling the
18331@code{nnmail} functions that handle this. It contains an optimization
18332that if the destination is a @acronym{IMAP} group on the same server, the
18333article 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
18345ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for
18346limiting (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
18348doesn't.
18349
18350To 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
18352editing window with detailed instructions.
18353
18354Some possible uses:
18355
18356@itemize @bullet
18357@item
18358Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags)
18359on your mailing list mailboxes enables other users on the same server to
18360follow the list without subscribing to it.
18361@item
18362At least with the Cyrus server, you are required to give the user
18363``anyone'' posting ("p") capabilities to have ``plussing'' work (that is,
18364mail sent to user+mailbox@@domain ending up in the @acronym{IMAP} mailbox
18365INBOX.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
18377If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
18378you may want the option of expunging all deleted articles in a mailbox
18379manually. This is exactly what @kbd{G x} does.
18380
18381Currently there is no way of showing deleted articles, you can just
18382delete them.
18383
18384@node A note on namespaces
18385@subsection A note on namespaces
18386@cindex IMAP namespace
18387@cindex namespaces
18388
18389The @acronym{IMAP} protocol has a concept called namespaces, described
18390by the following text in the RFC2060:
18391
18392@display
183935.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
18408While there is nothing in this text that warrants concern for the
18409@acronym{IMAP} implementation in Gnus, some servers use namespace
18410prefixes in a way that does not work with how Gnus uses mailbox names.
18411
18412Specifically, University of Washington's @acronym{IMAP} server uses
18413mailbox names like @code{#driver.mbx/read-mail} which are valid only
18414in the @sc{create} and @sc{append} commands. After the mailbox is
18415created (or a messages is appended to a mailbox), it must be accessed
18416without the namespace prefix, i.e. @code{read-mail}. Since Gnus do
18417not make it possible for the user to guarantee that user entered
18418mailbox names will only be used with the CREATE and APPEND commands,
18419you should simply not use the namespace prefixed mailbox names in
18420Gnus.
18421
18422See the UoW IMAPD documentation for the @code{#driver.*/} prefix
18423for more information on how to use the prefixes. They are a power
18424tool 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
18433best to fix them right away. If you encounter odd behavior, chances
18434are that either the server or Gnus is buggy.
18435
18436If you are familiar with network protocols in general, you will
18437probably be able to extract some clues from the protocol dump of the
18438exchanges between Gnus and the server. Even if you are not familiar
18439with network protocols, when you include the protocol dump in
18440@acronym{IMAP}-related bug reports you are helping us with data
18441critical to solving the problem. Therefore, we strongly encourage you
18442to include the protocol dump when reporting IMAP bugs in Gnus.
18443
18444
18445@vindex imap-log
18446Because the protocol dump, when enabled, generates lots of data, it is
18447disabled by default. You can enable it by setting @code{imap-log} as
18448follows:
18449
18450@lisp
18451(setq imap-log t)
18452@end lisp
18453
18454This instructs the @code{imap.el} package to log any exchanges with
18455the server. The log is stored in the buffer @samp{*imap-log*}. Look
18456for error messages, which sometimes are tagged with the keyword
18457@code{BAD}---but when submitting a bug, make sure to include all the
18458data.
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
23396Some ready-made functions to do this have been created: 22756Some 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
23413behave. 22773behave.
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.
23422Spamming is bad. Spamming is evil.
23423
23424Spamming is usually canceled within a day or so by various anti-spamming
23425agencies. These agencies usually also send out @dfn{NoCeM} messages.
23426NoCeM is pronounced ``no see-'em'', and means what the name
23427implies---these are messages that make the offending articles, like, go
23428away.
23429
23430What use are these NoCeM messages if the articles are canceled anyway?
23431Some sites do not honor cancel messages and some sites just honor cancels
23432from a select few people. Then you may wish to make use of the NoCeM
23433messages, which are distributed in the newsgroups
23434@samp{news.lists.filters}, @samp{alt.nocem.misc}, etc.
23435
23436Gnus can read and parse the messages in this group automatically, and
23437this will make spam disappear.
23438
23439There are some variables to customize, of course:
23440
23441@table @code
23442@item gnus-use-nocem
23443@vindex gnus-use-nocem
23444Set this variable to @code{t} to set the ball rolling. It is @code{nil}
23445by default.
23446
23447You can also set this variable to a positive number as a group level.
23448In that case, Gnus scans NoCeM messages when checking new news if this
23449value is not exceeding a group level that you specify as the prefix
23450argument to some commands, e.g. @code{gnus},
23451@code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan
23452NoCeM messages if you specify a group level that is smaller than this
23453value to those commands. For example, if you use 1 or 2 on the mail
23454groups and the levels on the news groups remain the default, 3 is the
23455best choice.
23456
23457@item gnus-nocem-groups
23458@vindex gnus-nocem-groups
23459Gnus will look for NoCeM messages in the groups in this list. The
23460default is
23461@lisp
23462("news.lists.filters" "alt.nocem.misc")
23463@end lisp
23464
23465@item gnus-nocem-issuers
23466@vindex gnus-nocem-issuers
23467There are many people issuing NoCeM messages. This list says what
23468people 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
23481Known despammers that you can put in this list are listed at@*
23482@uref{http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html}.
23483
23484You do not have to heed NoCeM messages from all these people---just the
23485ones you want to listen to. You also don't have to accept all NoCeM
23486messages from the people you like. Each NoCeM message has a @dfn{type}
23487header that gives the message a (more or less, usually less) rigorous
23488definition. 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.
23491Each condition is either a string (which is a regexp that matches types
23492you 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
23495For 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
23502On 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
23509The 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
23516This should be a function for verifying that the NoCeM issuer is who she
23517says she is. This variable defaults to @code{gnus-nocem-epg-verify} if
23518EasyPG is available, otherwise defaults to @code{pgg-verify}. The
23519function should return non-@code{nil} if the verification is successful,
23520otherwise (including the case the NoCeM message was not signed) should
23521return @code{nil}. If this is too slow and you don't care for
23522verification (which may be dangerous), you can set this variable to
23523@code{nil}.
23524
23525Formerly the default was @code{mc-verify}, which is a Mailcrypt
23526function. 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
23528you are willing to add the @acronym{PGP} public keys to GnuPG's keyring.
23529
23530@item gnus-nocem-directory
23531@vindex gnus-nocem-directory
23532This 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
23537The number of days before removing old NoCeM entries from the cache.
23538The default is 15. If you make it shorter Gnus will be faster, but you
23539might then see old spam.
23540
23541@item gnus-nocem-check-from
23542@vindex gnus-nocem-check-from
23543Non-@code{nil} means check for valid issuers in message bodies.
23544Otherwise don't bother fetching articles unless their author matches a
23545valid issuer; that is much faster if you are selective about the
23546issuers.
23547
23548@item gnus-nocem-check-article-limit
23549@vindex gnus-nocem-check-article-limit
23550If non-@code{nil}, the maximum number of articles to check in any NoCeM
23551group. @code{nil} means no restriction. NoCeM groups can be huge and
23552very slow to process.
23553
23554@end table
23555
23556Using NoCeM could potentially be a memory hog. If you have many living
23557(i. e., subscribed or unsubscribed groups), your Emacs process will grow
23558big. If this is a problem, you should kill off all (or most) of your
23559unsubscribed 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:
24398Note that with the nnimap back end, message bodies will not be 23612Note that with the nnimap back end, message bodies will not be
24399downloaded by default. You need to set 23613downloaded 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
24403That is about it. As some spam is likely to get through anyway, you 23617That is about it. As some spam is likely to get through anyway, you
24404might want to have a nifty function to call when you happen to read 23618might 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
24681Note for IMAP users: if you use the @code{spam-check-bogofilter}, 23895Note 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,
24683you should also set the variable @code{nnimap-split-download-body} 23897you should also set the variable @code{nnimap-split-download-body} to
24684to @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 23899the full message body. By default, the nnimap back end only retrieves
24686retrieves the message headers; @code{nnimap-split-download-body} tells 23900the message headers; @code{nnimap-split-download-body} tells it to
24687it to retrieve the message bodies as well. We don't set this by 23901retrieve the message bodies as well. We don't set this by default
24688default because it will slow @acronym{IMAP} down, and that is not an 23902because it will slow @acronym{IMAP} down, and that is not an
24689appropriate decision to make on behalf of the user. @xref{Splitting 23903appropriate decision to make on behalf of the user. @xref{Client-Side
24690in IMAP}. 23904@acronym{IMAP} Splitting}.
24691 23905
24692You have to specify one or more spam back ends for @code{spam-split} 23906You have to specify one or more spam back ends for @code{spam-split}
24693to use, by setting the @code{spam-use-*} variables. @xref{Spam Back 23907to 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
27607Gnus 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
27614Groups can be made permanently visible (@pxref{Listing Groups}). 26821Groups 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.
75If the text under the mouse pointer has a `earcon-callback' property,
76call 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.
86If the text at point has a `earcon-callback' property,
87call 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.
95If 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.
101If 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.
262If t, nnimap will fetch only the first part. If a string, it
263will fetch all parts that have types that match that string. A
264likely value would be \"text/\" to automatically fetch all
265textual parts.
266
267Currently only the nnimap backend actually supports partial
268article fetching. If the backend doesn't support it, it has no
269effect."
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.
1603Valid values are nil, t, `head', `first', `last', an integer or a
1604predicate. 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.
1612To automatically treat X-PGP-Sig, set it to head. 1619To 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.
7139If 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
7141the 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.
7152The 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.
7172It 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.
7444The higher the number, the more buttons will appear and the more false
7445positives are possible. Note that you can set this variable local to
7446specific groups. Setting it higher in TeX groups is probably a good idea.
7447See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
7448how 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.
7456The higher the number, the more buttons will appear and the more false 7408The 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."
865Check the [ ] for the entries you want to apply to this score file, then 865Check the [ ] for the entries you want to apply to this score file, then
866edit the value to suit your taste. Don't forget to mark the checkbox, 866edit the value to suit your taste. Don't forget to mark the checkbox,
867if you do all your changes will be lost. ") 867if 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
58This can also be a list of `(ISSUER CONDITION ...)' elements.
59
60See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
61issuer 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.
108If the function in this variable isn't bound, the message will be used
109unconditionally."
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.
125Otherwise don't fetch messages which have references or whose message-id
126matches 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.
139Otherwise don't bother fetching articles unless their author matches a
140valid 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
651A few pre-made functions are supplied: `gnus-subscribe-randomly'
652inserts new groups at the beginning of the list of groups;
653`gnus-subscribe-alphabetically' inserts new groups in strict
654alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
655in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
656for 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
659claim 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.
920The variable `gnus-browse-subscribe-newsgroup-method' determines
921how 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.
9355This is only useful if you're looking at a partial version of the
9356article 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.
9362If ARG (the prefix) is a number, show the article with the charset 9367If 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.
1585You can also set this variable to a positive number as a group level.
1586In that case, Gnus scans NoCeM messages when checking new news if this
1587value is not exceeding a group level that you specify as the prefix
1588argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc.
1589Otherwise, Gnus does not scan NoCeM messages if you specify a group
1590level 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.
78Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") 73Valid 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.
67Uses 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.
67Possible choices are nil (use default methods) or `anonymous'.") 71Possible 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.
71If t, nnimap will fetch only the first part. If a string, it
72will fetch all parts that have types that match that string. A
73likely value would be \"text/\" to automatically fetch all
74textual 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.
78This is always done if the server supports UID EXPUNGE, but it's 75This is always done if the server supports UID EXPUNGE, but it's
79not done by default on servers that doesn't support that command.") 76not 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.
80Switching this off will make nnimap slower, but it helps with
81some 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