# HG changeset patch # User Katsumi Yamaoka # Date 1285473799 0 # Node ID b6d2a63ad99323f13c6cd454f8d5e4a5486a1c49 # Parent aa7656773a382c658888ef51f23fdba0da230786 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. diff -r aa7656773a38 -r b6d2a63ad993 doc/misc/gnus-news.texi --- a/doc/misc/gnus-news.texi Sun Sep 26 03:39:24 2010 +0200 +++ b/doc/misc/gnus-news.texi Sun Sep 26 04:03:19 2010 +0000 @@ -246,6 +246,16 @@ @code{message-insert-formatted-citation-line} as well. @end itemize +@item Changes in Browse Server mode + +@itemize @bullet +@item Gnus' sophisticated subscription methods are now available in +Browse Server buffers as well using the variable +@code{gnus-browse-subscribe-newsgroup-method}. + +@end itemize + + @item Changes in back ends @itemize @bullet @@ -336,6 +346,8 @@ moving articles to a group that has not turned auto-expire on. @xref{Expiring Mail}. +@item NoCeM support has been removed. + @end itemize @end itemize diff -r aa7656773a38 -r b6d2a63ad993 doc/misc/gnus.texi --- a/doc/misc/gnus.texi Sun Sep 26 03:39:24 2010 +0200 +++ b/doc/misc/gnus.texi Sun Sep 26 04:03:19 2010 +0000 @@ -629,9 +629,9 @@ * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. +* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. -* IMAP:: Using Gnus as a @acronym{IMAP} client. * Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. @@ -698,15 +698,6 @@ * RSS:: Reading RDF site summary. * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. -@acronym{IMAP} - -* Splitting in IMAP:: Splitting mail with nnimap. -* Expiring in IMAP:: Expiring mail with nnimap. -* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. -* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. -* Debugging IMAP:: What to do when things don't work. - Other Sources * Directory Groups:: You can read a directory as if it was a newsgroup. @@ -808,7 +799,6 @@ * Highlighting and Menus:: Making buffers look all nice and cozy. * Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. @@ -1637,15 +1627,6 @@ @vindex gnus-no-groups-message Message displayed by Gnus when no groups are available. -@item gnus-play-startup-jingle -@vindex gnus-play-startup-jingle -If non-@code{nil}, play the Gnus jingle at startup. - -@item gnus-startup-jingle -@vindex gnus-startup-jingle -Jingle to be played if the above variable is non-@code{nil}. The -default is @samp{Tuxedomoon.Jingle4.au}. - @item gnus-use-backend-marks @vindex gnus-use-backend-marks If non-@code{nil}, Gnus will store article marks both in the @@ -3617,8 +3598,12 @@ @item u @kindex u (Browse) @findex gnus-browse-unsubscribe-current-group +@vindex gnus-browse-subscribe-newsgroup-method Unsubscribe to the current group, or, as will be the case here, -subscribe to it (@code{gnus-browse-unsubscribe-current-group}). +subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You +can affect the way the new group is entered into the Group buffer +using the variable @code{gnus-browse-subscribe-newsgroup-method}. See +@pxref{Subscription Methods} for available options. @item l @itemx q @@ -10086,18 +10071,6 @@ An alist of @code{(RATE . REGEXP)} pairs used by the function @code{gnus-button-mid-or-mail-heuristic}. -@c Stuff related to gnus-button-tex-level - -@item gnus-button-ctan-handler -@findex gnus-button-ctan-handler -The function to use for displaying CTAN links. It must take one -argument, the string naming the URL. - -@item gnus-ctan-url -@vindex gnus-ctan-url -Top directory of a CTAN (Comprehensive TeX Archive Network) archive used -by @code{gnus-button-ctan-handler}. - @c Misc stuff @item gnus-article-button-face @@ -10170,14 +10143,6 @@ @code{gnus-button-mid-or-mail-heuristic}, and @code{gnus-button-mid-or-mail-heuristic-alist}. -@item gnus-button-tex-level -@vindex gnus-button-tex-level -Controls the display of references to @TeX{} or LaTeX stuff, e.g. for CTAN -URLs. See the variables @code{gnus-ctan-url}, -@code{gnus-button-ctan-handler}, -@code{gnus-button-ctan-directory-regexp}, and -@code{gnus-button-handle-ctan-bogus-regexp}. - @end table @@ -10829,6 +10794,16 @@ be run just before printing the buffer. An alternative way to print article is to use Muttprint (@pxref{Saving Articles}). +@item A C +@vindex gnus-fetch-partial-articles +@findex gnus-summary-show-complete-article +If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will +fetch partial articles, if the backend it fetches them from supports +it. Currently only @code{nnimap} does. If you're looking at a +partial article, and want to see the complete article instead, then +the @kbd{A C} command (@code{gnus-summary-show-complete-article}) will +do so. + @end table @@ -11877,8 +11852,7 @@ posted it to several groups separately. Posting the same article to several groups (not cross-posting) is called @dfn{spamming}, and you are by law required to send nasty-grams to anyone who perpetrates such a -heinous crime. You may want to try NoCeM handling to filter out spam -(@pxref{NoCeM}). +heinous crime. Remember: Cross-posting is kinda ok, but posting the same article separately to several groups is not. Massive cross-posting (aka. @@ -12009,7 +11983,7 @@ install an OpenPGP implementation such as GnuPG. The Lisp interface to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG, epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg, -PGG Manual}), Mailcrypt, and gpg.el are also supported. +PGG Manual}), and Mailcrypt are also supported. @item To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6 @@ -12048,7 +12022,7 @@ @vindex mml1991-use Symbol indicating elisp interface to OpenPGP implementation for @acronym{PGP} messages. The default is @code{epg}, but @code{pgg}, -@code{mailcrypt}, and @code{gpg} are also supported although +and @code{mailcrypt} are also supported although deprecated. By default, Gnus uses the first available interface in this order. @@ -12056,7 +12030,7 @@ @vindex mml2015-use Symbol indicating elisp interface to OpenPGP implementation for @acronym{PGP/MIME} messages. The default is @code{epg}, but -@code{pgg}, @code{mailcrypt}, and @code{gpg} are also supported +@code{pgg}, and @code{mailcrypt} are also supported although deprecated. By default, Gnus uses the first available interface in this order. @@ -13726,9 +13700,9 @@ @menu * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. +* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. -* IMAP:: Using Gnus as a @acronym{IMAP} client. * Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. @@ -14141,6 +14115,14 @@ Remove all marks to whether Gnus was denied connection from any servers (@code{gnus-server-remove-denials}). +@item c +@kindex c (Server) +@findex gnus-server-copy-server +Copy a server and give it a new name +(@code{gnus-server-copy-server}). This can be useful if you have a +complex method definition, and want to use the same definition towards +a different (physical) server. + @item L @kindex L (Server) @findex gnus-server-offline-server @@ -14805,6 +14787,121 @@ @end table +@node Using @acronym{IMAP} +@section Using @acronym{IMAP} +@cindex imap + +The most popular mail backend is probably @code{nnimap}, which +provides access to @acronym{IMAP} servers. @acronym{IMAP} servers +store mail remotely, so the client doesn't store anything locally. +This means that it's a convenient choice when you're reading your mail +from different locations, or with different user agents. + +@menu +* Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}. +* Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection. +* Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box. +@end menu + + +@node Connecting to an @acronym{IMAP} Server +@subsection Connecting to an @acronym{IMAP} Server + +Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the +group buffer, or (if your primary interest is reading email), say +something like: + +@example +(setq gnus-select-method + '(nnimap "imap.gmail.com")) +@end example + +You'll be prompted for a user name and password. If you grow tired of +that, then add the following to your @file{~/.authinfo} file: + +@example +machine imap.gmail.com login password port imap +@end example + +That should basically be it for most users. + + +@node Customizing the @acronym{IMAP} Connection +@subsection Customizing the @acronym{IMAP} Connection + +Here's an example method that's more complex: + +@example +(nnimap "imap.gmail.com" + (nnimap-inbox "INBOX") + (nnimap-split-methods ,nnmail-split-methods) + (nnimap-expunge t) + (nnimap-stream 'ssl) + (nnir-search-engine imap) + (nnimap-expunge-inbox t)) +@end example + +@table @code +@item nnimap-address +The address of the server, like @samp{imap.gmail.com}. + +@item nnimap-server-port +If the server uses a non-standard port, that can be specified here. A +typical port would be @samp{imap} or @samp{imaps}. + +@item nnimap-stream +How @code{nnimap} should connect to the server. Possible values are: + +@table @code +@item ssl +This is the default, and this uses standard +@acronym{TLS}/@acronym{SSL} connection. + +@item network +Non-encrypted and unsafe straight socket connection. + +@item starttls +Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port. + +@item shell +If you need to tunnel via other systems to connect to the server, you +can use this option, and customize @code{nnimap-shell-program} to be +what you need. + +@end table + +@item nnimap-authenticator +Some @acronym{IMAP} servers allow anonymous logins. In that case, +this should be set to @code{anonymous}. + +@item nnimap-streaming +Virtually all @code{IMAP} server support fast streaming of data. If +you have problems connecting to the server, try setting this to @code{nil}. + +@end table + + +@node Client-Side @acronym{IMAP} Splitting +@subsection Client-Side @acronym{IMAP} Splitting + +Many people prefer to do the sorting/splitting of mail into their mail +boxes on the @acronym{IMAP} server. That way they don't have to +download the mail they're not all that interested in. + +If you do want to do client-side mail splitting, then the following +variables are relevant: + +@table @code +@item nnimap-inbox +This is the @acronym{IMAP} mail box that will be scanned for new mail. + +@item nnimap-split-methods +Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting +Mail}). + +@end table + + @node Getting Mail @section Getting Mail @cindex reading mail @@ -15363,10 +15460,7 @@ @acronym{IMAP} as intended, as a network mail reading protocol (ie with nnimap), for some reason or other, Gnus let you treat it similar to a @acronym{POP} server and fetches articles from a given -@acronym{IMAP} mailbox. @xref{IMAP}, for more information. - -Note that for the Kerberos, GSSAPI, @acronym{TLS}/@acronym{SSL} and STARTTLS support you -may need external programs and libraries, @xref{IMAP}. +@acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information. Keywords: @@ -15835,7 +15929,7 @@ above. Also note that with the nnimap backend, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Splitting in IMAP}). +(@pxref{Client-Side @acronym{IMAP} Splitting}). @item (! @var{func} @var{split}) If the split is a list, and the first element is @code{!}, then @@ -16599,6 +16693,7 @@ @end menu + @node Unix Mail Box @subsubsection Unix Mail Box @cindex nnmbox @@ -17724,739 +17819,6 @@ follow the link. -@node IMAP -@section IMAP -@cindex nnimap -@cindex @acronym{IMAP} - -@acronym{IMAP} is a network protocol for reading mail (or news, or @dots{}), -think of it as a modernized @acronym{NNTP}. Connecting to a @acronym{IMAP} -server is much similar to connecting to a news server, you just -specify the network address of the server. - -@acronym{IMAP} has two properties. First, @acronym{IMAP} can do -everything that @acronym{POP} can, it can hence be viewed as a -@acronym{POP++}. Secondly, @acronym{IMAP} is a mail storage protocol, -similar to @acronym{NNTP} being a news storage protocol---however, -@acronym{IMAP} offers more features than @acronym{NNTP} because news -is more or less read-only whereas mail is read-write. - -If you want to use @acronym{IMAP} as a @acronym{POP++}, use an imap -entry in @code{mail-sources}. With this, Gnus will fetch mails from -the @acronym{IMAP} server and store them on the local disk. This is -not the usage described in this section---@xref{Mail Sources}. - -If you want to use @acronym{IMAP} as a mail storage protocol, use an nnimap -entry in @code{gnus-secondary-select-methods}. With this, Gnus will -manipulate mails stored on the @acronym{IMAP} server. This is the kind of -usage explained in this section. - -A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP} -servers might look something like the following. (Note that for -@acronym{TLS}/@acronym{SSL}, you need external programs and libraries, -see below.) - -@lisp -(setq gnus-secondary-select-methods - '((nnimap "simpleserver") ; @r{no special configuration} - ; @r{perhaps a ssh port forwarded server:} - (nnimap "dolk" - (nnimap-address "localhost") - (nnimap-server-port 1430)) - ; @r{a UW server running on localhost} - (nnimap "barbar" - (nnimap-server-port 143) - (nnimap-address "localhost") - (nnimap-list-pattern ("INBOX" "mail/*"))) - ; @r{anonymous public cyrus server:} - (nnimap "cyrus.andrew.cmu.edu" - (nnimap-authenticator anonymous) - (nnimap-list-pattern "archive.*") - (nnimap-stream network)) - ; @r{a ssl server on a non-standard port:} - (nnimap "vic20" - (nnimap-address "vic20.somewhere.com") - (nnimap-server-port 9930) - (nnimap-stream ssl)))) -@end lisp - -After defining the new server, you can subscribe to groups on the -server using normal Gnus commands such as @kbd{U} in the Group Buffer -(@pxref{Subscription Commands}) or via the Server Buffer -(@pxref{Server Buffer}). - -The following variables can be used to create a virtual @code{nnimap} -server: - -@table @code - -@item nnimap-address -@vindex nnimap-address - -The address of the remote @acronym{IMAP} server. Defaults to the virtual -server name if not specified. - -@item nnimap-server-port -@vindex nnimap-server-port -Port on server to contact. Defaults to port 143, or 993 for @acronym{TLS}/@acronym{SSL}. - -Note that this should be an integer, example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-server-port 4711)) -@end lisp - -@item nnimap-list-pattern -@vindex nnimap-list-pattern -String or list of strings of mailboxes to limit available groups to. -This is used when the server has very many mailboxes and you're only -interested in a few---some servers export your home directory via -@acronym{IMAP}, you'll probably want to limit the mailboxes to those in -@file{~/Mail/*} then. - -The string can also be a cons of REFERENCE and the string as above, what -REFERENCE is used for is server specific, but on the University of -Washington server it's a directory that will be concatenated with the -mailbox. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-list-pattern ("INBOX" "Mail/*" "alt.sex.*" - ("~friend/Mail/" . "list/*")))) -@end lisp - -@item nnimap-stream -@vindex nnimap-stream -The type of stream used to connect to your server. By default, nnimap -will detect and automatically use all of the below, with the exception -of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over -@acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can -be automatically detected, but it's not widely deployed yet.) - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-stream ssl)) -@end lisp - -Please note that the value of @code{nnimap-stream} is a symbol! - -@itemize @bullet -@item -@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the -@samp{gsasl} or @samp{imtest} program. -@item -@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. -@item -@dfn{starttls:} Connect via the STARTTLS extension (similar to -@acronym{TLS}/@acronym{SSL}). Requires the external library @samp{starttls.el} and program -@samp{starttls}. -@item -@dfn{tls:} Connect through @acronym{TLS}. Requires GNUTLS (the program -@samp{gnutls-cli}). -@item -@dfn{ssl:} Connect through @acronym{SSL}. Requires OpenSSL (the program -@samp{openssl}) or SSLeay (@samp{s_client}). -@item -@dfn{shell:} Use a shell command to start @acronym{IMAP} connection. -@item -@dfn{network:} Plain, TCP/IP network connection. -@end itemize - -@vindex imap-kerberos4-program -The @samp{imtest} program is shipped with Cyrus IMAPD. If you're -using @samp{imtest} from Cyrus IMAPD < 2.0.14 (which includes version -1.5.x and 1.6.x) you need to frob @code{imap-process-connection-type} -to make @code{imap.el} use a pty instead of a pipe when communicating -with @samp{imtest}. You will then suffer from a line length -restrictions on @acronym{IMAP} commands, which might make Gnus seem to hang -indefinitely if you have many articles in a mailbox. The variable -@code{imap-kerberos4-program} contain parameters to pass to the imtest -program. - -For @acronym{TLS} connection, the @code{gnutls-cli} program from GNUTLS is -needed. It is available from -@uref{http://www.gnu.org/software/gnutls/}. - -@vindex imap-gssapi-program -This parameter specifies a list of command lines that invoke a GSSAPI -authenticated @acronym{IMAP} stream in a subshell. They are tried -sequentially until a connection is made, or the list has been -exhausted. By default, @samp{gsasl} from GNU SASL, available from -@uref{http://www.gnu.org/software/gsasl/}, and the @samp{imtest} -program from Cyrus IMAPD (see @code{imap-kerberos4-program}), are -tried. - -@vindex imap-ssl-program -For @acronym{SSL} connections, the OpenSSL program is available from -@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, -and nnimap support it too---although the most recent versions of -SSLeay, 0.9.x, are known to have serious bugs making it -useless. Earlier versions, especially 0.8.x, of SSLeay are known to -work. The variable @code{imap-ssl-program} contain parameters to pass -to OpenSSL/SSLeay. - -@vindex imap-shell-program -@vindex imap-shell-host -For @acronym{IMAP} connections using the @code{shell} stream, the -variable @code{imap-shell-program} specify what program to call. Make -sure nothing is interfering with the output of the program, e.g., don't -forget to redirect the error output to the void. - -@item nnimap-authenticator -@vindex nnimap-authenticator - -The authenticator used to connect to the server. By default, nnimap -will use the most secure authenticator your server is capable of. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-authenticator anonymous)) -@end lisp - -Please note that the value of @code{nnimap-authenticator} is a symbol! - -@itemize @bullet -@item -@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires -external program @code{gsasl} or @code{imtest}. -@item -@dfn{kerberos4:} Kerberos 4 authentication. Requires external program -@code{imtest}. -@item -@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires -external library @code{digest-md5.el}. -@item -@dfn{cram-md5:} Encrypted username/password via CRAM-MD5. -@item -@dfn{login:} Plain-text username/password via LOGIN. -@item -@dfn{anonymous:} Login as ``anonymous'', supplying your email address as password. -@end itemize - -@item nnimap-expunge-on-close -@cindex expunging -@vindex nnimap-expunge-on-close -Unlike Parmenides the @acronym{IMAP} designers have decided things that -don't exist actually do exist. More specifically, @acronym{IMAP} has -this concept of marking articles @code{Deleted} which doesn't actually -delete them, and this (marking them @code{Deleted}, that is) is what -nnimap does when you delete an article in Gnus (with @kbd{B DEL} or -similar). - -Since the articles aren't really removed when we mark them with the -@code{Deleted} flag we'll need a way to actually delete them. Feel like -running in circles yet? - -Traditionally, nnimap has removed all articles marked as @code{Deleted} -when closing a mailbox but this is now configurable by this server -variable. - -The possible options are: - -@table @code - -@item always -The default behavior, delete all articles marked as ``Deleted'' when -closing a mailbox. -@item never -Never actually delete articles. Currently there is no way of showing -the articles marked for deletion in nnimap, but other @acronym{IMAP} clients -may allow you to do this. If you ever want to run the EXPUNGE command -manually, @xref{Expunging mailboxes}. -@item ask -When closing mailboxes, nnimap will ask if you wish to expunge deleted -articles or not. - -@end table - -@item nnimap-importantize-dormant -@vindex nnimap-importantize-dormant - -If non-@code{nil} (the default), marks dormant articles as ticked (as -well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will -naturally still (only) be marked as dormant. This is to make dormant -articles stand out, just like ticked articles, in other @acronym{IMAP} -clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP} -has only one.) - -Probably the only reason for frobbing this would be if you're trying -enable per-user persistent dormant flags, using something like: - -@lisp -(setcdr (assq 'dormant nnimap-mark-to-flag-alist) - (format "gnus-dormant-%s" (user-login-name))) -(setcdr (assq 'dormant nnimap-mark-to-predicate-alist) - (format "KEYWORD gnus-dormant-%s" (user-login-name))) -@end lisp - -In this case, you would not want the per-user dormant flag showing up -as ticked for other users. - -@item nnimap-expunge-search-string -@cindex expunging -@vindex nnimap-expunge-search-string -@cindex expiring @acronym{IMAP} mail - -This variable contain the @acronym{IMAP} search command sent to server when -searching for articles eligible for expiring. The default is -@code{"UID %s NOT SINCE %s"}, where the first @code{%s} is replaced by -UID set and the second @code{%s} is replaced by a date. - -Probably the only useful value to change this to is -@code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in -messages instead of the internal article date. See section 6.4.4 of -RFC 2060 for more information on valid strings. - -However, if @code{nnimap-search-uids-not-since-is-evil} -is true, this variable has no effect since the search logic -is reversed, as described below. - -@item nnimap-authinfo-file -@vindex nnimap-authinfo-file - -A file containing credentials used to log in on servers. The format is -(almost) the same as the @code{ftp} @file{~/.netrc} file. See the -variable @code{nntp-authinfo-file} for exact syntax; also see -@ref{NNTP}. An example of an .authinfo line for an IMAP server, is: - -@example -machine students.uio.no login larsi password geheimnis port imap -@end example - -Note that it should be @code{port imap}, or @code{port 143}, if you -use a @code{nnimap-stream} of @code{tls} or @code{ssl}, even if the -actual port number used is port 993 for secured IMAP. For -convenience, Gnus will accept @code{port imaps} as a synonym of -@code{port imap}. - -@item nnimap-need-unselect-to-notice-new-mail -@vindex nnimap-need-unselect-to-notice-new-mail - -Unselect mailboxes before looking for new mail in them. Some servers -seem to need this under some circumstances; it was reported that -Courier 1.7.1 did. - -@item nnimap-nov-is-evil -@vindex nnimap-nov-is-evil -@cindex Courier @acronym{IMAP} server -@cindex @acronym{NOV} - -Never generate or use a local @acronym{NOV} database. Defaults to the -value of @code{gnus-agent}. - -Using a @acronym{NOV} database usually makes header fetching much -faster, but it uses the @code{UID SEARCH UID} command, which is very -slow on some servers (notably some versions of Courier). Since the Gnus -Agent caches the information in the @acronym{NOV} database without using -the slow command, this variable defaults to true if the Agent is in use, -and false otherwise. - -@item nnimap-search-uids-not-since-is-evil -@vindex nnimap-search-uids-not-since-is-evil -@cindex Courier @acronym{IMAP} server -@cindex expiring @acronym{IMAP} mail - -Avoid the @code{UID SEARCH UID @var{message numbers} NOT SINCE -@var{date}} command, which is slow on some @acronym{IMAP} servers -(notably, some versions of Courier). Instead, use @code{UID SEARCH SINCE -@var{date}} and prune the list of expirable articles within Gnus. - -When Gnus expires your mail (@pxref{Expiring Mail}), it starts with a -list of expirable articles and asks the IMAP server questions like ``Of -these articles, which ones are older than a week?'' While this seems -like a perfectly reasonable question, some IMAP servers take a long time -to answer it, since they seemingly go looking into every old article to -see if it is one of the expirable ones. Curiously, the question ``Of -@emph{all} articles, which ones are newer than a week?'' seems to be -much faster to answer, so setting this variable causes Gnus to ask this -question and figure out the answer to the real question itself. - -This problem can really sneak up on you: when you first configure Gnus, -everything works fine, but once you accumulate a couple thousand -messages, you start cursing Gnus for being so slow. On the other hand, -if you get a lot of email within a week, setting this variable will -cause a lot of network traffic between Gnus and the IMAP server. - -@item nnimap-logout-timeout -@vindex nnimap-logout-timeout - -There is a case where a connection to a @acronym{IMAP} server is unable -to close, when connecting to the server via a certain kind of network, -e.g. @acronym{VPN}. In that case, it will be observed that a connection -between Emacs and the local network looks alive even if the server has -closed a connection for some reason (typically, a timeout). -Consequently, Emacs continues waiting for a response from the server for -the @code{LOGOUT} command that Emacs sent, or hangs in other words. If -you are in such a network, setting this variable to a number of seconds -will be helpful. If it is set, a hung connection will be closed -forcibly, after this number of seconds from the time Emacs sends the -@code{LOGOUT} command. It should not be too small value but too large -value will be inconvenient too. Perhaps the value 1.0 will be a good -candidate but it might be worth trying some other values. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-logout-timeout 1.0)) -@end lisp - -@end table - -@menu -* Splitting in IMAP:: Splitting mail with nnimap. -* Expiring in IMAP:: Expiring mail with nnimap. -* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. -* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. -* Debugging IMAP:: What to do when things don't work. -@end menu - - - -@node Splitting in IMAP -@subsection Splitting in IMAP -@cindex splitting imap mail - -Splitting is something Gnus users have loved and used for years, and now -the rest of the world is catching up. Yeah, dream on, not many -@acronym{IMAP} servers have server side splitting and those that have -splitting seem to use some non-standard protocol. This means that -@acronym{IMAP} support for Gnus has to do its own splitting. - -And it does. - -(Incidentally, people seem to have been dreaming on, and Sieve has -gaining a market share and is supported by several IMAP servers. -Fortunately, Gnus support it too, @xref{Sieve Commands}.) - -Here are the variables of interest: - -@table @code - -@item nnimap-split-crosspost -@cindex splitting, crosspost -@cindex crosspost -@vindex nnimap-split-crosspost - -If non-@code{nil}, do crossposting if several split methods match the -mail. If @code{nil}, the first match in @code{nnimap-split-rule} -found will be used. - -Nnmail equivalent: @code{nnmail-crosspost}. - -@item nnimap-split-inbox -@cindex splitting, inbox -@cindex inbox -@vindex nnimap-split-inbox - -A string or a list of strings that gives the name(s) of @acronym{IMAP} -mailboxes to split from. Defaults to @code{nil}, which means that -splitting is disabled! - -@lisp -(setq nnimap-split-inbox - '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap")) -@end lisp - -No nnmail equivalent. - -@item nnimap-split-rule -@cindex splitting, rules -@vindex nnimap-split-rule - -New mail found in @code{nnimap-split-inbox} will be split according to -this variable. - -This variable contains a list of lists, where the first element in the -sublist gives the name of the @acronym{IMAP} mailbox to move articles -matching the regexp in the second element in the sublist. Got that? -Neither did I, we need examples. - -@lisp -(setq nnimap-split-rule - '(("INBOX.nnimap" - "^Sender: owner-nnimap@@vic20.globalcom.se") - ("INBOX.junk" "^Subject:.*MAKE MONEY") - ("INBOX.private" ""))) -@end lisp - -This will put all articles from the nnimap mailing list into mailbox -INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line -into INBOX.junk and everything else in INBOX.private. - -The first string may contain @samp{\\1} forms, like the ones used by -replace-match to insert sub-expressions from the matched text. For -instance: - -@lisp -("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@") -@end lisp - -The first element can also be the symbol @code{junk} to indicate that -matching messages should simply be deleted. Use with care. - -The second element can also be a function. In that case, it will be -called with the first element of the rule as the argument, in a buffer -containing the headers of the article. It should return a -non-@code{nil} value if it thinks that the mail belongs in that group. - -Nnmail users might recollect that the last regexp had to be empty to -match all articles (like in the example above). This is not required in -nnimap. Articles not matching any of the regexps will not be moved out -of your inbox. (This might affect performance if you keep lots of -unread articles in your inbox, since the splitting code would go over -them every time you fetch new mail.) - -These rules are processed from the beginning of the alist toward the -end. The first rule to make a match will ``win'', unless you have -crossposting enabled. In that case, all matching rules will ``win''. - -This variable can also have a function as its value, the function will -be called with the headers narrowed and should return a group where it -thinks the article should be split to. See @code{nnimap-split-fancy}. - -The splitting code tries to create mailboxes if it needs to. - -To allow for different split rules on different virtual servers, and -even different split rules in different inboxes on the same server, -the syntax of this variable have been extended along the lines of: - -@lisp -(setq nnimap-split-rule - '(("my1server" (".*" (("ding" "ding@@gnus.org") - ("junk" "From:.*Simon")))) - ("my2server" ("INBOX" nnimap-split-fancy)) - ("my[34]server" (".*" (("private" "To:.*Simon") - ("junk" my-junk-func)))))) -@end lisp - -The virtual server name is in fact a regexp, so that the same rules -may apply to several servers. In the example, the servers -@code{my3server} and @code{my4server} both use the same rules. -Similarly, the inbox string is also a regexp. The actual splitting -rules are as before, either a function, or a list with group/regexp or -group/function elements. - -Nnmail equivalent: @code{nnmail-split-methods}. - -@item nnimap-split-predicate -@cindex splitting -@vindex nnimap-split-predicate - -Mail matching this predicate in @code{nnimap-split-inbox} will be -split, it is a string and the default is @samp{UNSEEN UNDELETED}. - -This might be useful if you use another @acronym{IMAP} client to read mail in -your inbox but would like Gnus to split all articles in the inbox -regardless of readedness. Then you might change this to -@samp{UNDELETED}. - -@item nnimap-split-fancy -@cindex splitting, fancy -@findex nnimap-split-fancy -@vindex nnimap-split-fancy - -It's possible to set @code{nnimap-split-rule} to -@code{nnmail-split-fancy} if you want to use fancy -splitting. @xref{Fancy Mail Splitting}. - -However, to be able to have different fancy split rules for nnmail and -nnimap back ends you can set @code{nnimap-split-rule} to -@code{nnimap-split-fancy} and define the nnimap specific fancy split -rule in @code{nnimap-split-fancy}. - -Example: - -@lisp -(setq nnimap-split-rule 'nnimap-split-fancy - nnimap-split-fancy ...) -@end lisp - -Nnmail equivalent: @code{nnmail-split-fancy}. - -@item nnimap-split-download-body -@findex nnimap-split-download-body -@vindex nnimap-split-download-body - -Set to non-@code{nil} to download entire articles during splitting. -This is generally not required, and will slow things down -considerably. You may need it if you want to use an advanced -splitting function that analyzes the body to split the article. - -@end table - -@node Expiring in IMAP -@subsection Expiring in IMAP -@cindex expiring @acronym{IMAP} mail - -Even though @code{nnimap} is not a proper @code{nnmail} derived back -end, it supports most features in regular expiring (@pxref{Expiring -Mail}). Unlike splitting in @acronym{IMAP} (@pxref{Splitting in -IMAP}) it does not clone the @code{nnmail} variables (i.e., creating -@var{nnimap-expiry-wait}) but reuse the @code{nnmail} variables. What -follows below are the variables used by the @code{nnimap} expiry -process. - -A note on how the expire mark is stored on the @acronym{IMAP} server is -appropriate here as well. The expire mark is translated into a -@code{imap} client specific mark, @code{gnus-expire}, and stored on the -message. This means that likely only Gnus will understand and treat -the @code{gnus-expire} mark properly, although other clients may allow -you to view client specific flags on the message. It also means that -your server must support permanent storage of client specific flags on -messages. Most do, fortunately. - -If expiring @acronym{IMAP} mail seems very slow, try setting the server -variable @code{nnimap-search-uids-not-since-is-evil}. - -@table @code - -@item nnmail-expiry-wait -@item nnmail-expiry-wait-function - -These variables are fully supported. The expire value can be a -number, the symbol @code{immediate} or @code{never}. - -@item nnmail-expiry-target - -This variable is supported, and internally implemented by calling the -@code{nnmail} functions that handle this. It contains an optimization -that if the destination is a @acronym{IMAP} group on the same server, the -article is copied instead of appended (that is, uploaded again). - -@end table - -@node Editing IMAP ACLs -@subsection Editing IMAP ACLs -@cindex editing imap acls -@cindex Access Control Lists -@cindex Editing @acronym{IMAP} ACLs -@kindex G l (Group) -@findex gnus-group-nnimap-edit-acl - -ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for -limiting (or enabling) other users access to your mail boxes. Not all -@acronym{IMAP} servers support this, this function will give an error if it -doesn't. - -To edit an ACL for a mailbox, type @kbd{G l} -(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with an ACL -editing window with detailed instructions. - -Some possible uses: - -@itemize @bullet -@item -Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags) -on your mailing list mailboxes enables other users on the same server to -follow the list without subscribing to it. -@item -At least with the Cyrus server, you are required to give the user -``anyone'' posting ("p") capabilities to have ``plussing'' work (that is, -mail sent to user+mailbox@@domain ending up in the @acronym{IMAP} mailbox -INBOX.mailbox). -@end itemize - -@node Expunging mailboxes -@subsection Expunging mailboxes -@cindex expunging - -@cindex expunge -@cindex manual expunging -@kindex G x (Group) -@findex gnus-group-expunge-group - -If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, -you may want the option of expunging all deleted articles in a mailbox -manually. This is exactly what @kbd{G x} does. - -Currently there is no way of showing deleted articles, you can just -delete them. - -@node A note on namespaces -@subsection A note on namespaces -@cindex IMAP namespace -@cindex namespaces - -The @acronym{IMAP} protocol has a concept called namespaces, described -by the following text in the RFC2060: - -@display -5.1.2. Mailbox Namespace Naming Convention - - By convention, the first hierarchical element of any mailbox name - which begins with "#" identifies the "namespace" of the remainder of - the name. This makes it possible to disambiguate between different - types of mailbox stores, each of which have their own namespaces. - - For example, implementations which offer access to USENET - newsgroups MAY use the "#news" namespace to partition the USENET - newsgroup namespace from that of other mailboxes. Thus, the - comp.mail.misc newsgroup would have an mailbox name of - "#news.comp.mail.misc", and the name "comp.mail.misc" could refer - to a different object (e.g. a user's private mailbox). -@end display - -While there is nothing in this text that warrants concern for the -@acronym{IMAP} implementation in Gnus, some servers use namespace -prefixes in a way that does not work with how Gnus uses mailbox names. - -Specifically, University of Washington's @acronym{IMAP} server uses -mailbox names like @code{#driver.mbx/read-mail} which are valid only -in the @sc{create} and @sc{append} commands. After the mailbox is -created (or a messages is appended to a mailbox), it must be accessed -without the namespace prefix, i.e. @code{read-mail}. Since Gnus do -not make it possible for the user to guarantee that user entered -mailbox names will only be used with the CREATE and APPEND commands, -you should simply not use the namespace prefixed mailbox names in -Gnus. - -See the UoW IMAPD documentation for the @code{#driver.*/} prefix -for more information on how to use the prefixes. They are a power -tool and should be used only if you are sure what the effects are. - -@node Debugging IMAP -@subsection Debugging IMAP -@cindex IMAP debugging -@cindex protocol dump (IMAP) - -@acronym{IMAP} is a complex protocol, more so than @acronym{NNTP} or -@acronym{POP3}. Implementation bugs are not unlikely, and we do our -best to fix them right away. If you encounter odd behavior, chances -are that either the server or Gnus is buggy. - -If you are familiar with network protocols in general, you will -probably be able to extract some clues from the protocol dump of the -exchanges between Gnus and the server. Even if you are not familiar -with network protocols, when you include the protocol dump in -@acronym{IMAP}-related bug reports you are helping us with data -critical to solving the problem. Therefore, we strongly encourage you -to include the protocol dump when reporting IMAP bugs in Gnus. - - -@vindex imap-log -Because the protocol dump, when enabled, generates lots of data, it is -disabled by default. You can enable it by setting @code{imap-log} as -follows: - -@lisp -(setq imap-log t) -@end lisp - -This instructs the @code{imap.el} package to log any exchanges with -the server. The log is stored in the buffer @samp{*imap-log*}. Look -for error messages, which sometimes are tagged with the keyword -@code{BAD}---but when submitting a bug, make sure to include all the -data. - @node Other Sources @section Other Sources @@ -22369,7 +21731,6 @@ * Highlighting and Menus:: Making buffers look all nice and cozy. * Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. @@ -23388,13 +22749,12 @@ (gnus-demon-add-handler 'gnus-demon-close-connections 30 t) @end lisp -@findex gnus-demon-add-nocem @findex gnus-demon-add-scanmail @findex gnus-demon-add-rescan @findex gnus-demon-add-scan-timestamps @findex gnus-demon-add-disconnection Some ready-made functions to do this have been created: -@code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection}, +@code{gnus-demon-add-disconnection}, @code{gnus-demon-add-nntp-close-connection}, @code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and @code{gnus-demon-add-scanmail}. Just put those functions in your @@ -23413,152 +22773,6 @@ behave. -@node NoCeM -@section NoCeM -@cindex nocem -@cindex spam - -@dfn{Spamming} is posting the same article lots and lots of times. -Spamming is bad. Spamming is evil. - -Spamming is usually canceled within a day or so by various anti-spamming -agencies. These agencies usually also send out @dfn{NoCeM} messages. -NoCeM is pronounced ``no see-'em'', and means what the name -implies---these are messages that make the offending articles, like, go -away. - -What use are these NoCeM messages if the articles are canceled anyway? -Some sites do not honor cancel messages and some sites just honor cancels -from a select few people. Then you may wish to make use of the NoCeM -messages, which are distributed in the newsgroups -@samp{news.lists.filters}, @samp{alt.nocem.misc}, etc. - -Gnus can read and parse the messages in this group automatically, and -this will make spam disappear. - -There are some variables to customize, of course: - -@table @code -@item gnus-use-nocem -@vindex gnus-use-nocem -Set this variable to @code{t} to set the ball rolling. It is @code{nil} -by default. - -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. @code{gnus}, -@code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan -NoCeM messages if you specify a group level that is smaller than this -value to those commands. For example, if you use 1 or 2 on the mail -groups and the levels on the news groups remain the default, 3 is the -best choice. - -@item gnus-nocem-groups -@vindex gnus-nocem-groups -Gnus will look for NoCeM messages in the groups in this list. The -default is -@lisp -("news.lists.filters" "alt.nocem.misc") -@end lisp - -@item gnus-nocem-issuers -@vindex gnus-nocem-issuers -There are many people issuing NoCeM messages. This list says what -people you want to listen to. The default is: - -@lisp -("Adri Verhoef" - "alba-nocem@@albasani.net" - "bleachbot@@httrack.com" - "news@@arcor-online.net" - "news@@uni-berlin.de" - "nocem@@arcor.de" - "pgpmoose@@killfile.org" - "xjsppl@@gmx.de") -@end lisp - -Known despammers that you can put in this list are listed at@* -@uref{http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html}. - -You do not have to heed NoCeM messages from all these people---just the -ones you want to listen to. You also don't have to accept all NoCeM -messages from the people you like. Each NoCeM message has a @dfn{type} -header that gives the message a (more or less, usually less) rigorous -definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf}, -@samp{binary}, and @samp{troll}. To specify this, you have to use -@code{(@var{issuer} @var{conditions} @dots{})} elements in the list. -Each condition is either a string (which is a regexp that matches types -you want to use) or a list on the form @code{(not @var{string})}, where -@var{string} is a regexp that matches types you don't want to use. - -For instance, if you want all NoCeM messages from Chris Lewis except his -@samp{troll} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" ".*" (not "troll")) -@end lisp - -On the other hand, if you just want nothing but his @samp{spam} and -@samp{spew} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam") -@end lisp - -The specs are applied left-to-right. - - -@item gnus-nocem-verifyer -@vindex gnus-nocem-verifyer -@findex gnus-nocem-epg-verify -@findex pgg-verify -This should be a function for verifying that the NoCeM issuer is who she -says she is. This variable defaults to @code{gnus-nocem-epg-verify} if -EasyPG is available, otherwise defaults to @code{pgg-verify}. The -function should return non-@code{nil} if the verification is successful, -otherwise (including the case the NoCeM message was not signed) should -return @code{nil}. If this is too slow and you don't care for -verification (which may be dangerous), you can set this variable to -@code{nil}. - -Formerly the default was @code{mc-verify}, which is a Mailcrypt -function. While you can still use it, you can change it into -@code{gnus-nocem-epg-verify} or @code{pgg-verify} running with GnuPG if -you are willing to add the @acronym{PGP} public keys to GnuPG's keyring. - -@item gnus-nocem-directory -@vindex gnus-nocem-directory -This is where Gnus will store its NoCeM cache files. The default is@* -@file{~/News/NoCeM/}. - -@item gnus-nocem-expiry-wait -@vindex gnus-nocem-expiry-wait -The number of days before removing old NoCeM entries from the cache. -The default is 15. If you make it shorter Gnus will be faster, but you -might then see old spam. - -@item gnus-nocem-check-from -@vindex gnus-nocem-check-from -Non-@code{nil} means check for valid issuers in message bodies. -Otherwise don't bother fetching articles unless their author matches a -valid issuer; that is much faster if you are selective about the -issuers. - -@item gnus-nocem-check-article-limit -@vindex gnus-nocem-check-article-limit -If non-@code{nil}, the maximum number of articles to check in any NoCeM -group. @code{nil} means no restriction. NoCeM groups can be huge and -very slow to process. - -@end table - -Using NoCeM could potentially be a memory hog. If you have many living -(i. e., subscribed or unsubscribed groups), your Emacs process will grow -big. If this is a problem, you should kill off all (or most) of your -unsubscribed groups (@pxref{Subscription Commands}). - - @node Undo @section Undo @cindex undo @@ -24398,7 +23612,7 @@ Note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Splitting in IMAP}). +(@pxref{Client-Side @acronym{IMAP} Splitting}). That is about it. As some spam is likely to get through anyway, you might want to have a nifty function to call when you happen to read @@ -24680,14 +23894,14 @@ @vindex nnimap-split-download-body Note for IMAP users: if you use the @code{spam-check-bogofilter}, @code{spam-check-ifile}, and @code{spam-check-stat} spam back ends, -you should also set the variable @code{nnimap-split-download-body} -to @code{t}. These spam back ends are most useful when they can -``scan'' the full message body. By default, the nnimap back end only -retrieves the message headers; @code{nnimap-split-download-body} tells -it to retrieve the message bodies as well. We don't set this by -default because it will slow @acronym{IMAP} down, and that is not an -appropriate decision to make on behalf of the user. @xref{Splitting -in IMAP}. +you should also set the variable @code{nnimap-split-download-body} to +@code{t}. These spam back ends are most useful when they can ``scan'' +the full message body. By default, the nnimap back end only retrieves +the message headers; @code{nnimap-split-download-body} tells it to +retrieve the message bodies as well. We don't set this by default +because it will slow @acronym{IMAP} down, and that is not an +appropriate decision to make on behalf of the user. @xref{Client-Side +@acronym{IMAP} Splitting}. You have to specify one or more spam back ends for @code{spam-split} to use, by setting the @code{spam-use-*} variables. @xref{Spam Back @@ -27604,13 +26818,6 @@ @end iftex @item -Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}). - -@lisp -(setq gnus-use-nocem t) -@end lisp - -@item Groups can be made permanently visible (@pxref{Listing Groups}). @lisp diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/earcon.el --- a/lisp/gnus/earcon.el Sun Sep 26 03:39:24 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,230 +0,0 @@ -;;; earcon.el --- Sound effects for messages - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Steven L. Baur - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; This file provides access to sound effects in Gnus. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-audio) -(require 'gnus-art) - -(defgroup earcon nil - "Turn ** sounds ** into noise." - :group 'gnus-visual) - -(defcustom earcon-prefix "**" - "*String denoting the start of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-suffix "**" - "String denoting the end of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-regexp-alist - '(("boring" 1 "Boring.au") - ("evil[ \t]+laugh" 1 "Evil_Laugh.au") - ("gag\\|puke" 1 "Puke.au") - ("snicker" 1 "Snicker.au") - ("meow" 1 "catmeow.wav") - ("sob\\|boohoo" 1 "cry.wav") - ("drum[ \t]*roll" 1 "drumroll.au") - ("blast" 1 "explosion.au") - ("flush\\|plonk!*" 1 "flush.au") - ("kiss" 1 "kiss.wav") - ("tee[ \t]*hee" 1 "laugh.au") - ("shoot" 1 "shotgun.wav") - ("yawn" 1 "snore.wav") - ("cackle" 1 "witch.au") - ("yell\\|roar" 1 "yell2.au") - ("whoop-de-doo" 1 "whistle.au")) - "*A list of regexps to map earcons to real sounds." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Sound"))) - :group 'earcon) -(defvar earcon-button-marker-list nil) -(make-variable-buffer-local 'earcon-button-marker-list) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! -(defun earcon-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive "e") - (set-buffer (window-buffer (posn-window (event-start event)))) - (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'earcon-data)) - (fun (get-text-property pos 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-press-button () - "Check text at point for a callback function. -If the text at point has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'earcon-data)) - (fun (get-text-property (point) 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (earcon-article-next-button (- n))) - -(defun earcon-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'earcon-callback) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'earcon-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'earcon-callback))) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun earcon-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and (boundp gnus-article-button-face) - gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -(defun earcon-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist earcon-regexp-alist) - (case-fold-search t) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun earcon-button-push (marker) - ;; Push button starting at MARKER. - (with-current-buffer gnus-article-buffer - (goto-char marker) - (let* ((entry (earcon-button-entry)) - (inhibit-point-motion-hooks t) - (fun 'gnus-audio-play) - (args (list (nth 2 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! - -;;;###interactive -(defun earcon-region (beg end) - "Play Sounds in the region between point and mark." - (interactive "r") - (earcon-buffer (current-buffer) beg end)) - -;;;###interactive -(defun earcon-buffer (&optional buffer st nd) - (interactive) - (save-excursion - ;; clear old markers. - (if (boundp 'earcon-button-marker-list) - (while earcon-button-marker-list - (set-marker (pop earcon-button-marker-list) nil)) - (setq earcon-button-marker-list nil)) - (and buffer (set-buffer buffer)) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist earcon-regexp-alist) - beg entry regexp) - (goto-char (point-min)) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (concat (regexp-quote earcon-prefix) - ".*\\(" - (car entry) - "\\).*" - (regexp-quote earcon-suffix))) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning 1))) - (end (and entry (match-end 1))) - (from (match-beginning 1))) - (earcon-article-add-button - start end 'earcon-button-push - (car (push (set-marker (make-marker) from) - earcon-button-marker-list))) - (gnus-audio-play (caddr entry)))))))) - -;;;###autoload -(defun gnus-earcon-display () - "Play sounds in message buffers." - (interactive) - (with-current-buffer gnus-article-buffer - (goto-char (point-min)) - ;; Skip headers - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (sit-for 0) - (earcon-buffer (current-buffer) (point)))) - -;;;*** - -(provide 'earcon) - -(run-hooks 'earcon-load-hook) - -;;; earcon.el ends here diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-art.el Sun Sep 26 04:03:19 2010 +0000 @@ -257,6 +257,22 @@ (regexp :value ".*")) :group 'gnus-article-signature) +(defcustom gnus-fetch-partial-articles nil + "If non-nil, Gnus will fetch partial articles. +If t, nnimap will fetch only the first part. If a string, it +will fetch all parts that have types that match that string. A +likely value would be \"text/\" to automatically fetch all +textual parts. + +Currently only the nnimap backend actually supports partial +article fetching. If the backend doesn't support it, it has no +effect." + :version "24.1" + :type '(choice (const nil) + (const t) + (regexp)) + :group 'gnus-article) + (defcustom gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text." :type 'sexp @@ -1598,15 +1614,6 @@ :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-play-sounds nil - "Play sounds. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - (defcustom gnus-treat-x-pgp-sig nil "Verify X-PGP-Sig. To automatically treat X-PGP-Sig, set it to head. @@ -1711,8 +1718,7 @@ (gnus-treat-hide-citation gnus-article-hide-citation) (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) (gnus-treat-highlight-citation gnus-article-highlight-citation) - (gnus-treat-body-boundary gnus-article-treat-body-boundary) - (gnus-treat-play-sounds gnus-earcon-display))) + (gnus-treat-body-boundary gnus-article-treat-body-boundary))) (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) @@ -5075,7 +5081,10 @@ "|\n" "| Type: " type "\n" "| Filename: " filename "\n" - "| Size (encoded): " bsize " Byte\n" + "| Size (encoded): " bsize (format " byte%s\n" + (if (= bsize 1) + "" + "s")) (when description (concat "| Description: " description "\n")) "`----\n")) @@ -7030,9 +7039,7 @@ (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) ;; Flush original article as well. - (when (get-buffer gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq gnus-original-article nil))) + (gnus-flush-original-article-buffer) (when gnus-use-cache (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))) @@ -7046,6 +7053,11 @@ (set-window-point (get-buffer-window buf) (point))) (gnus-summary-show-article)) +(defun gnus-flush-original-article-buffer () + (when (get-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (setq gnus-original-article nil)))) + (defun gnus-article-edit-exit () "Exit the article editing without updating." (interactive) @@ -7134,46 +7146,6 @@ (function :tag "Other")) :group 'gnus-article-buttons) -(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" - "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. -If the default site is too slow, try to find a CTAN mirror, see -. See also -the variable `gnus-button-handle-ctan'." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type '(choice (const "http://www.tex.ac.uk/tex-archive/") - (const "http://tug.ctan.org/tex-archive/") - (const "http://www.dante.de/CTAN/") - (string :tag "Other"))) - -(defcustom gnus-button-ctan-handler 'browse-url - "Function to use for displaying CTAN links. -The function must take one argument, the string naming the URL." - :version "22.1" - :type '(choice (function-item :tag "Browse Url" browse-url) - (function :tag "Other")) - :group 'gnus-article-buttons) - -(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" - "Bogus strings removed from CTAN URLs." - :version "22.1" - :group 'gnus-article-buttons - :type '(choice (const "^/?tex-archive/\\|/") - (regexp :tag "Other"))) - -(defcustom gnus-button-ctan-directory-regexp - (regexp-opt - (list "archive-tools" "biblio" "bibliography" "digests" "documentation" - "dviware" "fonts" "graphics" "help" "indexing" "info" "language" - "languages" "macros" "nonfree" "obsolete" "support" "systems" - "tds" "tools" "usergrps" "web") t) - "Regular expression for ctan directories. -It should match all directories in the top level of `gnus-ctan-url'." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - (defcustom gnus-button-mid-or-mail-regexp (concat "\\b\\(= gnus-button-message-level 0) gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) - ;; CTAN - ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" - gnus-button-ctan-directory-regexp - "[^][>)!;:,'\n\t ]+\\)") - 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) - ((concat "\\btex-archive/\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) - ((concat - "\\b\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) ;; Info Konqueror style . ;; Must come before " Gnus home-grown style". ("\\binfo://?\\([^'\">\n\t]+\\)" @@ -8512,9 +8450,7 @@ (when gnus-keep-backlog (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) - (when (get-buffer gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq gnus-original-article nil))) + (gnus-flush-original-article-buffer) (when gnus-use-cache (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current)))))))) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-audio.el --- a/lisp/gnus/gnus-audio.el Sun Sep 26 03:39:24 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -;;; gnus-audio.el --- Sound effects for Gnus - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; Keywords: news, mail, multimedia - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This file provides access to sound effects in Gnus. -;; This file is partially stripped to support earcons.el. - -;;; Code: - -(require 'nnheader) - -(defgroup gnus-audio nil - "Playing sound in Gnus." - :version "21.1" - :group 'gnus-visual - :group 'multimedia) - -(defvar gnus-audio-inline-sound - (or (if (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) ; XEmacs - (fboundp 'play-sound)) ; Emacs - "Non-nil means try to play sounds without using an external program.") - -(defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files." - :type '(choice directory (const nil)) - :group 'gnus-audio) - -(defcustom gnus-audio-au-player (executable-find "play") - "Executable program for playing sun AU format sound files." - :group 'gnus-audio - :type '(choice file (const nil))) - -(defcustom gnus-audio-wav-player (executable-find "play") - "Executable program for playing WAV files." - :group 'gnus-audio - :type '(choice file (const nil))) - -;;; The following isn't implemented yet. Wait for Millennium Gnus. -;;(defvar gnus-audio-effects-enabled t -;; "When t, Gnus will use sound effects.") -;;(defvar gnus-audio-enable-hooks nil -;; "Functions run when enabling sound effects.") -;;(defvar gnus-audio-disable-hooks nil -;; "Functions run when disabling sound effects.") -;;(defvar gnus-audio-theme-song nil -;; "Theme song for Gnus.") -;;(defvar gnus-audio-enter-group nil -;; "Sound effect played when selecting a group.") -;;(defvar gnus-audio-exit-group nil -;; "Sound effect played when exiting a group.") -;;(defvar gnus-audio-score-group nil -;; "Sound effect played when scoring a group.") -;;(defvar gnus-audio-busy-sound nil -;; "Sound effect played when going into a ... sequence.") - - -;;;###autoload -;;(defun gnus-audio-enable-sound () -;; "Enable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled t) -;; (gnus-run-hooks gnus-audio-enable-hooks)) - -;;;###autoload - ;(defun gnus-audio-disable-sound () -;; "Disable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled nil) -;; (gnus-run-hooks gnus-audio-disable-hooks)) - -;;;###autoload -(defun gnus-audio-play (file) - "Play a sound FILE through the speaker." - (interactive "fSound file name: ") - (let ((sound-file (if (file-exists-p file) - file - (expand-file-name file gnus-audio-directory)))) - (when (file-exists-p sound-file) - (cond ((and gnus-audio-inline-sound - (condition-case nil - ;; Even if we have audio, we may fail with the - ;; wrong sort of sound file. - (progn (play-sound-file sound-file) - t) - (error nil)))) - ;; If we don't have built-in sound, or playing it failed, - ;; try with external program. - ((equal "wav" (file-name-extension sound-file)) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((equal "au" (file-name-extension sound-file)) - (call-process gnus-audio-au-player - sound-file - 0 - nil - sound-file)))))) - - -;;; The following isn't implemented yet, wait for Red Gnus -;;(defun gnus-audio-startrek-sounds () -;; "Enable sounds from Star Trek the original series." -;; (interactive) -;; (setq gnus-audio-busy-sound "working.au") -;; (setq gnus-audio-enter-group "bulkhead_door.au") -;; (setq gnus-audio-exit-group "bulkhead_door.au") -;; (setq gnus-audio-score-group "ST_laser.au") -;; (setq gnus-audio-theme-song "startrek.au") -;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) -;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) -;;;*** - -(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" - "Name of the Gnus startup jingle file.") - -(defun gnus-play-jingle () - "Play the Gnus startup jingle, unless that's inhibited." - (interactive) - (gnus-audio-play gnus-startup-jingle)) - -(provide 'gnus-audio) - -(run-hooks 'gnus-audio-load-hook) - -;;; gnus-audio.el ends here diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-cus.el --- a/lisp/gnus/gnus-cus.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-cus.el Sun Sep 26 04:03:19 2010 +0000 @@ -865,11 +865,6 @@ Check the [ ] for the entries you want to apply to this score file, then edit the value to suit your taste. Don't forget to mark the checkbox, if you do all your changes will be lost. ") - (widget-create 'push-button - :action (lambda (&rest ignore) - (require 'gnus-audio) - (gnus-audio-play "Evil_Laugh.au")) - "Bhahahah!") (widget-insert "\n\n") (make-local-variable 'gnus-custom-scores) (setq gnus-custom-scores diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-demon.el --- a/lisp/gnus/gnus-demon.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-demon.el Sun Sep 26 04:03:19 2010 +0000 @@ -240,15 +240,6 @@ ;; this idle-cycle. (push (car handler) gnus-demon-idle-has-been-called))))))))) -(defun gnus-demon-add-nocem () - "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) - -(defun gnus-demon-scan-nocem () - "Scan NoCeM groups for NoCeM messages." - (save-window-excursion - (gnus-nocem-scan-groups))) - (defun gnus-demon-add-disconnection () "Add daemonic server disconnection to Gnus." (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-group.el --- a/lisp/gnus/gnus-group.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-group.el Sun Sep 26 04:03:19 2010 +0000 @@ -2418,6 +2418,14 @@ (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) (with-temp-file tmpfile (url-insert-file-contents (format mbox-url number)) + (goto-char (point-min)) + ;; Add the debbugs address so that we can respond to reports easily. + (while (re-search-forward "^To: " nil t) + (end-of-line) + (insert (format ", %s@%s" number + (replace-regexp-in-string + "/.*$" "" + (replace-regexp-in-string "^http://" "" mbox-url))))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group "gnus-read-ephemeral-bug" @@ -3946,14 +3954,6 @@ (unless gnus-slave (gnus-master-read-slave-newsrc)) - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp arg) - (>= arg gnus-use-nocem)) - (not arg))) - (gnus-nocem-scan-groups)) - (gnus-get-unread-articles arg) ;; If the user wants it, we scan for new groups. diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-html.el --- a/lisp/gnus/gnus-html.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-html.el Sun Sep 26 04:03:19 2010 +0000 @@ -104,7 +104,12 @@ (match-string 0 encoded-text))) t t encoded-text) s (1+ s))) - encoded-text))))) + encoded-text)))) + ;; XEmacs does not have window-inside-pixel-edges + (defalias 'gnus-window-inside-pixel-edges + (if (fboundp 'window-inside-pixel-edges) + 'window-inside-pixel-edges + 'window-pixel-edges))) (defun gnus-html-encode-url (url) "Encode URL." @@ -450,7 +455,7 @@ image (let* ((width (car size)) (height (cdr size)) - (edges (window-pixel-edges (get-buffer-window (current-buffer)))) + (edges (gnus-window-inside-pixel-edges (get-buffer-window (current-buffer)))) (window-width (truncate (* gnus-max-image-proportion (- (nth 2 edges) (nth 0 edges))))) (window-height (truncate (* gnus-max-image-proportion diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-int.el --- a/lisp/gnus/gnus-int.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-int.el Sun Sep 26 04:03:19 2010 +0000 @@ -181,10 +181,15 @@ (prog1 (setq result (gnus-open-server method)) (unless silent - (gnus-message 5 "Opening %s server%s...%s" (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))) - (if result "done" "failed"))))))) + (gnus-message + (if result 5 3) + "Opening %s server%s...%s" (car method) + (if (equal (nth 1 method) "") "" + (format " on %s" (nth 1 method))) + (if result + "done" + (format "failed: %s" + (nnheader-get-report-string (car method)))))))))) (defun gnus-get-function (method function &optional noerror) "Return a function symbol based on METHOD and FUNCTION." @@ -265,36 +270,31 @@ (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. - (setcar (cdr elem) - (cond (result - (if (eq open-server-function #'nnagent-open-server) - ;; The agent's backend has a "special" status - 'offline - 'ok)) - ((and gnus-agent - (gnus-agent-method-p gnus-command-method)) - (cond (gnus-server-unopen-status - ;; Set the server's status to the unopen - ;; status. If that status is offline, - ;; recurse to open the agent's backend. - (setq open-offline (eq gnus-server-unopen-status 'offline)) - gnus-server-unopen-status) - ((and - (not gnus-batch-mode) - (gnus-y-or-n-p - (format - "Unable to open server %s (%s), go offline? " - server - (nnheader-get-report - (car gnus-command-method))))) - (setq open-offline t) - 'offline) - (t - ;; This agentized server was still denied - 'denied))) - (t - ;; This unagentized server must be denied - 'denied))) + (setcar + (cdr elem) + (cond (result + (if (eq open-server-function #'nnagent-open-server) + ;; The agent's backend has a "special" status + 'offline + 'ok)) + ((and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (cond + (gnus-server-unopen-status + ;; Set the server's status to the unopen + ;; status. If that status is offline, + ;; recurse to open the agent's backend. + (setq open-offline (eq gnus-server-unopen-status 'offline)) + gnus-server-unopen-status) + ((not gnus-batch-mode) + (setq open-offline t) + 'offline) + (t + ;; This agentized server was still denied + 'denied))) + (t + ;; This unagentized server must be denied + 'denied))) ;; NOTE: I MUST set the server's status to offline before this ;; recursive call as this status will drive the diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-nocem.el --- a/lisp/gnus/gnus-nocem.el Sun Sep 26 03:39:24 2010 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,452 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'nnmail) -(require 'gnus-art) -(require 'gnus-sum) -(require 'gnus-range) - -(defgroup gnus-nocem nil - "NoCeM pseudo-cancellation treatment." - :group 'gnus-score) - -(defcustom gnus-nocem-groups - '("news.lists.filters" "alt.nocem.misc") - "*List of groups that will be searched for NoCeM messages." - :group 'gnus-nocem - :version "23.1" - :type '(repeat (string :tag "Group"))) - -(defcustom gnus-nocem-issuers - '("Adri Verhoef" - "alba-nocem@albasani.net" - "bleachbot@httrack.com" - "news@arcor-online.net" - "news@uni-berlin.de" - "nocem@arcor.de" - "pgpmoose@killfile.org" - "xjsppl@gmx.de") - "*List of NoCeM issuers to pay attention to. - -This can also be a list of `(ISSUER CONDITION ...)' elements. - -See for an -issuer registry." - :group 'gnus-nocem - :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") - :version "23.1" - :type '(repeat (cons :format "%v" (string :tag "Issuer") - (repeat :tag "Condition" - (group (checklist :inline t (const not)) - (regexp :tag "Type" :value ".*"))))) - :get (lambda (symbol) - (mapcar (lambda (elem) - (if (consp elem) - (cons (car elem) - (mapcar (lambda (elt) - (if (consp elt) elt (list elt))) - (cdr elem))) - (list elem))) - (default-value symbol))) - :set (lambda (symbol value) - (custom-set-default - symbol - (mapcar (lambda (elem) - (if (consp elem) - (if (cdr elem) - (mapcar (lambda (elt) - (if (consp elt) - (if (cdr elt) elt (car elt)) - elt)) - elem) - (car elem)) - elem)) - value)))) - -(defcustom gnus-nocem-directory - (nnheader-concat gnus-article-save-directory "NoCeM/") - "*Directory where NoCeM files will be stored." - :group 'gnus-nocem - :type 'directory) - -(defcustom gnus-nocem-expiry-wait 15 - "*Number of days to keep NoCeM headers in the cache." - :group 'gnus-nocem - :type 'integer) - -(defcustom gnus-nocem-verifyer (if (locate-library "epg") - 'gnus-nocem-epg-verify - 'pgg-verify) - "*Function called to verify that the NoCeM message is valid. -If the function in this variable isn't bound, the message will be used -unconditionally." - :group 'gnus-nocem - :version "23.1" - :type '(radio (function-item gnus-nocem-epg-verify) - (function-item pgg-verify) - (function-item mc-verify) - (function :tag "other")) - :set (lambda (symbol value) - (custom-set-default symbol - (if (and (eq value 'gnus-nocem-epg-verify) - (not (locate-library "epg"))) - 'pgg-verify - value)))) - -(defcustom gnus-nocem-liberal-fetch nil - "*If t try to fetch all messages which have @@NCM in the subject. -Otherwise don't fetch messages which have references or whose message-id -matches a previously scanned and verified nocem message." - :group 'gnus-nocem - :type 'boolean) - -(defcustom gnus-nocem-check-article-limit 500 - "*If non-nil, the maximum number of articles to check in any NoCeM group." - :group 'gnus-nocem - :version "21.1" - :type '(choice (const :tag "unlimited" nil) - (integer 1000))) - -(defcustom gnus-nocem-check-from t - "Non-nil means check for valid issuers in message bodies. -Otherwise don't bother fetching articles unless their author matches a -valid issuer, which is much faster if you are selective about the issuers." - :group 'gnus-nocem - :version "21.1" - :type 'boolean) - -;;; Internal variables - -(defvar gnus-nocem-active nil) -(defvar gnus-nocem-alist nil) -(defvar gnus-nocem-touched-alist nil) -(defvar gnus-nocem-hashtb nil) -(defvar gnus-nocem-seen-message-ids nil) - -;;; Functions - -(defun gnus-nocem-active-file () - (concat (file-name-as-directory gnus-nocem-directory) "active")) - -(defun gnus-nocem-cache-file () - (concat (file-name-as-directory gnus-nocem-directory) "cache")) - -;; -;; faster lookups for group names: -;; - -(defvar gnus-nocem-real-group-hashtb nil - "Real-name mappings of subscribed groups.") - -(defun gnus-fill-real-hashtb () - "Fill up a hash table with the real-name mappings from the user's active file." - (if (hash-table-p gnus-nocem-real-group-hashtb) - (clrhash gnus-nocem-real-group-hashtb) - (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) - (mapcar (lambda (group) - (setq group (gnus-group-real-name (car group))) - (puthash group t gnus-nocem-real-group-hashtb)) - gnus-newsrc-alist)) - -;;;###autoload -(defun gnus-nocem-scan-groups () - "Scan all NoCeM groups for new NoCeM messages." - (interactive) - (let ((groups gnus-nocem-groups) - (gnus-inhibit-demon t) - group active gactive articles check-headers) - (gnus-make-directory gnus-nocem-directory) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; Get the group name mappings: - (gnus-fill-real-hashtb) - ;; Read the active file if it hasn't been read yet. - (and (file-exists-p (gnus-nocem-active-file)) - (not gnus-nocem-active) - (ignore-errors - (load (gnus-nocem-active-file) t t t))) - ;; Go through all groups and see whether new articles have - ;; arrived. - (while (setq group (pop groups)) - (if (not (setq gactive (gnus-activate-group group))) - () ; This group doesn't exist. - (setq active (nth 1 (assoc group gnus-nocem-active))) - (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. - (or (not active) - (< (cdr active) (cdr gactive)))) - ;; Ok, there are new articles in this group, se we fetch the - ;; headers. - (save-excursion - (let ((dependencies (make-vector 10 nil)) - headers header) - (with-temp-buffer - (setq headers - (if (eq 'nov - (gnus-retrieve-headers - (setq articles - (gnus-uncompress-range - (cons - (if active (1+ (cdr active)) - (car gactive)) - (cdr gactive)))) - group)) - (gnus-get-newsgroup-headers-xover - articles nil dependencies) - (gnus-get-newsgroup-headers dependencies))) - (while (setq header (pop headers)) - ;; We take a closer look on all articles that have - ;; "@@NCM" in the subject. Unless we already read - ;; this cross posted message. Nocem messages - ;; are not allowed to have references, so we can - ;; ignore scanning followups. - (and (string-match "@@NCM" (mail-header-subject header)) - (and gnus-nocem-check-from - (let ((case-fold-search t)) - (catch 'ok - (mapc - (lambda (author) - (if (consp author) - (setq author (car author))) - (if (string-match - author (mail-header-from header)) - (throw 'ok t))) - gnus-nocem-issuers) - nil))) - (or gnus-nocem-liberal-fetch - (and (or (string= "" (mail-header-references - header)) - (null (mail-header-references header))) - (not (member (mail-header-message-id header) - gnus-nocem-seen-message-ids)))) - (push header check-headers))) - (setq check-headers (last (nreverse check-headers) - gnus-nocem-check-article-limit)) - (let ((i 0) - (len (length check-headers))) - (dolist (h check-headers) - (gnus-message - 7 "Checking article %d in %s for NoCeM (%d of %d)..." - (mail-header-number h) group (incf i) len) - (gnus-nocem-check-article group h))))))) - (setq gnus-nocem-active - (cons (list group gactive) - (delq (assoc group gnus-nocem-active) - gnus-nocem-active))))) - ;; Save the results, if any. - (gnus-nocem-save-cache) - (gnus-nocem-save-active))) - -(defun gnus-nocem-check-article (group header) - "Check whether the current article is an NCM article and that we want it." - ;; Get the article. - (let ((date (mail-header-date header)) - (gnus-newsgroup-name group) - issuer b e type) - (when (or (not date) - (time-less-p - (time-since (date-to-time date)) - (days-to-time gnus-nocem-expiry-wait))) - (gnus-request-article-this-buffer (mail-header-number header) group) - (goto-char (point-min)) - (when (re-search-forward - "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----" - nil t) - (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward - "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?" - nil t) - (delete-region (match-end 0) (point-max))) - (goto-char (point-min)) - ;; The article has to have proper NoCeM headers. - (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) - (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) - ;; We get the name of the issuer. - (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer") - type (mail-fetch-field "type")) - (widen) - (if (not (gnus-nocem-message-wanted-p issuer type)) - (message "invalid NoCeM issuer: %s" issuer) - (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. - (gnus-nocem-enter-article) ; We gobble the message. - (push (mail-header-message-id header) ; But don't come back for - gnus-nocem-seen-message-ids))))))) ; second helpings. - -(defun gnus-nocem-message-wanted-p (issuer type) - (let ((issuers gnus-nocem-issuers) - wanted conditions condition) - (cond - ;; Do the quick check first. - ((member issuer issuers) - t) - ((setq conditions (cdr (assoc issuer issuers))) - ;; Check whether we want this type. - (while (setq condition (pop conditions)) - (cond - ((stringp condition) - (when (string-match condition type) - (setq wanted t))) - ((and (consp condition) - (eq (car condition) 'not) - (stringp (cadr condition))) - (when (string-match (cadr condition) type) - (setq wanted nil))) - (t - (error "Invalid NoCeM condition: %S" condition)))) - wanted)))) - -(defun gnus-nocem-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (if (functionp gnus-nocem-verifyer) - (ignore-errors - (funcall gnus-nocem-verifyer)) - ;; If we don't have Mailcrypt, then we use the message anyway. - t)) - -(defun gnus-nocem-enter-article () - "Enter the current article into the NoCeM cache." - (goto-char (point-min)) - (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) - (e (search-forward "\n@@END NCM BODY\n" nil t)) - (buf (current-buffer)) - ncm id group) - (when (and b e) - (narrow-to-region b (1+ (match-beginning 0))) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (cond - ((not (ignore-errors - (setq group (gnus-group-real-name (symbol-name (read buf)))) - (gethash group gnus-nocem-real-group-hashtb))) - ;; An error. - ) - (t - ;; Valid group. - (beginning-of-line) - (while (eq (char-after) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (if (hash-table-p gnus-nocem-hashtb) - (gethash id gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) - nil) - ;; only store if not already present - (puthash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (eq (char-after) ?\t) - (forward-line 1))))) - (when ncm - (setq gnus-nocem-touched-alist t) - (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) - gnus-nocem-alist)) - t))) - -;;;###autoload -(defun gnus-nocem-load-cache () - "Load the NoCeM cache." - (interactive) - (unless gnus-nocem-alist - ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. - (when (file-exists-p (gnus-nocem-cache-file)) - (load (gnus-nocem-cache-file) t t t) - (gnus-nocem-alist-to-hashtb)))) - -(defun gnus-nocem-save-cache () - "Save the NoCeM cache." - (when (and gnus-nocem-alist - gnus-nocem-touched-alist) - (with-temp-file (gnus-nocem-cache-file) - (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) - (setq gnus-nocem-touched-alist nil))) - -(defun gnus-nocem-save-active () - "Save the NoCeM active file." - (with-temp-file (gnus-nocem-active-file) - (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) - -(defun gnus-nocem-alist-to-hashtb () - "Create a hashtable from the Message-IDs we have." - (let* ((alist gnus-nocem-alist) - (pprev (cons nil alist)) - (prev pprev) - (expiry (days-to-time gnus-nocem-expiry-wait)) - entry) - (if (hash-table-p gnus-nocem-hashtb) - (clrhash gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) - (while (setq entry (car alist)) - (if (not (time-less-p (time-since (car entry)) expiry)) - ;; This entry has expired, so we remove it. - (setcdr prev (cdr alist)) - (setq prev alist) - ;; This is ok, so we enter it into the hashtable. - (setq entry (cdr entry)) - (while entry - (puthash (car entry) t gnus-nocem-hashtb) - (setq entry (cdr entry)))) - (setq alist (cdr alist))))) - -(gnus-add-shutdown 'gnus-nocem-close 'gnus) - -(defun gnus-nocem-close () - "Clear internal NoCeM variables." - (setq gnus-nocem-alist nil - gnus-nocem-hashtb nil - gnus-nocem-active nil - gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil - gnus-nocem-real-group-hashtb nil)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (and gnus-nocem-hashtb - (gethash id gnus-nocem-hashtb))) - -(autoload 'epg-make-context "epg") -(eval-when-compile - (autoload 'epg-verify-string "epg") - (autoload 'epg-context-result-for "epg") - (autoload 'epg-signature-status "epg")) - -(defun gnus-nocem-epg-verify () - "Return t if EasyPG verifies a signed message in the current buffer." - (let ((context (epg-make-context 'OpenPGP)) - result) - (epg-verify-string context (buffer-string)) - (and (setq result (epg-context-result-for context 'verify)) - (not (cdr result)) - (eq (epg-signature-status (car result)) 'good)))) - -(provide 'gnus-nocem) - -;;; gnus-nocem.el ends here diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-srvr.el --- a/lisp/gnus/gnus-srvr.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-srvr.el Sun Sep 26 04:03:19 2010 +0000 @@ -28,6 +28,7 @@ (eval-when-compile (require 'cl)) (require 'gnus) +(require 'gnus-start) (require 'gnus-spec) (require 'gnus-group) (require 'gnus-int) @@ -547,6 +548,7 @@ (gnus-server-list-servers)) (defun gnus-server-copy-server (from to) + "Copy a server definiton to a new name." (interactive (list (or (gnus-server-server-name) @@ -643,6 +645,30 @@ (defvar gnus-browse-menu-hook nil "*Hook run after the creation of the browse mode menu.") +(defcustom gnus-browse-subscribe-newsgroup-method + 'gnus-subscribe-alphabetically + "Function(s) called when subscribing groups in the Browse Server Buffer +A few pre-made functions are supplied: `gnus-subscribe-randomly' +inserts new groups at the beginning of the list of groups; +`gnus-subscribe-alphabetically' inserts new groups in strict +alphabetic order; `gnus-subscribe-hierarchically' inserts new groups +in hierarchical newsgroup order; `gnus-subscribe-interactively' asks +for your decision; `gnus-subscribe-killed' kills all new groups; +`gnus-subscribe-zombies' will make all new groups into zombies; +`gnus-subscribe-topics' will enter groups into the topics that +claim them." + :version "24.1" + :group 'gnus-server + :type '(radio (function-item gnus-subscribe-randomly) + (function-item gnus-subscribe-alphabetically) + (function-item gnus-subscribe-hierarchically) + (function-item gnus-subscribe-interactively) + (function-item gnus-subscribe-killed) + (function-item gnus-subscribe-zombies) + (function-item gnus-subscribe-topics) + function + (repeat function))) + (defvar gnus-browse-mode-hook nil) (defvar gnus-browse-mode-map nil) (put 'gnus-browse-mode 'mode-class 'special) @@ -890,7 +916,9 @@ (gnus-browse-next-group (- n))) (defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." + "(Un)subscribe to the next ARG groups. +The variable `gnus-browse-subscribe-newsgroup-method' determines +how new groups will be entered into the group buffer." (interactive "p") (when (eobp) (error "No group at current line")) @@ -939,22 +967,24 @@ ;; subscribe to it. (if (gnus-ephemeral-group-p group) (gnus-kill-ephemeral-group group)) - ;; We need to discern between killed/zombie groups and - ;; just unsubscribed ones. - (gnus-group-change-level - (or (gnus-group-entry group) - (list t group gnus-level-default-subscribed - nil nil (if (gnus-server-equal - gnus-browse-current-method "native") - nil - (gnus-method-simplify - gnus-browse-current-method)))) - gnus-level-default-subscribed (gnus-group-level group) - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-group-entry (car (nth 1 gnus-newsrc-alist)))) - (null (gnus-group-entry group))) + (let ((entry (gnus-group-entry group))) + (if entry + ;; Just change the subscription level if it is an + ;; unsubscribed group. + (gnus-group-change-level entry + gnus-level-default-subscribed) + ;; If it is a killed group or a zombie, feed it to the + ;; mechanism for new group subscription. + (gnus-call-subscribe-functions + gnus-browse-subscribe-newsgroup-method + group))) (delete-char 1) - (insert ? )) + (insert (let ((lvl (gnus-group-level group))) + (cond + ((< lvl gnus-level-unsubscribed) ? ) + ((< lvl gnus-level-zombie) ?U) + ((< lvl gnus-level-killed) ?Z) + (t ?K))))) (gnus-group-change-level group gnus-level-unsubscribed gnus-level-default-subscribed) (delete-char 1) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-start.el --- a/lisp/gnus/gnus-start.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-start.el Sun Sep 26 04:03:19 2010 +0000 @@ -1063,15 +1063,6 @@ (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)) - ;; We might read in new NoCeM messages here. - (when (and (not dont-connect) - gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp level) - (>= level gnus-use-nocem)) - (not level))) - (gnus-nocem-scan-groups)) - ;; Read any slave files. (gnus-master-read-slave-newsrc) @@ -1767,8 +1758,10 @@ (not (gnus-method-denied-p method))) (unless (gnus-server-opened method) (gnus-open-server method)) - (when (gnus-check-backend-function - 'retrieve-group-data-early (car method)) + (when (and + (gnus-server-opened method) + (gnus-check-backend-function + 'retrieve-group-data-early (car method))) (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) (setcar (nthcdr 3 elem) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Sun Sep 26 04:03:19 2010 +0000 @@ -2047,6 +2047,7 @@ "e" gnus-summary-end-of-article "^" gnus-summary-refer-parent-article "r" gnus-summary-refer-parent-article + "C" gnus-summary-show-complete-article "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread @@ -8645,8 +8646,7 @@ (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) (not (eq gnus-build-sparse-threads 'more)) - (null gnus-thread-expunge-below) - (not gnus-use-nocem))) + (null gnus-thread-expunge-below))) (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit nil) (mapatoms @@ -8729,14 +8729,7 @@ t) ;; Do the `display' group parameter. (and gnus-newsgroup-display - (not (funcall gnus-newsgroup-display))) - ;; Check NoCeM things. - (when (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t))) + (not (funcall gnus-newsgroup-display))))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit @@ -9357,6 +9350,18 @@ (ps-spool-buffer))))) (kill-buffer buffer)))) +(defun gnus-summary-show-complete-article () + "Show a complete version of the current article. +This is only useful if you're looking at a partial version of the +article currently." + (interactive) + (let ((gnus-keep-backlog nil) + (gnus-use-cache nil) + (gnus-agent nil) + (gnus-fetch-partial-articles nil)) + (gnus-flush-original-article-buffer) + (gnus-summary-show-article))) + (defun gnus-summary-show-article (&optional arg) "Force redisplaying of the current article. If ARG (the prefix) is a number, show the article with the charset diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/gnus.el --- a/lisp/gnus/gnus.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/gnus.el Sun Sep 26 04:03:19 2010 +0000 @@ -308,11 +308,6 @@ :group 'gnus-start :type 'boolean) -(defcustom gnus-play-startup-jingle nil - "If non-nil, play the Gnus jingle at startup." - :group 'gnus-start - :type 'boolean) - (unless (fboundp 'gnus-group-remove-excess-properties) (defalias 'gnus-group-remove-excess-properties 'ignore)) @@ -960,8 +955,6 @@ (defvar gnus-group-buffer "*Group*") -(autoload 'gnus-play-jingle "gnus-audio") - (defface gnus-splash '((((class color) (background dark)) @@ -984,9 +977,7 @@ (erase-buffer) (unless gnus-inhibit-startup-message (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) + (sit-for 0))))) (defun gnus-indent-rigidly (start end arg) "Indent rigidly using only spaces and no tabs." @@ -1580,25 +1571,6 @@ (sexp :format "all" :value t))) -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages. -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. -Otherwise, Gnus does not scan NoCeM messages if you specify a group -level to those commands." - :group 'gnus-meta - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (list :convert-widget - (lambda (widget) - (list 'integer :tag "group level" - :value (if (boundp 'gnus-level-default-subscribed) - gnus-level-default-subscribed - 3)))))) - (defcustom gnus-suppress-duplicates nil "*If non-nil, Gnus will mark duplicate copies of the same article as read." :group 'gnus-meta @@ -2813,13 +2785,12 @@ rmail-summary-exists rmail-select-summary) ;; Only used in gnus-util, which has an autoload. ("rmailsum" rmail-update-summary) - ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail + ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) @@ -2830,8 +2801,6 @@ gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) - ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close - gnus-nocem-unwanted-article-p) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) @@ -4395,7 +4364,7 @@ ;; When using the development version of Gnus, load the gnus-load ;; file. (unless (string-match "^Gnus" gnus-version) - (load "gnus-load")) + (load "gnus-load" nil t)) (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/mm-decode.el --- a/lisp/gnus/mm-decode.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/mm-decode.el Sun Sep 26 04:03:19 2010 +0000 @@ -1147,13 +1147,15 @@ ;; time to adjust it, since we know at this point that it should ;; be unibyte. `(let* ((handle ,handle)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - ,@forms))) + (when (and (mm-handle-buffer handle) + (buffer-name (mm-handle-buffer handle))) + (with-temp-buffer + (mm-disable-multibyte) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + ,@forms)))) (put 'mm-with-part 'lisp-indent-function 1) (put 'mm-with-part 'edebug-form-spec '(body)) @@ -1246,9 +1248,13 @@ (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt "Save MIME part to: ") + (read-file-name (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) (or mm-default-directory default-directory) - nil nil (or filename ""))) + (or filename ""))) + (when (file-directory-p file) + (setq file (expand-file-name filename file))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? " diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/mml1991.el --- a/lisp/gnus/mml1991.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/mml1991.el Sun Sep 26 04:03:19 2010 +0000 @@ -57,8 +57,6 @@ (defvar mml1991-function-alist '((mailcrypt mml1991-mailcrypt-sign mml1991-mailcrypt-encrypt) - (gpg mml1991-gpg-sign - mml1991-gpg-encrypt) (pgg mml1991-pgg-sign mml1991-pgg-encrypt) (epg mml1991-epg-sign @@ -168,99 +166,6 @@ (insert-buffer-substring cipher) (goto-char (point-max)))))) -;;; gpg wrapper - -(autoload 'gpg-sign-cleartext "gpg") - -(declare-function gpg-sign-encrypt "ext:gpg" - (plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode)) -(declare-function gpg-encrypt "ext:gpg" - (plaintext ciphertext result recipients &optional - passphrase armor textmode)) - -(defun mml1991-gpg-sign (cont) - (let ((text (current-buffer)) - headers signature - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Save MIME Content[^ ]+: headers from signing - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (setq headers (buffer-string)) - (delete-region (point-min) (point))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (quoted-printable-decode-region (point-min) (point-max)) - (with-temp-buffer - (unless (gpg-sign-cleartext text (setq signature (current-buffer)) - result-buffer - nil - (message-options-get 'message-sender)) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (quoted-printable-encode-region (point-min) (point-max)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (if headers (insert headers)) - (insert "\n") - (insert-buffer-substring signature) - (goto-char (point-max))))) - -(defun mml1991-gpg-encrypt (cont &optional sign) - (let ((text (current-buffer)) - cipher - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMORED - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (inline (mm-disable-multibyte)) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign - text (setq cipher (current-buffer)) - result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) - ;; pgg wrapper (defvar pgg-default-user-id) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/mml2015.el --- a/lisp/gnus/mml2015.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/mml2015.el Sun Sep 26 04:03:19 2010 +0000 @@ -63,11 +63,6 @@ (require 'pgg))) (and (fboundp 'pgg-sign-region) 'pgg)) - (progn - (ignore-errors - (require 'gpg)) - (and (fboundp 'gpg-sign-detached) - 'gpg)) (progn (ignore-errors (load "mc-toplev")) (and (fboundp 'mc-encrypt-generic) @@ -75,7 +70,7 @@ (fboundp 'mc-cleanup-recipient-headers) 'mailcrypt))) "The package used for PGP/MIME. -Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") +Valid packages include `epg', `pgg' and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist @@ -85,24 +80,18 @@ mml2015-mailcrypt-decrypt mml2015-mailcrypt-clear-verify mml2015-mailcrypt-clear-decrypt) - (gpg mml2015-gpg-sign - mml2015-gpg-encrypt - mml2015-gpg-verify - mml2015-gpg-decrypt - mml2015-gpg-clear-verify - mml2015-gpg-clear-decrypt) - (pgg mml2015-pgg-sign - mml2015-pgg-encrypt - mml2015-pgg-verify - mml2015-pgg-decrypt - mml2015-pgg-clear-verify - mml2015-pgg-clear-decrypt) - (epg mml2015-epg-sign - mml2015-epg-encrypt - mml2015-epg-verify - mml2015-epg-decrypt - mml2015-epg-clear-verify - mml2015-epg-clear-decrypt)) + (pgg mml2015-pgg-sign + mml2015-pgg-encrypt + mml2015-pgg-verify + mml2015-pgg-decrypt + mml2015-pgg-clear-verify + mml2015-pgg-clear-decrypt) + (epg mml2015-epg-sign + mml2015-epg-encrypt + mml2015-epg-verify + mml2015-epg-decrypt + mml2015-epg-clear-verify + mml2015-epg-clear-decrypt)) "Alist of PGP/MIME functions.") (defvar mml2015-result-buffer nil) @@ -148,7 +137,7 @@ ;; Extract plaintext from cleartext signature. IMO, this kind of task ;; should be done by GnuPG rather than Elisp, but older PGP backends -;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. +;; (such as Mailcrypt, and PGG) discard the output from GnuPG. (defun mml2015-extract-cleartext-signature () ;; Daiki Ueno in ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still @@ -234,6 +223,58 @@ handles (list handles))))) +(defun mml2015-gpg-pretty-print-fpr (fingerprint) + (let* ((result "") + (fpr-length (string-width fingerprint)) + (n-slice 0) + slice) + (setq fingerprint (string-to-list fingerprint)) + (while fingerprint + (setq fpr-length (- fpr-length 4)) + (setq slice (butlast fingerprint fpr-length)) + (setq fingerprint (nthcdr 4 fingerprint)) + (setq n-slice (1+ n-slice)) + (setq result + (concat + result + (case n-slice + (1 slice) + (otherwise (concat " " slice)))))) + result)) + +(defun mml2015-gpg-extract-signature-details () + (goto-char (point-min)) + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (signer (and (re-search-forward + "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" + nil t) + (cons (match-string 1) (match-string 2)))) + (fprint (and (re-search-forward + "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " + nil t) + (match-string 1))) + (trust (and (re-search-forward + "^\\[GNUPG:\\] \\(TRUST_.*\\)$" + nil t) + (match-string 1))) + (trust-good-enough-p + (cdr (assoc trust mml2015-unabbrev-trust-alist)))) + (cond ((and signer fprint) + (concat (cdr signer) + (unless trust-good-enough-p + (concat "\nUntrusted, Fingerprint: " + (mml2015-gpg-pretty-print-fpr fprint))) + (when expired + (format "\nWARNING: Signature from expired key (%s)" + (car signer))))) + ((re-search-forward + "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) + (match-string 2)) + (t + "From unknown user")))) + (defun mml2015-mailcrypt-clear-decrypt () (let (result) (setq result @@ -446,280 +487,6 @@ (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) -;;; gpg wrapper - -(autoload 'gpg-decrypt "gpg") -(autoload 'gpg-verify "gpg") -(autoload 'gpg-verify-cleartext "gpg") -(autoload 'gpg-sign-detached "gpg") -(autoload 'gpg-sign-encrypt "gpg") -(autoload 'gpg-encrypt "gpg") -(autoload 'gpg-passphrase-read "gpg") - -(defun mml2015-gpg-passphrase () - (or (message-options-get 'gpg-passphrase) - (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) - -(defun mml2015-gpg-decrypt-1 () - (let ((cipher (current-buffer)) plain result) - (if (with-temp-buffer - (prog1 - (gpg-decrypt cipher (setq plain (current-buffer)) - mml2015-result-buffer nil) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string))) - (set-buffer cipher) - (erase-buffer) - (insert-buffer-substring plain) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)))) - '(t) - ;; Some wrong with the return value, check plain text buffer. - (if (> (point-max) (point-min)) - '(t) - nil)))) - -(defun mml2015-gpg-decrypt (handle ctl) - (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) - (mml2015-mailcrypt-decrypt handle ctl))) - -(defun mml2015-gpg-clear-decrypt () - (let (result) - (setq result (mml2015-gpg-decrypt-1)) - (if (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-gpg-pretty-print-fpr (fingerprint) - (let* ((result "") - (fpr-length (string-width fingerprint)) - (n-slice 0) - slice) - (setq fingerprint (string-to-list fingerprint)) - (while fingerprint - (setq fpr-length (- fpr-length 4)) - (setq slice (butlast fingerprint fpr-length)) - (setq fingerprint (nthcdr 4 fingerprint)) - (setq n-slice (1+ n-slice)) - (setq result - (concat - result - (case n-slice - (1 slice) - (otherwise (concat " " slice)))))) - result)) - -(defun mml2015-gpg-extract-signature-details () - (goto-char (point-min)) - (let* ((expired (re-search-forward - "^\\[GNUPG:\\] SIGEXPIRED$" - nil t)) - (signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" - nil t) - (cons (match-string 1) (match-string 2)))) - (fprint (and (re-search-forward - "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " - nil t) - (match-string 1))) - (trust (and (re-search-forward - "^\\[GNUPG:\\] \\(TRUST_.*\\)$" - nil t) - (match-string 1))) - (trust-good-enough-p - (cdr (assoc trust mml2015-unabbrev-trust-alist)))) - (cond ((and signer fprint) - (concat (cdr signer) - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint))) - (when expired - (format "\nWARNING: Signature from expired key (%s)" - (car signer))))) - ((re-search-forward - "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) - (match-string 2)) - (t - "From unknown user")))) - -(defun mml2015-gpg-verify (handle ctl) - (catch 'error - (let (part message signature info-is-set-p) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (setq message (current-buffer)) - (insert part) - ;; Convert to in signed text. If --textmode is - ;; specified when signing, the conversion is not necessary. - (goto-char (point-min)) - (end-of-line) - (while (not (eobp)) - (unless (eq (char-before) ?\r) - (insert "\r")) - (forward-line) - (end-of-line)) - (with-temp-buffer - (setq signature (current-buffer)) - (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (mm-insert-part part) - (unless (condition-case err - (prog1 - (gpg-verify message signature mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Error.") - (setq info-is-set-p t) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Quit.") - (setq info-is-set-p t) - nil)) - (unless info-is-set-p - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (throw 'error handle))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details)))) - handle))) - -(defun mml2015-gpg-clear-verify () - (if (condition-case err - (prog1 - (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (mml2015-extract-cleartext-signature)) - -(defun mml2015-gpg-sign (cont) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) signature) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (with-temp-buffer - (unless (gpg-sign-detached text (setq signature (current-buffer)) - mml2015-result-buffer - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - ;;; FIXME: what is the micalg? - (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer-substring signature) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max))))) - -(defun mml2015-gpg-encrypt (cont &optional sign) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) - cipher) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (mm-disable-multibyte) - ;; set up a function to call the correct gpg encrypt routine - ;; with the right arguments. (FIXME: this should be done - ;; differently.) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign ; passed in when using signencrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer-substring cipher) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))))) - ;;; pgg wrapper (defvar pgg-default-user-id) diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/nndoc.el --- a/lisp/gnus/nndoc.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/nndoc.el Sun Sep 26 04:03:19 2010 +0000 @@ -64,9 +64,6 @@ (body-end . "") (file-end . "") (subtype digest guess)) - (mime-parts - (generate-head-function . nndoc-generate-mime-parts-head) - (article-transform-function . nndoc-transform-mime-parts)) (nsmail (article-begin . "^From - ")) (news @@ -77,6 +74,9 @@ (mbox (article-begin-function . nndoc-mbox-article-begin) (body-end-function . nndoc-mbox-body-end)) + (mime-parts + (generate-head-function . nndoc-generate-mime-parts-head) + (article-transform-function . nndoc-transform-mime-parts)) (babyl (article-begin . "\^_\^L *\n") (body-end . "\^_") diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/nnheader.el --- a/lisp/gnus/nnheader.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/nnheader.el Sun Sep 26 04:03:19 2010 +0000 @@ -822,12 +822,16 @@ (apply 'format args))) nil) -(defun nnheader-get-report (backend) +(defun nnheader-get-report-string (backend) "Get the most recent report from BACKEND." (condition-case () - (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (nnheader-message 5 "")))) + (format "%s" (symbol-value (intern (format "%s-status-string" + backend)))) + (error ""))) + +(defun nnheader-get-report (backend) + "Get the most recent report from BACKEND." + (nnheader-message 5 (nnheader-get-report-string backend))) (defun nnheader-insert (format &rest args) "Clear the communication buffer and insert FORMAT and ARGS into the buffer. diff -r aa7656773a38 -r b6d2a63ad993 lisp/gnus/nnimap.el --- a/lisp/gnus/nnimap.el Sun Sep 26 03:39:24 2010 +0200 +++ b/lisp/gnus/nnimap.el Sun Sep 26 04:03:19 2010 +0000 @@ -62,22 +62,23 @@ (defvoo nnimap-inbox nil "The mail box where incoming mail arrives and should be split out of.") +(defvoo nnimap-split-methods nil + "How mail is split. +Uses the same syntax as nnmail-split-methods") + (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods) or `anonymous'.") -(defvoo nnimap-fetch-partial-articles nil - "If non-nil, nnimap will fetch partial articles. -If t, nnimap will fetch only the first part. If a string, it -will fetch all parts that have types that match that string. A -likely value would be \"text/\" to automatically fetch all -textual parts.") - (defvoo nnimap-expunge t "If non-nil, expunge articles after deleting them. This is always done if the server supports UID EXPUNGE, but it's not done by default on servers that doesn't support that command.") +(defvoo nnimap-streaming t + "If non-nil, try to use streaming commands with IMAP servers. +Switching this off will make nnimap slower, but it helps with +some servers.") (defvoo nnimap-connection-alist nil) @@ -110,8 +111,6 @@ (download "gnus-download") (forward "gnus-forward"))) -(defvar nnimap-split-methods nil) - (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -128,8 +127,7 @@ (nnimap-article-ranges (gnus-compress-sequence articles)) (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER.FIELDS %s]" "RFC822.HEADER.LINES %s") (append '(Subject From Date Message-Id @@ -273,42 +271,50 @@ (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) + (port nil) (ports (cond ((eq nnimap-stream 'network) (open-network-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imap") - "imap" - "143"))) + (setq port + (or nnimap-server-port + (if (netrc-find-service-number "imap") + "imap" + "143")))) '("143" "imap")) ((eq nnimap-stream 'shell) (nnimap-open-shell-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port "imap")) + (setq port (or nnimap-server-port "imap"))) '("imap")) ((eq nnimap-stream 'starttls) (starttls-open-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port "imap")) + (setq port (or nnimap-server-port "imap"))) '("imap")) ((eq nnimap-stream 'ssl) (open-tls-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imaps") - "imaps" - "993"))) + (setq port + (or nnimap-server-port + (if (netrc-find-service-number "imaps") + "imaps" + "993")))) '("143" "993" "imap" "imaps")))) connection-result login-result credentials) (setf (nnimap-process nnimap-object) (get-buffer-process (current-buffer))) - (when (and (nnimap-process nnimap-object) - (memq (process-status (nnimap-process nnimap-object)) - '(open run))) + (if (not (and (nnimap-process nnimap-object) + (memq (process-status (nnimap-process nnimap-object)) + '(open run)))) + (nnheader-report 'nnimap "Unable to contact %s:%s via %s" + nnimap-address port nnimap-stream) (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) - (when (setq connection-result (nnimap-wait-for-connection)) + (if (not (setq connection-result (nnimap-wait-for-connection))) + (nnheader-report 'nnimap + "%s" (buffer-substring + (point) (line-end-position))) (when (eq nnimap-stream 'starttls) (nnimap-command "STARTTLS") (starttls-negotiate (nnimap-process nnimap-object))) @@ -370,7 +376,7 @@ (deffoo nnimap-request-article (article &optional group server to-buffer) (with-current-buffer nntp-server-buffer (let ((result (nnimap-possibly-change-group group server)) - parts) + parts structure) (when (stringp article) (setq article (nnimap-find-article-by-message-id group article))) (when (and result @@ -378,36 +384,113 @@ (erase-buffer) (with-current-buffer (nnimap-buffer) (erase-buffer) - (when nnimap-fetch-partial-articles - (if (eq nnimap-fetch-partial-articles t) + (when gnus-fetch-partial-articles + (if (eq gnus-fetch-partial-articles t) (setq parts '(1)) (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) (goto-char (point-min)) (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) - (let ((structure (ignore-errors (read (current-buffer))))) - (setq parts (nnimap-find-wanted-parts structure)))))) - (setq result - (nnimap-command - (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) - "UID FETCH %d BODY.PEEK[]" - "UID FETCH %d RFC822.PEEK") - article)) - ;; Check that we really got an article. - (goto-char (point-min)) - (unless (looking-at "\\* [0-9]+ FETCH") - (setq result nil))) - (let ((buffer (nnimap-find-process-buffer (current-buffer)))) - (when (car result) - (with-current-buffer (or to-buffer nntp-server-buffer) - (insert-buffer-substring buffer) - (goto-char (point-min)) - (let ((bytes (nnimap-get-length))) - (delete-region (line-beginning-position) - (progn (forward-line 1) (point))) - (goto-char (+ (point) bytes)) - (delete-region (point) (point-max)) - (nnheader-ms-strip-cr)) - (cons group article)))))))) + (setq structure (ignore-errors (read (current-buffer))) + parts (nnimap-find-wanted-parts structure))))) + (when (if parts + (nnimap-get-partial-article article parts structure) + (nnimap-get-whole-article article)) + (let ((buffer (current-buffer))) + (with-current-buffer (or to-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring buffer) + (nnheader-ms-strip-cr) + (cons group article))))))))) + +(defun nnimap-get-whole-article (article) + (let ((result + (nnimap-command + (if (nnimap-ver4-p) + "UID FETCH %d BODY.PEEK[]" + "UID FETCH %d RFC822.PEEK") + article))) + ;; Check that we really got an article. + (goto-char (point-min)) + (unless (looking-at "\\* [0-9]+ FETCH") + (setq result nil)) + (when result + (goto-char (point-min)) + (let ((bytes (nnimap-get-length))) + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + (delete-region (point) (point-max))) + t))) + +(defun nnimap-ver4-p () + (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + +(defun nnimap-get-partial-article (article parts structure) + (let ((result + (nnimap-command + "UID FETCH %d (%s %s)" + article + (if (nnimap-ver4-p) + "BODY.PEEK[HEADER]" + "RFC822.HEADER") + (if (nnimap-ver4-p) + (mapconcat (lambda (part) + (format "BODY.PEEK[%s]" part)) + parts " ") + (mapconcat (lambda (part) + (format "RFC822.PEEK[%s]" part)) + parts " "))))) + (when result + (nnimap-convert-partial-article structure)))) + +(defun nnimap-convert-partial-article (structure) + ;; First just skip past the headers. + (goto-char (point-min)) + (let ((bytes (nnimap-get-length)) + id parts) + ;; Delete "FETCH" line. + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + ;; Collect all the body parts. + (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]") + (setq id (match-string 1) + bytes (nnimap-get-length)) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point))) + (push (list id (buffer-substring (point) (+ (point) bytes))) + parts) + (delete-region (point) (+ (point) bytes))) + ;; Delete trailing junk. + (delete-region (point) (point-max)) + ;; Now insert all the parts again where they fit in the structure. + (nnimap-insert-partial-structure structure parts) + t)) + +(defun nnimap-insert-partial-structure (structure parts &optional subp) + (let ((type (car (last structure 4))) + (boundary (cadr (member "BOUNDARY" (car (last structure 3)))))) + (when subp + (insert (format "Content-type: multipart/%s; boundary=%S\n\n" + (downcase type) boundary))) + (while (not (stringp (car structure))) + (insert "\n--" boundary "\n") + (if (consp (caar structure)) + (nnimap-insert-partial-structure (pop structure) parts t) + (let ((bit (pop structure))) + (insert (format "Content-type: %s/%s" + (downcase (nth 0 bit)) + (downcase (nth 1 bit)))) + (if (member "CHARSET" (nth 2 bit)) + (insert (format + "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit))))) + (insert "\n")) + (insert (format "Content-transfer-encoding: %s\n" + (nth 5 bit))) + (insert "\n") + (when (assoc (nth 9 bit) parts) + (insert (cadr (assoc (nth 9 bit) parts))))))) + (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) @@ -423,13 +506,14 @@ (number-to-string num) (format "%s.%s" prefix num))) parts) - (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) - (when (string-match nnimap-fetch-partial-articles type) - (push (if (string= prefix "") + (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))) + (id (if (string= prefix "") (number-to-string num) - (format "%s.%s" prefix num)) - parts))) - (incf num)))) + (format "%s.%s" prefix num)))) + (setcar (nthcdr 9 sub) id) + (when (string-match gnus-fetch-partial-articles type) + (push id parts)))) + (incf num))) (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) @@ -777,7 +861,12 @@ (nnimap-send-command "UID FETCH %d:* FLAGS" start) start (car elem)) - sequences)))) + sequences))) + ;; Some servers apparently can't have many outstanding + ;; commands, so throttle them. + (when (and (not nnimap-streaming) + (car sequences)) + (nnimap-wait-for-response (caar sequences)))) sequences)))) (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) @@ -785,26 +874,26 @@ (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. - (nnimap-wait-for-response (cadar sequences)) - ;; Now we should have all the data we need, no matter whether - ;; we're QRESYNCING, fetching all the flags from scratch, or - ;; just fetching the last 100 flags per group. - (nnimap-update-infos (nnimap-flags-to-marks - (nnimap-parse-flags - (nreverse sequences))) - infos) - ;; Finally, just return something resembling an active file in - ;; the nntp buffer, so that the agent can save the info, too. - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (info infos) - (let* ((group (gnus-info-group info)) - (active (gnus-active group))) - (when active - (insert (format "%S %d %d y\n" - (gnus-group-real-name group) - (cdr active) - (car active)))))))))) + (when (nnimap-wait-for-response (cadar sequences)) + ;; Now we should have all the data we need, no matter whether + ;; we're QRESYNCING, fetching all the flags from scratch, or + ;; just fetching the last 100 flags per group. + (nnimap-update-infos (nnimap-flags-to-marks + (nnimap-parse-flags + (nreverse sequences))) + infos) + ;; Finally, just return something resembling an active file in + ;; the nntp buffer, so that the agent can save the info, too. + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (info infos) + (let* ((group (gnus-info-group info)) + (active (gnus-active group))) + (when active + (insert (format "%S %d %d y\n" + (gnus-group-real-name group) + (cdr active) + (car active))))))))))) (defun nnimap-update-infos (flags infos) (dolist (info infos) @@ -1045,17 +1134,22 @@ (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) - (let ((process (get-buffer-process (current-buffer)))) + (let ((process (get-buffer-process (current-buffer))) + openp) (goto-char (point-max)) - (while (and (memq (process-status process) - '(open run)) - (not (re-search-backward (format "^%d .*\n" sequence) - (max (point-min) (- (point) 500)) - t))) + (while (and (setq openp (memq (process-status process) + '(open run))) + (not (re-search-backward + (format "^%d .*\n" sequence) + (if nnimap-streaming + (max (point-min) (- (point) 500)) + (point-min)) + t))) (when messagep (message "Read %dKB" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) - (goto-char (point-max))))) + (goto-char (point-max))) + openp)) (defun nnimap-parse-response () (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) @@ -1129,8 +1223,7 @@ (nnimap-article-ranges articles) (format "(UID %s%s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER] BODY.PEEK" "RFC822.PEEK")) (if nnimap-split-download-body-default