+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (POP before SMTP): POP-before-SMTP works with all sending
+ methods, so don't mention smtpmail here.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus.texi (Picons): Document gnus-picon-properties.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mention of compilation, as that's no longer
+ supported.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus.texi (Archived Messages): Mention
+ gnus-gcc-pre-body-encode-hook and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Various Summary Stuff):
+ Remove mention of `gnus-propagate-marks'.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi: Remove mentions of nnml/nnfolder/nntp backend marks,
+ which no longer exist.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.texi (Archived Messages):
+ Document gnus-gcc-self-resent-messages.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.texi (Mail Variables):
+ Mention the optional user parameter for X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Posting Styles): Mention X-Message-SMTP-Method.
+
+ * message.texi (Mail Variables): Document X-Message-SMTP-Method.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Key Index): Change encoding to utf-8.
+
2012-06-21 Glenn Morris <rgm@gnu.org>
* Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737)
@syncodeindex vr cp
@syncodeindex pg cp
-@documentencoding ISO-8859-1
+@documentencoding UTF-8
@copying
Copyright @copyright{} 1995-2012 Free Software Foundation, Inc.
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
Getting Mail
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13
+* Ma Gnus:: Celebrating 25 years of Gnus.
Customization
(setq gnus-secondary-select-methods '((nnmbox "")))
@end lisp
-Note: the @acronym{NNTP} back end stores marks in marks files
-(@pxref{NNTP marks}). This feature makes it easy to share marks between
-several Gnus installations, but may slow down things a bit when fetching
-new articles. @xref{NNTP marks}, for more information.
@node The Server is Down
generated, if @code{(gcc-self . "string")} is present, this string will
be inserted literally as a @code{gcc} header. This parameter takes
precedence over any default @code{Gcc} rules as described later
-(@pxref{Archived Messages}).
+(@pxref{Archived Messages}), with the exception for messages to resend.
@strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of
@code{nntp} groups (or the like) isn't valid. An @code{nntp} server
@example
(posting-style
(name "Funky Name")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
("X-My-Header" "Funky Value")
(signature "Funky Signature"))
@end example
named @code{file-name} (a certain coding system of which an alias is
@code{file-name}) in XEmacs.
-The @code{nnml} back end, the @code{nnrss} back end, the @acronym{NNTP}
-marks feature (@pxref{NNTP marks}), the agent, and the cache use
-non-@acronym{ASCII} group names in those files and directories. This
-variable overrides the value of @code{file-name-coding-system} which
-specifies the coding system used when encoding and decoding those file
-names and directory names.
+The @code{nnml} back end, the @code{nnrss} back end, the agent, and
+the cache use non-@acronym{ASCII} group names in those files and
+directories. This variable overrides the value of
+@code{file-name-coding-system} which specifies the coding system used
+when encoding and decoding those file names and directory names.
In XEmacs (with the @code{mule} feature), @code{file-name-coding-system}
is the only means to specify the coding system used to encode and decode
@acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}).
This is mostly useful if you're on a terminal that has a limited font
and doesn't show accented characters, ``advanced'' punctuation, and the
-like. For instance, @samp{»} is translated into @samp{>>}, and so on.
+like. For instance, @samp{»} is translated into @samp{>>}, and so on.
@item W Y f
@kindex W Y f (Summary)
Also @pxref{Group Parameters}.
-@vindex gnus-propagate-marks
-@item gnus-propagate-marks
-If non-@code{nil}, propagate marks to the backends for possible
-storing. @xref{NNTP marks}, and friends, for a more fine-grained
-sieve.
-
@end table
@xref{Mail Variables, ,Mail Variables,message,Message manual}, for more
information.
+
@node POP before SMTP
@section POP before SMTP
@cindex pop before smtp
-@findex message-smtpmail-send-it
@findex mail-source-touch-pop
-Does your @acronym{ISP} require the @acronym{POP}-before-@acronym{SMTP}
-authentication? It is whether you need to connect to the @acronym{POP}
-mail server within a certain time before sending mails. If so, there is
-a convenient way. To do that, put the following lines in your
-@file{~/.gnus.el} file:
+Does your @acronym{ISP} use @acronym{POP}-before-@acronym{SMTP}
+authentication? This authentication method simply requires you to
+contact the @acronym{POP} server before sending email. To do that,
+put the following lines in your @file{~/.gnus.el} file:
@lisp
-(setq message-send-mail-function 'message-smtpmail-send-it)
(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
@end lisp
@noindent
-It means to let Gnus connect to the @acronym{POP} mail server in advance
-whenever you send a mail. The @code{mail-source-touch-pop} function
-does only a @acronym{POP} authentication according to the value of
-@code{mail-sources} without fetching mails, just before sending a mail.
-Note that you have to use @code{message-smtpmail-send-it} which runs
-@code{message-send-mail-hook} rather than @code{smtpmail-send-it} and
-set the value of @code{mail-sources} for a @acronym{POP} connection
-correctly. @xref{Mail Sources}.
+The @code{mail-source-touch-pop} function does @acronym{POP}
+authentication according to the value of @code{mail-sources} without
+fetching mails, just before sending a mail. @xref{Mail Sources}.
If you have two or more @acronym{POP} mail servers set in
@code{mail-sources}, you may want to specify one of them to
(mail-source-touch-pop))))
@end lisp
+
@node Mail and Post
@section Mail and Post
non-@code{nil}, the behavior is the same as @code{all}, but it may be
changed in the future.
+@item gnus-gcc-self-resent-messages
+@vindex gnus-gcc-self-resent-messages
+Like the @code{gcc-self} group parameter, applied only for unmodified
+messages that @code{gnus-summary-resend-message} (@pxref{Summary Mail
+Commands}) resends. Non-@code{nil} value of this variable takes
+precedence over any existing @code{Gcc} header.
+
+If this is @code{none}, no @code{Gcc} copy will be made. If this is
+@code{t}, messages resent will be @code{Gcc} copied to the current
+group. If this is a string, it specifies a group to which resent
+messages will be @code{Gcc} copied. If this is @code{nil}, @code{Gcc}
+will be done according to existing @code{Gcc} header(s), if any. If
+this is @code{no-gcc-self}, that is the default, resent messages will be
+@code{Gcc} copied to groups that existing @code{Gcc} header specifies,
+except for the current group.
+
+@item gnus-gcc-pre-body-encode-hook
+@vindex gnus-gcc-pre-body-encode-hook
+@itemx gnus-gcc-post-body-encode-hook
+@vindex gnus-gcc-post-body-encode-hook
+
+These hooks are run before/after encoding the message body of the Gcc
+copy of a sent message. The current buffer (when the hook is run)
+contains the message including the message header. Changes made to
+the message will only affect the Gcc copy, but not the original
+message. You can use these hooks to edit the copy (and influence
+subsequent transformations), e.g. remove MML secure tags
+(@pxref{Signing and encrypting}).
+
@end table
(signature-file "~/.work-signature")
(address "user@@bar.foo")
(body "You are fired.\n\nSincerely, your boss.")
+ ("X-Message-SMTP-Method" "smtp smtp.example.org 587")
(organization "Important Work, Inc"))
("nnml:.*"
(From (with-current-buffer gnus-article-buffer
You may also use @code{message-alternative-emails} instead.
@xref{Message Headers, ,Message Headers, message, Message Manual}.
+Of particular interest in the ``work-mail'' style is the
+@samp{X-Message-SMTP-Method} header. It specifies how to send the
+outgoing email. You may want to sent certain emails through certain
+@acronym{SMTP} servers due to company policies, for instance.
+@xref{Mail Variables, ,Message Variables, message, Message Manual}.
+
+
@node Drafts
@section Drafts
@cindex drafts
* Direct Functions:: Connecting directly to the server.
* Indirect Functions:: Connecting indirectly to the server.
* Common Variables:: Understood by several connection functions.
-* NNTP marks:: Storing marks for @acronym{NNTP} servers.
@end menu
@end table
-@node NNTP marks
-@subsubsection NNTP marks
-@cindex storing NNTP marks
-
-Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP}
-servers in marks files. A marks file records what marks you have set
-in a group and each file is specific to the corresponding server.
-Marks files are stored in @file{~/News/marks}
-(@code{nntp-marks-directory}) under a classic hierarchy resembling
-that of a news server, for example marks for the group
-@samp{gmane.discuss} on the news.gmane.org server will be stored in
-the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}.
-
-Marks files are useful because you can copy the @file{~/News/marks}
-directory (using rsync, scp or whatever) to another Gnus installation,
-and it will realize what articles you have read and marked. The data
-in @file{~/News/marks} has priority over the same data in
-@file{~/.newsrc.eld}.
-
-Note that marks files are very much server-specific: Gnus remembers
-the article numbers so if you don't use the same servers on both
-installations things are most likely to break (most @acronym{NNTP}
-servers do not use the same article numbers as any other server).
-However, if you use servers A, B, C on one installation and servers A,
-D, E on the other, you can sync the marks files for A and then you'll
-get synchronization for that server between the two installations.
-
-Using @acronym{NNTP} marks can possibly incur a performance penalty so
-if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil}
-variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}.
-
-Related variables:
-
-@table @code
-
-@item nntp-marks-is-evil
-@vindex nntp-marks-is-evil
-If non-@code{nil}, this back end will ignore any marks files. The
-default is @code{nil}.
-
-@item nntp-marks-directory
-@vindex nntp-marks-directory
-The directory where marks for nntp groups will be stored.
-
-@end table
-
-
@node News Spool
@subsection News Spool
@cindex nnspool
@acronym{NOV} databases for the incoming mails. This makes it possibly the
fastest back end when it comes to reading mail.
-@cindex self contained nnml servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnml}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnml} server) and have all your marks be preserved. Marks
-for a group are usually stored in the @code{.marks} file (but see
-@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
-Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
-to restore the group (after restoring the backup into the nnml
-directory).
-
-If for some reason you believe your @file{.marks} files are screwed
-up, you can just delete them all. Gnus will then correctly regenerate
-them next time it starts.
-
Virtual server settings:
@table @code
@vindex nnml-prepare-save-mail-hook
Hook run narrowed to an article before saving.
-@item nnml-marks-is-evil
-@vindex nnml-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnml-marks-file-name
-@vindex nnml-marks-file-name
-The name of the @dfn{marks} files. The default is @file{.marks}.
-
@item nnml-use-compressed-files
@vindex nnml-use-compressed-files
If non-@code{nil}, @code{nnml} will allow using compressed message
@code{nnfolder} will add extra headers to keep track of article
numbers and arrival dates.
-@cindex self contained nnfolder servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnfolder}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnfolder} server) and have all your marks be preserved.
-Marks for a group are usually stored in a file named as the mbox file
-with @code{.mrk} concatenated to it (but see
-@code{nnfolder-marks-file-suffix}) within the @code{nnfolder}
-directory. Individual @code{nnfolder} groups are also possible to
-backup, use @kbd{G m} to restore the group (after restoring the backup
-into the @code{nnfolder} directory).
-
Virtual server settings:
@table @code
The directory where the @acronym{NOV} files should be stored. If
@code{nil}, @code{nnfolder-directory} is used.
-@item nnfolder-marks-is-evil
-@vindex nnfolder-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnfolder-marks-file-suffix
-@vindex nnfolder-marks-file-suffix
-The extension for @sc{marks} files. The default is @file{.mrk}.
-
-@item nnfolder-marks-directory
-@vindex nnfolder-marks-directory
-The directory where the @sc{marks} files should be stored. If
-@code{nil}, @code{nnfolder-directory} is used.
-
@end table
@code{nnmaildir} stores article marks for a given group in the
corresponding maildir, in a way designed so that it's easy to manipulate
them from outside Gnus. You can tar up a maildir, unpack it somewhere
-else, and still have your marks. @code{nnml} also stores marks, but
-it's not as easy to work with them from outside Gnus as with
-@code{nnmaildir}.
+else, and still have your marks.
@code{nnmaildir} uses a significant amount of memory to speed things up.
(It keeps in memory some of the things that @code{nnml} stores in files
might interfere with overwriting data, so you may want to shut down Gnus
before you restore the data.
-It is also possible to archive individual @code{nnml},
-@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks.
-For @code{nnml} or @code{nnmaildir}, you copy all files in the group's
-directory. For @code{nnfolder} you need to copy both the base folder
-file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in
-this example). Restoring the group is done with @kbd{G m} from the Group
-buffer. The last step makes Gnus notice the new directory.
-@code{nnmaildir} notices the new directory automatically, so @kbd{G m}
-is unnecessary in that case.
-
@node Web Searches
@subsection Web Searches
@cindex nnweb
@item !
@itemx not
-@itemx ¬
+@itemx ¬
This logical operator only takes a single argument. It returns the
logical negation of the value of its argument.
* Formatting Variables:: You can specify what buffers should look like.
* Window Layout:: Configuring the Gnus buffer windows.
* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
* Mode Lines:: Displaying information in the mode lines.
* Highlighting and Menus:: Making buffers look all nice and cozy.
* Daemons:: Gnus can do things behind your back.
Ignoring is done first; then cutting; then maxing; and then as the very
last operation, padding.
-If you use lots of these advanced thingies, you'll find that Gnus gets
-quite slow. This can be helped enormously by running @kbd{M-x
-gnus-compile} when you are satisfied with the look of your lines.
-@xref{Compilation}.
-
@node User-Defined Specs
@subsection User-Defined Specs
@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
@cindex %<<, %>>, guillemets
-@c @cindex %<<, %>>, %«, %», guillemets
+@c @cindex %<<, %>>, %«, %», guillemets
@vindex gnus-balloon-face-0
Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
special @code{balloon-help} property set to
interface.
-@node Compilation
-@section Compilation
-@cindex compilation
-@cindex byte-compilation
-
-@findex gnus-compile
-
-Remember all those line format specification variables?
-@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so
-on. Now, Gnus will of course heed whatever these variables are, but,
-unfortunately, changing them will mean a quite significant slow-down.
-(The default values of these variables have byte-compiled functions
-associated with them, while the user-generated versions do not, of
-course.)
-
-To help with this, you can run @kbd{M-x gnus-compile} after you've
-fiddled around with the variables and feel that you're (kind of)
-satisfied. This will result in the new specs being byte-compiled, and
-you'll get top speed again. Gnus will save these compiled specs in the
-@file{.newsrc.eld} file. (User-defined functions aren't compiled by
-this function, though---you should compile them yourself by sticking
-them into the @file{~/.gnus.el} file and byte-compiling that file.)
-
-
@node Mode Lines
@section Mode Lines
@cindex mode lines
If @code{inline}, the textual representation is replaced. If
@code{right}, picons are added right to the textual representation.
+@vindex gnus-picon-properties
+The value of the variable @code{gnus-picon-properties} is a list of
+properties applied to picons.
+
The following variables offer control over where things are located.
@table @code
@cindex Pterodactyl Gnus
@cindex Oort Gnus
@cindex No Gnus
+@cindex Ma Gnus
@cindex Gnus versions
The first ``proper'' release of Gnus 5 was done in November 1995 when it
http://git.gnus.org for details (http://www.gnus.org will be updated
with the information when possible).
+On the January 31th 2012, Ma Gnus was begun.
+
If you happen upon a version of Gnus that has a prefixed name --
``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
-``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic.
-Don't let it know that you're frightened. Back away. Slowly. Whatever
-you do, don't run. Walk away, calmly, until you're out of its reach.
-Find a proper released version of Gnus and snuggle up to that instead.
+``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus'' -- don't
+panic. Don't let it know that you're frightened. Back away. Slowly.
+Whatever you do, don't run. Walk away, calmly, until you're out of
+its reach. Find a proper released version of Gnus and snuggle up to
+that instead.
@node Why?
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-* No Gnus:: Very punny.
+* No Gnus:: Very punny. Gnus 5.12/5.13.
+* Ma Gnus:: Celebrating 25 years of Gnus.
@end menu
These lists are, of course, just @emph{short} overviews of the
@include gnus-news.texi
+@node Ma Gnus
+@subsubsection Ma Gnus
+@cindex Ma Gnus
+
+I'm sure there will be lots of text here. It's really spelled 真
+Gnus.
+
+New features in Ma Gnus:
+
+@itemize @bullet
+
+@item Changes in Message mode and related Gnus features
+@c ****************************************************
+
+@itemize @bullet
+
+@item
+The new hooks @code{gnus-gcc-pre-body-encode-hook} and
+@code{gnus-gcc-post-body-encode-hook} are run before/after encoding
+the message body of the Gcc copy of a sent message. See
+@xref{Archived Messages}.
+
+@end itemize
+
+@end itemize
+
@iftex
@page
@c Local Variables:
@c mode: texinfo
-@c coding: iso-8859-1
+@c coding: utf-8
@c End:
requires the @acronym{POP}-before-@acronym{SMTP} authentication.
@xref{POP before SMTP, , POP before SMTP, gnus, The Gnus Manual}.
+@cindex X-Message-SMTP-Method
+If you have a complex @acronym{SMTP} setup, and want some messages to
+go via one mail server, and other messages to go through another, you
+can use the @samp{X-Message-SMTP-Method} header. These are the
+supported values:
+
+@table @samp
+@item smtpmail
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587
+@end example
+
+This will send the message via @samp{smtp.fsf.org}, using port 587.
+
+@example
+X-Message-SMTP-Method: smtp smtp.fsf.org 587 other-user
+@end example
+
+This is the same as the above, but uses @samp{other-user} as the user
+name when authenticating. This is handy if you have several
+@acronym{SMTP} accounts on the same server.
+
+@item sendmail
+
+@example
+X-Message-SMTP-Method: sendmail
+@end example
+
+This will send the message via the locally installed sendmail/exim/etc
+installation.
+
+@end table
+
@item message-mh-deletable-headers
@vindex message-mh-deletable-headers
Most versions of MH doesn't like being fed messages that contain the
For older news, see Gnus info node "New Features".
\f
-* Installation changes
+* New features
-** Upgrading from previous (stable) version if you have used No Gnus.
+** If you have the "tnef" program installed, Gnus will display ms-tnef
+ files, aka "winmail.dat".
-If you have tried No Gnus (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version. In particular, you will probably want to remove the
-`~/News/marks' directory (perhaps selectively), so that flags are read
-from your `~/.newsrc.eld' instead of from the stale marks file, where
-this release will store flags for nntp. See a later entry for more
-information about nntp marks. Note that downgrading isn't safe in
-general.
+** Archives (like tar and zip files) will be automatically unpacked,
+ and the files inside the packages will be displayed as MIME parts.
-** Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23,
-Gnus uses Emacs' new internal coding system `utf-8-emacs' for saving
-articles drafts and `~/.newsrc.eld'. These files may not be read
-correctly in Emacs 22 and below. If you want to use Gnus across
-different Emacs versions, you may set `mm-auto-save-coding-system' to
-`emacs-mule'.
+** shr has a new command `z' that cycles through image sizes.
-** Lisp files are now installed in `.../site-lisp/gnus/' by default. It
-defaulted to `.../site-lisp/' formerly. In addition to this, the new
-installer issues a warning if other Gnus installations which will shadow
-the latest one are detected. You can then remove those shadows manually
-or remove them using `make remove-installed-shadows'.
+** `backtab' in the summary buffer now selects the previous link in
+ the article buffer.
-** The installation directory name is allowed to have spaces and/or tabs.
+** Using the "X-Message-SMTP-Method" header in Message buffers now
+ allows specifying how messages are to be sent. For example:
-\f
-* New packages and libraries within Gnus
-
-** Gnus includes the Emacs Lisp SASL library.
-
-This provides a clean API to SASL mechanisms from within Emacs. The
-user visible aspects of this, compared to the earlier situation, include
-support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top.
-
-** ManageSieve connections uses the SASL library by default.
-
-The primary change this brings is support for DIGEST-MD5 and NTLM, when
-the server supports it.
-
-** Gnus includes a password cache mechanism in password-cache.el.
-
-It is enabled by default (see `password-cache'), with a short timeout of
-16 seconds (see `password-cache-expiry'). If PGG is used as the PGP
-back end, the PGP passphrase is managed by this mechanism. Passwords
-for ManageSieve connections are managed by this mechanism, after
-querying the user about whether to do so.
-
-** Using EasyPG with Gnus When EasyPG, is available, Gnus will use it
-instead of PGG. EasyPG is an Emacs user interface to GNU Privacy Guard.
- *Note EasyPG Assistant user's manual: (epa)Top. EasyPG is included in
-Emacs 23 and available separately as well.
-
-\f
-* Changes in group mode
-
-** Old intermediate incoming mail files (`Incoming*') are deleted after a
-couple of days, not immediately. *Note Mail Source Customization::.
-(New in Gnus 5.10.10 / Emacs 22.2)
-
-
-\f
-* Changes in summary and article mode
-
-** Gnus now supports sticky article buffers. Those are article buffers
-that are not reused when you select another article. *Note Sticky
-Articles::.
-
-** Gnus can selectively display `text/html' articles with a WWW browser
-with `K H'. *Note MIME Commands::.
-
-** International host names (IDNA) can now be decoded inside article bodies
-using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn
-(`http://www.gnu.org/software/libidn/') has been installed.
-
-** The non-ASCII group names handling has been much improved. The back
-ends that fully support non-ASCII group names are now `nntp', `nnml',
-and `nnrss'. Also the agent, the cache, and the marks features work
-with those back ends. *Note Non-ASCII Group Names::.
+ X-Message-SMTP-Method: smtp smtp.fsf.org 587
-** Gnus now displays DNS master files sent as text/dns using dns-mode.
+** Gnus keeps track of non-existent articles for nnimap groups, so
+ that sparse IMAP folders now list a correct number of messages in
+ them.
-** Gnus supports new limiting commands in the Summary buffer: `/ r'
-(`gnus-summary-limit-to-replied') and `/ R'
-(`gnus-summary-limit-to-recipient'). *Note Limiting::.
-
-** You can now fetch all ticked articles from the server using `Y t'
-(`gnus-summary-insert-ticked-articles'). *Note Summary Generation
-Commands::.
-
-** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t'
-(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::.
-
-** S/MIME now features LDAP user certificate searches. You need to
-configure the server in `smime-ldap-host-list'.
-
-** URLs inside OpenPGP headers are retrieved and imported to your PGP key
-ring when you click on them.
-
-** Picons can be displayed right from the textual address, see
-`gnus-picon-style'. *Note Picons::.
-
-** ANSI SGR control sequences can be transformed using `W A'.
-
-ANSI sequences are used in some Chinese hierarchies for highlighting
-articles (`gnus-article-treat-ansi-sequences').
-
-** Gnus now MIME decodes articles even when they lack "MIME-Version" header.
-This changes the default of `gnus-article-loose-mime'.
-
-** `gnus-decay-scores' can be a regexp matching score files. For example,
-set it to `\\.ADAPT\\'' and only adaptive score files will be decayed.
- *Note Score Decays::.
-
-** Strings prefixing to the `To' and `Newsgroup' headers in summary lines
-when using `gnus-ignored-from-addresses' can be customized with
-`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To
-From Newsgroups::.
-
-** You can replace MIME parts with external bodies. See
-`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME
-Commands::, *note Using MIME::.
-
-** The option `mm-fill-flowed' can be used to disable treatment of
-format=flowed messages. Also, flowed text is disabled when sending
-inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text.
-(New in Gnus 5.10.7)
-
-** Now the new command `S W' (`gnus-article-wide-reply-with-original') for
-a wide reply in the article buffer yanks a text that is in the active
-region, if it is set, as well as the `R'
-(`gnus-article-reply-with-original') command. Note that the `R' command
-in the article buffer no longer accepts a prefix argument, which was
-used to make it do a wide reply. *Note Article Keymap::.
-
-** The new command `C-h b' (`gnus-article-describe-bindings') used in the
-article buffer now shows not only the article commands but also the real
-summary commands that are accessible from the article buffer.
-
-
-\f
-* Changes in Message mode
+** Gnus will guess the real type of MIME parts of type
+ application/octet-stream based on the file suffix. So an
+ application/octet-stream with a name of "rms.jpg" will be displayed
+ as an image/jpeg type by default, for instance.
-** Gnus now supports the "hashcash" client puzzle anti-spam mechanism. Use
-`(setq message-generate-hashcash t)' to enable. *Note Hashcash::.
-
-** You can now drag and drop attachments to the Message buffer. See
-`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
-(message)MIME.
-
-** The option `message-yank-empty-prefix' now controls how empty lines are
-prefixed in cited text. *Note Insertion Variables: (message)Insertion
-Variables.
-
-** Gnus uses narrowing to hide headers in Message buffers. The
-`References' header is hidden by default. To make all headers visible,
-use `(setq message-hidden-headers nil)'. *Note Message Headers:
-(message)Message Headers.
-
-** You can highlight different levels of citations like in the article
-buffer. See `gnus-message-highlight-citation'.
-
-** `auto-fill-mode' is enabled by default in Message mode. See
-`message-fill-column'. *Note Message Headers: (message)Various Message
-Variables.
-
-** You can now store signature files in a special directory named
-`message-signature-directory'.
-
-** The option `message-citation-line-format' controls the format of the
-"Whomever writes:" line. You need to set
-`message-citation-line-function' to
-`message-insert-formatted-citation-line' as well.
-
-\f
-* Changes in back ends
-
-** The nntp back end stores article marks in `~/News/marks'.
-
-The directory can be changed using the (customizable) variable
-`nntp-marks-directory', and marks can be disabled using the (back end)
-variable `nntp-marks-is-evil'. The advantage of this is that you can
-copy `~/News/marks' (using rsync, scp or whatever) to another Gnus
-installation, and it will realize what articles you have read and
-marked. The data in `~/News/marks' has priority over the same data in
-`~/.newsrc.eld'.
-
-** You can import and export your RSS subscriptions from OPML files. *Note
-RSS::.
-
-** IMAP identity (RFC 2971) is supported.
-
-By default, Gnus does not send any information about itself, but you can
-customize it using the variable `nnimap-id'.
-
-** The `nnrss' back end now supports multilingual text. Non-ASCII group
-names for the `nnrss' groups are also supported. *Note RSS::.
-
-** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS.
-
-** The nnml back end allows other compression programs beside `gzip' for
-compressed message files. *Note Mail Spool::.
-
-** The nnml back end supports group compaction.
-
-This feature, accessible via the functions `gnus-group-compact-group'
-(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the
-server buffer) renumbers all articles in a group, starting from 1 and
-removing gaps. As a consequence, you get a correct total article count
-(until messages are deleted again).
-
-
-\f
-* Appearance
-
-** The tool bar has been updated to use GNOME icons. You can also
-customize the tool bars: `M-x customize-apropos RET -tool-bar$' should
-get you started. (Only for Emacs, not in XEmacs.)
-
-** The tool bar icons are now (de)activated correctly in the group buffer,
-see the variable `gnus-group-update-tool-bar'. Its default value
-depends on your Emacs version.
-
-** You can change the location of XEmacs' toolbars in Gnus buffers. See
-`gnus-use-toolbar' and `message-use-toolbar'.
-
-
-\f
-* Miscellaneous changes
-
-** Having edited the select-method for the foreign server in the server
-buffer is immediately reflected to the subscription of the groups which
-use the server in question. For instance, if you change
-`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus
-will connect to the news host by way of the intermediate host
-`bar.example.com' from next time.
-
-** The `all.SCORE' file can be edited from the group buffer using `W e'.
-
-** You can set `gnus-mark-copied-or-moved-articles-as-expirable' to a
-non-`nil' value so that articles that have been read may be marked as
-expirable automatically when copying or moving them to a group that has
-auto-expire turned on. The default is `nil' and copying and moving of
-articles behave as before; i.e., the expirable marks will be unchanged
-except that the marks will be removed when copying or moving articles to
-a group that has not turned auto-expire on. *Note Expiring Mail::.
-
-
-\f
+** `nnimap-inbox' can now be a list of mail box names.
+
* For older news, see Gnus info node "New Features".
----------------------------------------------------------------------
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el: Add coding cookie for a soft hyphen that mm-shr uses.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-read-summary-keys): Protect against the key
+ being bound to a lambda form.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-picon.el (gnus-picon-properties): New defcustom.
+ (gnus-picon-create-glyph): Use it.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el: Add a iso-8859-1 cookie to make stuff work under other
+ locales.
+
+ * mm-decode.el (mm-display-part): Dissect archives when hitting `RET'
+ on a handle.
+
+ * gnus-sum.el (gnus-summary-limit-to-author): Use the current From
+ address as the default.
+
+ * nnfolder.el (nnfolder-save-buffer): Delete old versions silently.
+ It makes no sense to query the user about internal files.
+
+ * gnus-spec.el: Remove all the byte-compilation stuff, since
+ benchmarking shows that it doesn't help when entering large summary
+ buffers.
+
+ * gnus-util.el (gnus-byte-code): Remove.
+
+ * gnus-spec.el (gnus-update-format-specifications): Remove outdated
+ grouplens stuff.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running
+ (bug#11514).
+
+2012-06-26 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk>
+
+ * message.el (message-buffers): Return all buffers derived from Message
+ to make `gnus-dired-attach' work with mu4e.
+
+2012-06-26 Daiki Ueno <ueno@unixuser.org>
+
+ * mm-decode.el (mm-inhibit-auto-detect-attachment): New variable.
+ (mm-dissect-singlepart): Don't guess the MIME type of
+ application/octet-stream parts if mm-inhibit-auto-detect-attachment is
+ set.
+ (mm-dissect-multipart): Bind mm-inhibit-auto-detect-attachment if the
+ toplevel MIME type is multipart/encrypted.
+
+2012-06-26 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * gnus-agent.el (gnus-agent-save-active): Deal with the "groups" format.
+ In particular, add an optional argument and a docstring.
+
+ * gnus-start.el (gnus-groups-to-gnus-format): Use it.
+
+ * nntp.el (nntp-finish-retrieve-group-infos): Make `nntp-server-buffer'
+ current before calling `gnus-groups-to-gnus-format'.
+ Note that this was already the case for `gnus-active-to-gnus-format'.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * pop3.el (pop3-wait-for-messages): Fix retrieved data size calculation.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-buffer): Doc fix.
+
+ * gnus-sum.el (gnus-handle-ephemeral-exit):
+ Avoid creating the group buffer if it doesn't exist.
+
+ * gnus-group.el (gnus-group-read-ephemeral-group): If no quit-config
+ is given, mark the group as ephemeral with the current window conf.
+
+ * gnus-sum.el (gnus-set-global-variables): Don't assume that the group
+ buffer exists, which it doesn't if we haven't started Gnus.
+ (gnus-summary-exit): Allow quitting when we don't have a group buffer.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime):
+ Allow specifying what the top-level part type is.
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ `scroll-margin' isn't defined on XEmacs.
+
+2012-06-26 Philipp Haselwarter <philipp.haselwarter@gmx.de> (tiny change)
+
+ * gnus-sum.el (gnus-auto-center-summary):
+ Set default to respect `scroll-margin'.
+
+2012-06-26 Elias Oltmanns <eo@nebensachen.de> (tiny change)
+
+ * gnus-cite.el (gnus-dissect-cited-text): A single line without
+ citation prefix within a block of cited text should be considered
+ part of that block *only* if it is a blank line.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * shr.el (shr-find-fill-point): Remove unused code; don't break a line
+ before kinsoku-bol characters nor within kinsoku-eol characters.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sync.el (gnus-topic-alist, gnus-group-topic)
+ (gnus-topic-create-topic, gnus-topic-enter-dribble):
+ Silence compiler.
+ (gnus-sync-read): Use mapc instead of mapcar.
+
+ * mm-archive.el: Require mm-decode for some macros.
+ (gnus-recursive-directory-files, mailcap-extension-to-mime):
+ Silence the byte compiler.
+ (mm-archive-decoders): New function that returns the value of
+ the mm-archive-decoders variable.
+
+ * mm-decode.el:
+ Don't require mm-archive; autoload mm-archive functions instead.
+ (mm-dissect-singlepart): Use the function mm-archive-decoders.
+
+ * nnmail.el (mail-send-and-exit): Silence the byte compiler.
+
+2012-06-26 Peter Munster <pmrb@free.fr>
+
+ * gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer).
+ (gnus-demon-cancel): Ditto.
+ (gnus-demon-run-callback): When function cannot be called due to low
+ idleness, call it when idleness reaches the expected value, instead
+ of waiting another timer period.
+ (gnus-demon-init): Add `time' to arguments of call-back.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el: Register gnus-registry functions.
+
+ * gnus-registry.el (gnus-try-warping-via-registry):
+ Moved here and indent.
+
+ * gnus-int.el (gnus-warp-to-article):
+ Check whether the registry is enabled before warping.
+
+2012-06-26 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-sum.el (gnus-summary-insert-subject): Record information
+ in the registry about each article retrieved.
+
+ * gnus-int.el (gnus-select-group-with-message-id): New function.
+ (gnus-try-warping-via-registry): Ditto.
+ (gnus-warp-to-article): Fall back on the registry.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-fetch-partial-articles): Minor doc string fixup.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message-insert-gcc): Assume that
+ gnus-gcc-self-resent-messages may be a group parameter.
+ (gnus-summary-resend-message):
+ Don't encode encoded words in header when Gcc'ing resent message.
+
+2012-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-insert): Treat non-breaking space just like normal
+ space. This seems to produce more pleasing results.
+ (shr-insert):
+ Only insert a blank line if we're starting from an image.
+ (shr-tag-br):
+ Allow <br> to end lines or to make a single blank line.
+ (shr-ensure-paragraph): Consider lines with white space to be blank.
+
+2012-06-26 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Add gnus-gcc-pre-body-encode-hook
+ and gnus-gcc-post-body-encode-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Guess what the type of application/octet-stream parts really is.
+
+ * gnus-sum.el (gnus-propagate-marks): Remove.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-coding-system-for-read): Remove.
+ (nntp-coding-system-for-write): Ditto.
+ (nntp-open-connection): Just use `binary' directly.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * registry.el (registry-usage-test, registry-persistence-test):
+ Move to tests/gnustest-registry.el.
+ (registry-make-testable-db, registry-match-test)
+ (registry-instantiation-test): Move to tests/gnustest-registry.el.
+
+ * gnus-registry.el (gnus-registry-misc-test)
+ (gnus-registry-usage-test): Move to tests/gnustest-registry.el.
+
+ * tests/gnustest-registry.el:
+ New file with the registry and gnus-registry ERT tests.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-summary-resend-message):
+ Make gnus-summary-resend-message-insert-gcc be last item in
+ message-header-setup-hook.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
+ (nnfolder-marks, nnfolder-marks-file-suffix)
+ (nnfolder-marks-modtime): Remove.
+ (nnfolder-open-server): Don't use marks.
+ (nnfolder-request-delete-group): Ditto.
+ (nnfolder-request-rename-group): Ditto.
+ (nnfolder-request-set-mark, nnfolder-request-marks)
+ (nnfolder-group-marks-pathname, nnfolder-marks-changed-p)
+ (nnfolder-save-marks, nnfolder-open-marks): Remove.
+
+ * nnml.el (nnml-marks-is-evil, nnml-marks-file-name, nnml-marks)
+ (nnml-marks-modtime): Remove.
+ (nnml-request-delete-group): Don't use marks.
+ (nnml-request-rename-group): Ditto.
+ (nnml-request-set-mark, nnml-request-marks, nnml-marks-changed-p)
+ (nnml-save-marks, nnml-open-marks): Remove.
+
+ * nntp.el (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks)
+ (nntp-marks-modtime, nntp-marks-directory, nntp-request-set-mark)
+ (nntp-request-marks, nntp-marks-directory, nntp-marks-changed-p)
+ (nntp-save-marks, nntp-open-marks, nntp-possibly-create-directory)
+ (nntp-server-to-method-cache): Remove.
+
+ * shr.el (shr-rescale-image): Fix wrong merge.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * shr.el (shr-remove-trailing-whitespace):
+ Really delete the padding on too-wide lines.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-archive.el (mm-archive-dissect-and-inline): New function.
+ (mm-archive-dissect-and-inline): Fix up the undisplayer.
+
+ * mm-decode.el (mm-display-external): Output the text from
+ the command in the buffer after the command finished.
+ This makes text-based commands behave better.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (smtpmail-smtp-user): Silence compiler warning.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): Also allow specifying
+ the SMTP user name.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-article-map): Fix typo.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-multi-smtp-send-mail): New function.
+ (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method
+ header to implement multi-SMTP functionality.
+
+ * gnus-agent.el (gnus-agent-send-mail-function): Removed.
+ (gnus-agentize): Don't set it.
+ (gnus-agent-send-mail): Don't use it.
+
+ * gnus-sum.el (gnus-summary-widget-backward):
+ New function and keystroke.
+
+ * shr.el (shr-put-image): Remove underlines from sliced images.
+ (shr-zoom-image): Compute the region to be replaced more correctly.
+
+2012-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-gcc-self-resent-messages): New user option.
+ (gnus-summary-resend-message-insert-gcc): New function.
+ (gnus-summary-resend-message): Modify message-header-setup-hook and
+ message-sent-hook to make it work for Gcc.
+ (gnus-inews-do-gcc): Update the number of unread articles of groups
+ that messages are Gcc'd to.
+
+ * message.el (message-resend): Run message-sent-hook to do Gcc.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-registry.el (gnus-registry-fixup-registry):
+ Move the message to a higher level to silence compilation.
+
+ * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
+ parameter to allow controlling the scaling.
+
+ * shr.el (shr-zoom-image): New command and keystroke.
+ (shr-put-image): Take a `size' flag to say how to scale the image.
+
+ * mm-archive.el (mm-dissect-archive): Use it to get all file names.
+ Use recursive deletion.
+ (mm-dissect-archive): Add support for zip files.
+
+ * gnus-util.el (gnus-recursive-directory-files): New function.
+
+ * mm-archive.el (mm-archive-list-files): Inline text and image parts.
+ (mm-archive-decoders): Add tgz support.
+
+ * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline.
+ Otherwise inserting text into the Gnus buffer can look odd.
+
+ * gnus-art.el (gnus-mime-inline-part): Slight clean-up.
+
+ * mm-archive.el (mm-archive-decoders): Add support for tar.
+
+ * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus.
+
+ * nnmail.el (nnmail-extra-headers): Add Cc to the default.
+
+2012-06-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists.
+
+ * mm-archive.el: New file.
+
+ * mm-decode.el (mm-dissect-singlepart):
+ Use it to decode ms-tnef files.
+
+ * mm-util.el (mm-find-buffer-file-coding-system): Comment fix.
+
+ * message.el (message-goto-*): Make all the `message-goto-*' commands
+ push the mark before moving point. This makes it easier to go back
+ to where you came from after editing whatever you jumped to.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-newsrc-groups): Quote normally.
+ (gnus-sync-lesync-pre-save-group-entry): Remove invalid invlists.
+ (gnus-sync-lesync-normalize-group-entry): Ignore a few more keys.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * spam.el: Move BBDB autoloads.
+ (spam-exists-in-BBDB-p):
+ New function to do the BBDB search directly in BBDB 2 and 3.
+ (spam-check-BBDB): Use it.
+ (spam-enter-ham-BBDB): Use it.
+
+2012-06-26 Peter Munster <pmrb@free.fr> (tiny change)
+
+ * gnus-group.el (gnus-group-get-new-news):
+ New parameter `one-level' for scanning exactly one level.
+
+ * gnus-start.el (gnus-get-unread-articles): Ditto.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about setup.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: More commentary about `gnus-sync-read' issues.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Improve docs about CouchDB admins.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el (gnus-sync-lesync-setup): Fix salt when user setup is
+ not needed. Provide xmlplistread list function to produce XML plist
+ output for non-Gnus LeSync clients.
+
+2012-06-26 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-sync.el: Add LeSync synchronization backend and logic to read
+ and save against it. Group subscriptions, read marks, other marks,
+ subscription levels, topic names, and topic offsets (the group's
+ position within the topic) are saved. This is an experimental
+ backend and may change significantly. Load json.el from
+ the gnus-fallback-lib if it's not available otherwise.
+ (gnus-sync-save): Don't use `apply-partially' because of XEmacs.
+
+2012-06-26 David Engster <dengste@eml.cc>
+
+ * tests/gnustest-nntp.el: New file for simple NNTP testing.
+
2012-06-18 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change)
* gnus-win.el (gnus-configure-frame): Pass an arg to window-dedicated-p.
(defvar gnus-category-group-cache nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil)
minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
- (unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function
- (or message-send-mail-real-function
- (function (lambda () (funcall message-send-mail-function))))
- message-send-mail-real-function 'gnus-agent-send-mail))
+ (setq message-send-mail-real-function 'gnus-agent-send-mail)
;; If the servers file doesn't exist, auto-agentize some servers and
;; save the servers file so this auto-agentizing isn't invoked
(defun gnus-agent-send-mail ()
(if (or (not gnus-agent-queue-mail)
(and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
- (funcall gnus-agent-send-mail-function)
+ (message-multi-smtp-send-mail)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
(gnus-group-update-group group t)))
nil))
-(defun gnus-agent-save-active (method)
+(defun gnus-agent-save-active (method &optional groups-p)
+ "Sync the agent's active file with the current buffer.
+Pass non-nil for GROUPS-P if the buffer starts out in groups format.
+Regardless, both the file and the buffer end up in active format
+if METHOD is agentized; otherwise the function is a no-op."
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(new (gnus-make-hashtable (count-lines (point-min) (point-max))))
(file (gnus-agent-lib-file "active")))
- (gnus-active-to-gnus-format nil new)
+ (if groups-p
+ (gnus-groups-to-gnus-format nil new)
+ (gnus-active-to-gnus-format nil new))
(gnus-agent-write-active file new)
(erase-buffer)
(let ((nnheader-file-coding-system gnus-agent-file-coding-system))
(unfoldable
(or (equal gnus-article-unfold-long-headers t)
(and (stringp gnus-article-unfold-long-headers)
- (string-match gnus-article-unfold-long-headers header)))))
+ (string-match gnus-article-unfold-long-headers
+ header)))))
(with-temp-buffer
(insert header)
(goto-char (point-min))
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
(mm-read-coding-system "Charset: "))))
- (t
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))))
+ ((mm-handle-undisplayer handle)
+ (mm-remove-part handle)))
(forward-line 2)
(mm-display-inline handle)
(goto-char b)))))
(not gnus-inhibit-hiding))
(gnus-article-hide-headers)))
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Enable image to be deleted."
(let ((image (shr-put-image data (propertize (or alt "*")
- 'gnus-image-category 'shr))))
+ 'gnus-image-category 'shr)
+ flags)))
(when image
(gnus-add-image 'shr image))))
(ding)
(unless (member keys nosave-in-article)
(set-buffer gnus-article-current-summary))
- (when (get func 'disabled)
+ (when (and (symbolp func)
+ (get func 'disabled))
(error "Function %s disabled" func))
(call-interactively func)
(setq new-sum-point (point)))
(if (and (equal (cdadr m) "")
(equal (cdar m) (cdaddr m))
(goto-char (caadr m))
+ (looking-at "[ \t]*$")
(forward-line 1)
(= (point) (caaddr m)))
(setcdr m (cdddr m))
;;; Internal variables.
(defvar gnus-demon-timers nil
- "List of idle timers which are running.")
+ "Plist of idle timers which are running.")
(defvar gnus-inhibit-demon nil
"If non-nil, no daemonic function will be run.")
(float-time (or (current-idle-time)
'(0 0 0)))))
-(defun gnus-demon-run-callback (func &optional idle)
- "Run FUNC if Emacs has been idle for longer than IDLE seconds."
+(defun gnus-demon-run-callback (func &optional idle time special)
+ "Run FUNC if Emacs has been idle for longer than IDLE seconds.
+If not, and a TIME is given, restart a new idle timer, so FUNC
+can be called at the next opportunity. Such a special idle run is
+marked with SPECIAL."
(unless gnus-inhibit-demon
- (when (or (not idle)
- (and (eq idle t) (> (gnus-demon-idle-since) 0))
- (<= idle (gnus-demon-idle-since)))
+ (block run-callback
+ (when (eq idle t)
+ (setq idle 0.001))
+ (cond (special
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))))
+ ((and idle (> idle (gnus-demon-idle-since)))
+ (when time
+ (nnheader-cancel-timer (plist-get gnus-demon-timers func))
+ (setq gnus-demon-timers
+ (plist-put gnus-demon-timers func
+ (run-with-idle-timer idle nil
+ 'gnus-demon-run-callback
+ func idle time t))))
+ (return-from run-callback)))
(with-local-quit
- (ignore-errors
- (funcall func))))))
+ (ignore-errors
+ (funcall func))))))
(defun gnus-demon-init ()
"Initialize the Gnus daemon."
;; (func number any)
;; Call every `time'
((integerp time)
- (run-with-timer time time 'gnus-demon-run-callback func idle))
+ (run-with-timer time time 'gnus-demon-run-callback
+ func idle time))
;; (func string any)
((stringp time)
- (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback func idle)))))
+ (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback
+ func idle)))))
(when timer
- (add-to-list 'gnus-demon-timers timer)))))
+ (setq gnus-demon-timers (plist-put gnus-demon-timers func timer))))))
(defun gnus-demon-time-to-step (time)
"Find out how many steps to TIME, which is on the form \"17:43\"."
(defun gnus-demon-cancel ()
"Cancel any Gnus daemons."
(interactive)
- (dolist (timer gnus-demon-timers)
- (nnheader-cancel-timer timer))
+ (dotimes (i (/ (length gnus-demon-timers) 2))
+ (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers)))
(setq gnus-demon-timers nil))
(defun gnus-demon-add-disconnection ()
(autoload 'gnus-group-make-nnir-group "nnir")
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
"*Message displayed by Gnus when no groups are available."
:group 'gnus-start
:type 'string)
;; (gnus-read-group "Group name: ")
(gnus-group-completing-read)
(gnus-read-method "From method")))
- ;; Transform the select method into a unique server.
(unless (gnus-alive-p)
- (gnus-no-server))
+ (nnheader-init-server-buffer)
+ ;; Necessary because of funky inlining.
+ (require 'gnus-cache)
+ (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
+ ;; Transform the select method into a unique server.
(when (stringp method)
(setq method (gnus-server-to-method method)))
(let ((address-slot
`(-1 nil (,group
,gnus-level-default-subscribed nil nil ,method
,(cons
- (cond
- (quit-config
- (cons 'quit-config quit-config))
- ((assq gnus-current-window-configuration
- gnus-buffer-configuration)
- (cons 'quit-config
+ (cons 'quit-config
+ (cond
+ (quit-config
+ quit-config)
+ ((assq gnus-current-window-configuration
+ gnus-buffer-configuration)
(cons gnus-summary-buffer
- gnus-current-window-configuration))))
+ gnus-current-window-configuration))
+ (t
+ (cons (current-buffer)
+ (current-window-configuration)))))
parameters)))
gnus-newsrc-hashtb)
(push method gnus-ephemeral-servers)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(unless (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(when activate
(gnus-activate-foreign-newsgroups level))
(gnus-group-get-new-news)))
-(defun gnus-group-get-new-news (&optional arg)
+(defun gnus-group-get-new-news (&optional arg one-level)
"Get newly arrived articles.
If ARG is a number, it specifies which levels you are interested in
re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
+\"hard\" re-reading of the active files from all servers.
+If ONE-LEVEL is not nil, then re-scan only the specified level,
+otherwise all levels below ARG will be scanned too."
(interactive "P")
(require 'nnmail)
(let ((gnus-inhibit-demon t)
(unless gnus-slave
(gnus-master-read-slave-newsrc))
- (gnus-get-unread-articles (gnus-group-default-level arg t))
+ (gnus-get-unread-articles (gnus-group-default-level arg t)
+ nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
header
(gnus-group-real-name group))))
+(defun gnus-select-group-with-message-id (group message-id)
+ "Activate and select GROUP with the given MESSAGE-ID selected.
+Returns the article number of the message.
+
+If GROUP is not already selected, the message will be the only one in
+the group's summary.
+"
+ ;; TODO: is there a way to know at this point whether the group will
+ ;; be newly-selected? If so we could clean up the logic at the end
+ ;;
+ ;; save the new group's display parameter, if any, so we
+ ;; can replace it temporarily with zero.
+ (let ((saved-display
+ (gnus-group-get-parameter group 'display :allow-list)))
+
+ ;; Tell gnus we really don't want any articles
+ (gnus-group-set-parameter group 'display 0)
+
+ (unwind-protect
+ (gnus-summary-read-group-1
+ group (not :show-all) :no-article (not :kill-buffer)
+ ;; The combination of no-display and this dummy list of
+ ;; articles to select somehow makes it possible to open a
+ ;; group with no articles in it. Black magic.
+ :no-display '(-1); select-articles
+ )
+ ;; Restore the new group's display parameter
+ (gnus-group-set-parameter group 'display saved-display)))
+
+ ;; The summary buffer was suppressed by :no-display above.
+ ;; Create it now and insert the message
+ (let ((group-is-new (gnus-summary-setup-buffer group)))
+ (condition-case err
+ (let ((article-number
+ (gnus-summary-insert-subject message-id)))
+ (unless article-number
+ (signal 'error "message-id not in group"))
+ (gnus-summary-select-article nil nil nil article-number)
+ article-number)
+ ;; Clean up the new summary and propagate the error
+ (error (when group-is-new (gnus-summary-exit))
+ (apply 'signal err)))))
+
+(defun gnus-simplify-group-name (group)
+ "Return the simplest representation of the name of GROUP.
+This is the string that Gnus uses to identify the group."
+ (gnus-group-prefixed-name
+ (gnus-group-real-name group)
+ (gnus-group-method group)))
+
(defun gnus-warp-to-article ()
"Warps from an article in a virtual group to the article in its
real group. Does nothing on a real group."
(interactive)
(when (gnus-virtual-group-p gnus-newsgroup-name)
(let ((gnus-command-method
- (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (gnus-check-backend-function
- 'warp-to-article (car gnus-command-method))
- (funcall (gnus-get-function gnus-command-method 'warp-to-article))))))
+ (gnus-find-method-for-group gnus-newsgroup-name)))
+ (or
+ (when (gnus-check-backend-function
+ 'warp-to-article (car gnus-command-method))
+ (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+ (and (bound-and-true-p gnus-registry-enabled)
+ (gnus-try-warping-via-registry))))))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
(const all :tag "Any")
(string :tag "Regexp")))
+(defcustom gnus-gcc-self-resent-messages 'no-gcc-self
+ "Like `gcc-self' group parameter, only for unmodified resent messages.
+Applied to messages sent by `gnus-summary-resend-message'. Non-nil
+value of this variable takes precedence over any existing Gcc header.
+
+If this is `none', no Gcc copy will be made. If this is t, messages
+resent will be Gcc'd to the current group. If this is a string, it
+specifies a group to which resent messages will be Gcc'd. If this is
+nil, Gcc will be done according to existing Gcc header(s), if any.
+If this is `no-gcc-self', resent messages will be Gcc'd to groups that
+existing Gcc header specifies, except for the current group."
+ :version "24.2"
+ :group 'gnus-message
+ :type '(choice (const none) (const t) string (const nil)
+ (const no-gcc-self)))
+
(gnus-define-group-parameter
posting-charset-alist
:type list
:group 'gnus-message
:type 'boolean)
+(defcustom gnus-gcc-pre-body-encode-hook nil
+ "A hook called before encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
+(defcustom gnus-gcc-post-body-encode-hook nil
+ "A hook called after encoding the body of the Gcc copy of a message.
+The current buffer (when the hook is run) contains the message
+including the message header. Changes made to the message will
+only affect the Gcc copy, but not the original message."
+ :group 'gnus-message
+ :type 'hook)
+
(autoload 'gnus-message-citation-mode "gnus-cite" nil t)
;;; Internal variables.
(set-buffer gnus-original-article-buffer)
(message-forward post)))))))
+(defun gnus-summary-resend-message-insert-gcc ()
+ "Insert Gcc header according to `gnus-gcc-self-resent-messages'."
+ (gnus-inews-insert-gcc)
+ (let ((gcc (mapcar
+ (lambda (group)
+ (mm-encode-coding-string
+ group
+ (gnus-group-name-charset (gnus-inews-group-method group)
+ group)))
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t)
+ " ,"))))
+ (self (with-current-buffer gnus-summary-buffer
+ gnus-gcc-self-resent-messages)))
+ (message-remove-header "gcc")
+ (when gcc
+ (goto-char (point-max))
+ (cond ((eq self 'none))
+ ((eq self t)
+ (insert "Gcc: \"" gnus-newsgroup-name "\"\n"))
+ ((stringp self)
+ (insert "Gcc: "
+ (mm-encode-coding-string
+ (if (string-match " " self)
+ (concat "\"" self "\"")
+ self)
+ (gnus-group-name-charset (gnus-inews-group-method self)
+ self))
+ "\n"))
+ ((null self)
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))
+ ((eq self 'no-gcc-self)
+ (when (setq gcc (delete
+ gnus-newsgroup-name
+ (delete (concat "\"" gnus-newsgroup-name "\"")
+ gcc)))
+ (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")))))))
+
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
(with-current-buffer gnus-original-article-buffer
(nnmail-fetch-field "to"))))
current-prefix-arg))
- (dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil nil article)
- (with-current-buffer gnus-original-article-buffer
- (let ((gnus-gcc-externalize-attachments nil))
- (message-resend address)))
- (gnus-summary-mark-article-as-forwarded article)))
+ (let ((message-header-setup-hook (copy-sequence message-header-setup-hook))
+ (message-sent-hook (copy-sequence message-sent-hook)))
+ ;; `gnus-summary-resend-message-insert-gcc' must run last.
+ (add-hook 'message-header-setup-hook
+ 'gnus-summary-resend-message-insert-gcc t)
+ (add-hook 'message-sent-hook
+ `(lambda ()
+ (let ((rfc2047-encode-encoded-words nil))
+ ,(if gnus-agent
+ '(gnus-agent-possibly-do-gcc)
+ '(gnus-inews-do-gcc)))))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil nil article)
+ (with-current-buffer gnus-original-article-buffer
+ (let ((gnus-gcc-externalize-attachments nil)
+ (message-inhibit-body-encoding t))
+ (message-resend address)))
+ (gnus-summary-mark-article-as-forwarded article))))
;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
(defun gnus-summary-resend-message-edit ()
(nnheader-set-temp-buffer " *acc*")
(setq message-options (with-current-buffer cur message-options))
(insert-buffer-substring cur)
+ (run-hooks 'gnus-gcc-pre-body-encode-hook)
(message-encode-message-body)
+ (run-hooks 'gnus-gcc-post-body-encode-hook)
(save-restriction
(message-narrow-to-headers)
(let* ((mail-parse-charset message-default-charset)
(when (and group-art
;; FIXME: Should gcc-mark-as-read work when
;; Gnus is not running?
- (gnus-alive-p)
- (or gnus-gcc-mark-as-read
- (and
- (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read))))
- (gnus-group-mark-article-read group (cdr group-art)))
+ (gnus-alive-p))
+ (if (or gnus-gcc-mark-as-read
+ (and (boundp 'gnus-inews-mark-gcc-as-read)
+ (symbol-value 'gnus-inews-mark-gcc-as-read)))
+ (gnus-group-mark-article-read group (cdr group-art))
+ (with-current-buffer gnus-group-buffer
+ (let ((gnus-group-marked (list group))
+ (gnus-get-new-news-hook nil)
+ (inhibit-read-only t))
+ (gnus-group-get-new-news-this-group nil t)))))
(setq options message-options)
(with-current-buffer cur (setq message-options options))
(kill-buffer (current-buffer)))))))))
:type '(repeat string)
:group 'gnus-picon)
+(defcustom gnus-picon-properties '(:color-symbols (("None" . "white")))
+ "List of image properties applied to picons."
+ :type 'list
+ :version "24.2"
+ :group 'gnus-picon)
+
(defcustom gnus-picon-style 'inline
"How should picons be displayed.
If `inline', the textual representation is replaced. If `right', picons are
(defun gnus-picon-create-glyph (file)
(or (cdr (assoc file gnus-picon-glyph-alist))
- (cdar (push (cons file (gnus-create-image
- file nil nil
- :color-symbols '(("None" . "white"))))
+ (cdar (push (cons file (apply 'gnus-create-image
+ file nil nil
+ gnus-picon-properties))
gnus-picon-glyph-alist))))
;;; Functions that does picon transformations:
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
(require 'gnus)
(require 'gnus-int)
(require 'gnus-sum)
(append gnus-registry-track-extra
'(mark group keyword)))
(when (not (equal old (oref db :tracked)))
- (gnus-message 4 "Reindexing the Gnus registry (tracked change)")
+ (gnus-message 9 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
(gnus-registry-set-id-key id key val))))
(message "Import done, collected %d entries" count))))
-(ert-deftest gnus-registry-misc-test ()
- (should-error (gnus-registry-extract-addresses '("" "")))
-
- (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
- "noname <ed@you.me>"
- "noname <cyd@stupidchicken.com>"
- "noname <tzz@lifelogs.com>")
- (gnus-registry-extract-addresses
- (concat "Ted Zlatanov <tzz@lifelogs.com>, "
- "ed <ed@you.me>, " ; "ed" is not a valid name here
- "cyd@stupidchicken.com, "
- "tzz@lifelogs.com")))))
-
-(ert-deftest gnus-registry-usage-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "gnus-registry-persist"))
- (db (gnus-registry-make-db tempfile))
- (gnus-registry-db db)
- back size)
- (message "Adding %d keys to the test Gnus registry" n)
- (dotimes (i n)
- (let ((id (number-to-string i)))
- (gnus-registry-handle-action id
- (if (>= 50 i) "fromgroup" nil)
- "togroup"
- (when (>= 70 i)
- (format "subject %d" (mod i 10)))
- (when (>= 80 i)
- (format "sender %d" (mod i 10))))))
- (message "Testing Gnus registry size is %d" n)
- (should (= n (registry-size db)))
- (message "Looking up individual keys (registry-lookup)")
- (should (equal (loop for e
- in (mapcar 'cadr
- (registry-lookup db '("20" "83" "72")))
- collect (assq 'subject e)
- collect (assq 'sender e)
- collect (assq 'group e))
- '((subject "subject 0") (sender "sender 0") (group "togroup")
- (subject) (sender) (group "togroup")
- (subject) (sender "sender 2") (group "togroup"))))
-
- (message "Looking up individual keys (gnus-registry-id-key)")
- (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
- (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
- (message "Trying to insert a duplicate key")
- (should-error (gnus-registry-insert db "55" '()))
- (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
- (should (gnus-registry-get-or-make-entry "22"))
- (message "Saving the Gnus registry to %s" tempfile)
- (should (gnus-registry-save tempfile db))
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saving the Gnus registry to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- "Gnus Registry"
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading Gnus registry back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read Gnus registry back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile)
- (message "Pruning Gnus registry to 0 by setting :max-soft")
- (oset db :max-soft 0)
- (registry-prune db)
- (should (= (registry-size db) 0)))
- (message "Done with Gnus registry usage testing."))
-
;;;###autoload
(defun gnus-registry-initialize ()
"Initialize the Gnus registry."
(gnus-registry-initialize)))
gnus-registry-enabled)
+;; largely based on nnir-warp-to-article
+(defun gnus-try-warping-via-registry ()
+ "Try to warp via the registry.
+This will be done via the current article's source group based on
+data stored in the registry."
+ (interactive)
+ (when (gnus-summary-article-header)
+ (let* ((message-id (mail-header-id (gnus-summary-article-header)))
+ ;; Retrieve the message's group(s) from the registry
+ (groups (gnus-registry-get-id-key message-id 'group))
+ ;; If starting from an ephemeral group, this describes
+ ;; how to restore the window configuration
+ (quit-config
+ (gnus-ephemeral-group-p gnus-newsgroup-name))
+ (seen-groups (list (gnus-group-group-name))))
+
+ (catch 'found
+ (dolist (group (mapcar 'gnus-simplify-group-name groups))
+
+ ;; skip over any groups we really don't want to warp to.
+ (unless (or (member group seen-groups)
+ (gnus-ephemeral-group-p group) ;; any ephemeral group
+ (memq (car (gnus-find-method-for-group group))
+ ;; Specific methods; this list may need to expand.
+ '(nnir)))
+
+ ;; remember that we've seen this group already
+ (push group seen-groups)
+
+ ;; first exit from any ephemeral summary buffer.
+ (when quit-config
+ (gnus-summary-exit)
+ ;; and if the ephemeral summary buffer in turn came from
+ ;; another summary buffer we have to clean that summary
+ ;; up too.
+ (when (eq (cdr quit-config) 'summary)
+ (gnus-summary-exit))
+ ;; remember that we've already done this part
+ (setq quit-config nil))
+
+ ;; Try to activate the group. If that fails, just move
+ ;; along. We may have more groups to work with
+ (ignore-errors
+ (gnus-select-group-with-message-id group message-id))
+ (throw 'found t)))))))
+
;; TODO: a few things
(provide 'gnus-registry)
(propertize (string 8206) 'invisible t)
""))
-(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (gnus-put-text-property
- (point)
- (progn
- (insert
- (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
- (let ((val
- (inline
- (gnus-summary-from-or-to-or-newsgroups
- gnus-tmp-header gnus-tmp-from))))
- (if (> (length val) 23)
- (if (gnus-lrm-string-p val)
- (concat (substring val 0 23) gnus-lrm-string)
- (substring val 0 23))
- val))
- gnus-tmp-closing-bracket))
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
- (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
- (insert "* ")
- (gnus-put-text-property
- (point)
- (progn
- (insert ": :")
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
- (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
- (insert gnus-tmp-marked-mark gnus-tmp-subscribed
- gnus-tmp-process-marked
- gnus-group-indentation
- (format "%5s: " gnus-tmp-number-of-unread))
- (gnus-put-text-property
- (point)
- (progn
- (insert gnus-tmp-group "\n")
- (1- (point)))
- gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
- (gnus-byte-code 'gnus-group-line-format-spec))
+(defvar gnus-summary-line-format-spec nil)
+(defvar gnus-summary-dummy-line-format-spec nil)
+(defvar gnus-group-line-format-spec nil)
(defvar gnus-format-specs
`((version . ,emacs-version)
- (gnus-version . ,(gnus-continuum-version))
- (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec)
- (summary-dummy "* %(: :%) %S\n"
- ,gnus-summary-dummy-line-format-spec)
- (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
- ,gnus-summary-line-format-spec))
+ (gnus-version . ,(gnus-continuum-version)))
"Alist of format specs.")
(defvar gnus-default-format-specs gnus-format-specs)
(not (equal emacs-version
(cdr (assq 'version gnus-format-specs)))))
(setq gnus-format-specs nil))
- ;; Flush the group format spec cache if there's the grouplens stuff
- ;; or it doesn't support decoded group names.
- (when (memq 'group types)
- (let* ((spec (assq 'group gnus-format-specs))
- (sspec (gnus-prin1-to-string (nth 2 spec))))
- (when (or (string-match " gnus-tmp-grouplens[ )]" sspec)
- (not (string-match " gnus-tmp-decoded-group[ )]" sspec)))
- (setq gnus-format-specs (delq spec gnus-format-specs)))))
-
;; Go through all the formats and see whether they need updating.
(let (new-format entry type val updated)
(while (setq type (pop types))
(gnus-add-text-properties (point) (progn (eval form) (point)) props)
(eval form))))
-(defun gnus-compile ()
- "Byte-compile the user-defined format specs."
- (interactive)
- (require 'bytecomp)
- (let ((entries gnus-format-specs)
- (byte-compile-warnings '(unresolved callargs redefine))
- entry gnus-tmp-func)
- (save-excursion
- (gnus-message 7 "Compiling format specs...")
-
- (while entries
- (setq entry (pop entries))
- (if (memq (car entry) '(gnus-version version))
- (setq gnus-format-specs (delq entry gnus-format-specs))
- (let ((form (caddr entry)))
- (when (and (listp form)
- ;; Under GNU Emacs, it's (byte-code ...)
- (not (eq 'byte-code (car form)))
- ;; Under XEmacs, it's (funcall #<compiled-function ...>)
- (not (and (eq 'funcall (car form))
- (byte-code-function-p (cadr form)))))
- (defalias 'gnus-tmp-func `(lambda () ,form))
- (byte-compile 'gnus-tmp-func)
- (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
-
- (push (cons 'version emacs-version) gnus-format-specs)
- ;; Mark the .newsrc.eld file as "dirty".
- (gnus-dribble-touch)
- (gnus-message 7 "Compiling user specs...done"))))
-
(defun gnus-set-format (type &optional insertable)
(set (intern (format "gnus-%s-line-format-spec" type))
(gnus-parse-format
;; Return the new active info.
active)))))
-(defvar gnus-propagate-marks) ; gnus-sum
-
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when (and info active)
;; Allow the backend to update the info in the group.
(gnus-info-group info)))))
(gnus-activate-group (gnus-info-group info) nil t))
- ;; Allow backends to update marks,
- (when gnus-propagate-marks
- (let ((method (inline (gnus-find-method-for-group
- (gnus-info-group info)))))
- (when (gnus-check-backend-function 'request-marks (car method))
- (gnus-request-marks info method))))
-
(let* ((range (gnus-info-read info))
(num 0))
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level dont-connect)
+(defun gnus-get-unread-articles (&optional level dont-connect one-level)
(setq gnus-server-method-cache nil)
(require 'gnus-agent)
(let* ((newsrc (cdr gnus-newsrc-alist))
(push (setq method-group-list (list method method-type nil nil))
type-cache))
;; Only add groups that need updating.
- (if (<= (gnus-info-level info)
+ (if (funcall (if one-level #'= #'<=) (gnus-info-level info)
(if (eq (cadr method-group-list) 'foreign)
foreign-level
alevel))
(gnus-online method)
(gnus-agent-method-p method))
(progn
- (gnus-agent-save-active method)
+ (gnus-agent-save-active method t)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
:group 'gnus-summary-maneuvering
:type 'boolean)
-(defcustom gnus-auto-center-summary 2
+(defcustom gnus-auto-center-summary
+ (max (or (bound-and-true-p scroll-margin) 0) 2)
"*If non-nil, always center the current summary buffer.
In particular, if `vertical' do only vertical recentering. If non-nil
and non-`vertical', do both horizontal and vertical recentering."
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks nil
- "If non-nil, Gnus will store and retrieve marks from the backends.
-This means that marks will be stored both in .newsrc.eld and in
-the backend, and will slow operation down somewhat."
- :type 'boolean
- :group 'gnus-summary-marks)
-
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
[tab] gnus-summary-widget-forward
+ [backtab] gnus-summary-widget-backward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (with-current-buffer gnus-group-buffer
+ (with-temp-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
(when (and (gnus-check-backend-function
'request-set-mark gnus-newsgroup-name)
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group gnus-newsgroup-name)
- 'server-marks))
(not (gnus-article-unpropagatable-p (cdr type))))
(let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
;; Don't do anything about marks for articles we
(info (nth 2 entry))
(active (gnus-active group))
(set-marks
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks)))
+ (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks))
range)
(if (not entry)
;; Group that Gnus doesn't know exists, but still allow the
;; article if ID is a number -- so that the next `P' or `N'
;; command will fetch the previous (or next) article even
;; if the one we tried to fetch this time has been canceled.
- (when (> number gnus-newsgroup-end)
+ (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end))
(setq gnus-newsgroup-end number))
- (when (< number gnus-newsgroup-begin)
+ (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin))
(setq gnus-newsgroup-begin number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
(gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
- (set-buffer gnus-group-buffer)
+ (when (buffer-live-p (get-buffer gnus-group-buffer))
+ (set-buffer gnus-group-buffer))
(unless quit-config
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (set-buffer gnus-group-buffer)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (set-buffer gnus-group-buffer))
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
"Handle movement when leaving an ephemeral group.
The state which existed when entering the ephemeral is reset."
(if (not (buffer-live-p (car quit-config)))
- (gnus-configure-windows 'group 'force)
+ (when (gnus-buffer-live-p gnus-group-buffer)
+ (gnus-configure-windows 'group 'force))
(set-buffer (car quit-config))
(unless (eq (cdr quit-config) 'group)
(setq gnus-current-select-method
(interactive
(list (read-string (if current-prefix-arg
"Exclude author (regexp): "
- "Limit to author (regexp): "))
+ "Limit to author (regexp): ")
+ (let ((header (gnus-summary-article-header)))
+ (if (not header)
+ ""
+ (car (mail-header-parse-address
+ (mail-header-from header))))))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
(select-window (gnus-get-buffer-window gnus-article-buffer))
(widget-forward arg))
+(defun gnus-summary-widget-backward (arg)
+ "Move point to the previous field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (unless (widget-at (point))
+ (goto-char (point-max)))
+ (widget-backward arg))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
to-group 'expire (list to-article) info))
(when (and to-marks
- (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group to-group)
- 'server-marks)))
+ (gnus-method-option-p
+ (gnus-find-method-for-group to-group)
+ 'server-marks))
(gnus-request-set-mark
to-group (list (list (list to-article) 'add to-marks)))))
(not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (bound-and-true-p gnus-registry-enabled)
+ (not (gnus-ephemeral-group-p (car where))))
+ (gnus-registry-handle-action
+ (mail-header-id header) nil
+ (gnus-group-prefixed-name (car where) gnus-override-method)
+ (mail-header-subject header)
+ (mail-header-from header)))
(when (and (stringp id)
(or
(not (string= (gnus-group-real-name group)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and (or gnus-propagate-marks
- (gnus-method-option-p
- (gnus-find-method-for-group group)
- 'server-marks))
+ (when (and (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks)
(gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
;; This is the gnus-sync.el package.
-;; It's due for a rewrite using gnus-after-set-mark-hook and
-;; gnus-before-update-mark-hook, and my plan is to do this once No
-;; Gnus development is done. Until then please consider it
-;; experimental.
-
;; Put this in your startup file (~/.gnus.el for instance)
;; possibilities for gnus-sync-backend:
;; Tramp over SSH: /ssh:user@host:/path/to/filename
-;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename
;; ...or any other file Tramp and Emacs can handle...
;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
-;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
-;; gnus-sync-newsrc-groups `("nntp" "nnrss")
-;; gnus-sync-newsrc-offsets `(2 3))
+;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date)
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+;; gnus-sync-newsrc-offsets '(2 3))
+;; against a LeSync server (beware the vampire LeSync, who knows your newsrc)
+
+;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz")
+;; gnus-sync-newsrc-groups '("nntp" "nnrss"))
+
+;; What's a LeSync server?
+
+;; 1. install CouchDB, set up a real server admin user, and create a
+;; database, e.g. "tzz" and save the URL,
+;; e.g. http://lesync.info:5984/tzz
+
+;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)'
+
+;; (If you run it more than once, you have to remove the entry from
+;; _users yourself. This is intentional. This sets up a database
+;; admin for the "tzz" database, distinct from the server admin
+;; user in (1) above.)
+
+;; That's it, you can start using http://lesync.info:5984/tzz in your
+;; gnus-sync-backend as a LeSync backend. Fan fiction about the
+;; vampire LeSync is welcome.
+
+;; You may not want to expose a CouchDB install to the Big Bad
+;; Internet, especially if your love of all things furry would be thus
+;; revealed. Make sure it's not accessible by unauthorized users and
+;; guests, at least.
+
+;; If you want to try it out, I will create a test DB for you under
+;; http://lesync.info:5984/yourfavoritedbname
;; TODO:
-;; - after gnus-sync-read, the message counts are wrong. So it's not
-;; run automatically, you have to call it with M-x gnus-sync-read
+;; - after gnus-sync-read, the message counts look wrong until you do
+;; `g'. So it's not run automatically, you have to call it with M-x
+;; gnus-sync-read
;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to
;; catch the mark updates
+;; - repositioning of groups within topic after a LeSync sync is a
+;; weird sort of bubble sort ("buttle" sort: the old entry ends up
+;; at the rear of the list); you will eventually end up with the
+;; right order after calling `gnus-sync-read' a bunch of times.
+
+;; - installing topics and groups is inefficient and annoying, lots of
+;; prompts could be avoided
+
;;; Code:
(eval-when-compile (require 'cl))
+(eval-and-compile
+ (or (ignore-errors (progn
+ (require 'json)))
+ ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
+ (ignore-errors
+ (let ((load-path (cons (expand-file-name
+ "gnus-fallback-lib"
+ (file-name-directory (locate-library "gnus")))
+ load-path)))
+ (require 'json)))
+ (error
+ "json not found in `load-path' or gnus-fallback-lib/ directory.")))
(require 'gnus)
(require 'gnus-start)
(require 'gnus-util)
+(defvar gnus-topic-alist) ;; gnus-group.el
+(eval-when-compile
+ (autoload 'gnus-group-topic "gnus-topic")
+ (autoload 'gnus-topic-create-topic "gnus-topic" nil t)
+ (autoload 'gnus-topic-enter-dribble "gnus-topic"))
+
(defgroup gnus-sync nil
"The Gnus synchronization facility."
:version "24.1"
:group 'gnus)
-(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss")
"List of groups to be synchronized in the gnus-newsrc-alist.
The group names are matched, they don't have to be fully
qualified. Typically you would choose all of these. That's the
:group 'gnus-sync
:type '(repeat regexp))
-(defcustom gnus-sync-newsrc-offsets '(2 3)
- "List of per-group data to be synchronized."
- :group 'gnus-sync
- :type '(set (const :tag "Read ranges" 2)
- (const :tag "Marks" 3)))
-
(defcustom gnus-sync-global-vars nil
"List of global variables to be synchronized.
You may want to sync `gnus-newsrc-last-checked-date' but pretty
much any symbol is fair game. You could additionally sync
`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
-and `gnus-topic-alist' to cover all the variables in
-newsrc.eld (except for `gnus-format-specs' which should not be
-synchronized, I believe). Also see `gnus-variable-list'."
+and `gnus-topic-alist'. Also see `gnus-variable-list'."
:group 'gnus-sync
:type '(repeat (choice (variable :tag "A known variable")
(symbol :tag "Any symbol"))))
"The synchronization backend."
:group 'gnus-sync
:type '(radio (const :format "None" nil)
+ (list :tag "Sync server"
+ (const :format "LeSync Server API" lesync)
+ (string :tag "URL of a CouchDB database for API access"))
(string :tag "Sync to a file")))
(defvar gnus-sync-newsrc-loader nil
"Carrier for newsrc data")
-(defun gnus-sync-save ()
-"Save the Gnus sync data to the backend."
- (interactive)
+(defcustom gnus-sync-lesync-name (system-name)
+ "The LeSync name for this machine."
+ :group 'gnus-sync
+ :type 'string)
+
+(defcustom gnus-sync-lesync-install-topics 'ask
+ "Should LeSync install the recorded topics?"
+ :group 'gnus-sync
+ :type '(choice (const :tag "Never Install" nil)
+ (const :tag "Always Install" t)
+ (const :tag "Ask Me Once" ask)))
+
+(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal)
+ "LeSync props, keyed by group name")
+
+(defvar gnus-sync-lesync-design-prefix "/_design/lesync"
+ "The LeSync design prefix for CouchDB")
+
+(defvar gnus-sync-lesync-security-object "/_security"
+ "The LeSync security object for CouchDB")
+
+(defun gnus-sync-lesync-parse ()
+ "Parse the result of a LeSync request."
+ (goto-char (point-min))
+ (condition-case nil
+ (when (search-forward-regexp "^$" nil t)
+ (json-read))
+ (error
+ (gnus-message
+ 1
+ "gnus-sync-lesync-parse: Could not read the LeSync response!")
+ nil)))
+
+(defun gnus-sync-lesync-call (url method headers &optional kvdata)
+ "Make an access request to URL using KVDATA and METHOD.
+KVDATA must be an alist."
+ (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch
+ (let ((url-request-method method)
+ (url-request-extra-headers headers)
+ (url-request-data (if kvdata (json-encode kvdata) nil)))
+ (with-current-buffer (url-retrieve-synchronously url)
+ (let ((data (gnus-sync-lesync-parse)))
+ (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S"
+ method url `((headers . ,headers) (data ,kvdata)) data)
+ (kill-buffer (current-buffer))
+ data)))))
+
+(defun gnus-sync-lesync-PUT (url headers &optional data)
+ (gnus-sync-lesync-call url "PUT" headers data))
+
+(defun gnus-sync-lesync-POST (url headers &optional data)
+ (gnus-sync-lesync-call url "POST" headers data))
+
+(defun gnus-sync-lesync-GET (url headers &optional data)
+ (gnus-sync-lesync-call url "GET" headers data))
+
+(defun gnus-sync-lesync-DELETE (url headers &optional data)
+ (gnus-sync-lesync-call url "DELETE" headers data))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-alist-p (list)
+ "Non-null if and only if LIST is an alist."
+ (while (consp list)
+ (setq list (if (consp (car list))
+ (cdr list)
+ 'not-alist)))
+ (null list))
+
+;; this is not necessary with newer versions of json.el but 1.2 or older
+;; (which are in Emacs 24.1 and earlier) need it
+(defun gnus-sync-json-plist-p (list)
+ "Non-null if and only if LIST is a plist."
+ (while (consp list)
+ (setq list (if (and (keywordp (car list))
+ (consp (cdr list)))
+ (cddr list)
+ 'not-plist)))
+ (null list))
+
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)
+; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz")
+
+(defun gnus-sync-lesync-setup (url &optional user password salt reader admin)
+ (interactive "sEnter URL to set up: ")
+ "Set up the LeSync database at URL.
+Install USER as a READER and/or an ADMIN in the security object
+under \"_security\", and in the CouchDB \"_users\" table using
+PASSWORD and SALT. Only one USER is thus supported for now.
+When SALT is nil, a random one will be generated using `random'."
+ (let* ((design-url (concat url gnus-sync-lesync-design-prefix))
+ (security-object (concat url "/_security"))
+ (user-record `((names . [,user]) (roles . [])))
+ (couch-user-name (format "org.couchdb.user:%s" user))
+ (salt (or salt (sha1 (format "%s" (random t)))))
+ (couch-user-record
+ `((_id . ,couch-user-name)
+ (type . user)
+ (name . ,(format "%s" user))
+ (roles . [])
+ (salt . ,salt)
+ (password_sha . ,(when password
+ (sha1
+ (format "%s%s" password salt))))))
+ (rev (progn
+ (gnus-sync-lesync-find-prop 'rev design-url design-url)
+ (gnus-sync-lesync-get-prop 'rev design-url)))
+ (latest-func "function(head,req)
+{
+ var tosend = [];
+ var row;
+ var ftime = (req.query['ftime'] || 0);
+ while (row = getRow())
+ {
+ if (row.value['float-time'] > ftime)
+ {
+ var s = row.value['_id'];
+ if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"');
+ }
+ }
+ send('['+tosend.join(',') + ']');
+}")
+;; <key>read</key>
+;; <dict>
+;; <key>de.alt.fan.ipod</key>
+;; <array>
+;; <integer>1</integer>
+;; <integer>2</integer>
+;; <dict>
+;; <key>start</key>
+;; <integer>100</integer>
+;; <key>length</key>
+;; <integer>100</integer>
+;; </dict>
+;; </array>
+;; </dict>
+ (xmlplistread-func "function(head, req) {
+ var row;
+ start({ 'headers': { 'Content-Type': 'text/xml' } });
+
+ send('<dict>');
+ send('<key>read</key>');
+ send('<dict>');
+ while(row = getRow())
+ {
+ var read = row.value.read;
+ if (read && read[0] && read[0] == 'invlist')
+ {
+ send('<key>'+row.key+'</key>');
+ //send('<invlist>'+read+'</invlist>');
+ send('<array>');
+
+ var from = 0;
+ var flip = false;
+
+ for (var i = 1; i < read.length && read[i]; i++)
+ {
+ var cur = read[i];
+ if (flip)
+ {
+ if (from == cur-1)
+ {
+ send('<integer>'+read[i]+'</integer>');
+ }
+ else
+ {
+ send('<dict>');
+ send('<key>start</key>');
+ send('<integer>'+from+'</integer>');
+ send('<key>end</key>');
+ send('<integer>'+(cur-1)+'</integer>');
+ send('</dict>');
+ }
+
+ }
+ flip = ! flip;
+ from = cur;
+ }
+ send('</array>');
+ }
+ }
+
+ send('</dict>');
+ send('</dict>');
+}
+")
+ (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}")
+ (revs-func "function(doc){emit(doc._id, doc._rev);}")
+ (bytimesubs-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc._rev);}")
+ (bytime-func "function(doc)
+{emit([(doc['float-time']||0), doc._id], doc);}")
+ (groups-func "function(doc){emit(doc._id, doc);}"))
+ (and (if user
+ (and (assq 'ok (gnus-sync-lesync-PUT
+ security-object
+ nil
+ (append (and reader
+ (list `(readers . ,user-record)))
+ (and admin
+ (list `(admins . ,user-record))))))
+ (assq 'ok (gnus-sync-lesync-PUT
+ (concat (file-name-directory url)
+ "_users/"
+ couch-user-name)
+ nil
+ couch-user-record)))
+ t)
+ (assq 'ok (gnus-sync-lesync-PUT
+ design-url
+ nil
+ `(,@(when rev (list (cons '_rev rev)))
+ (lists . ((latest . ,latest-func)
+ (xmlplistread . ,xmlplistread-func)))
+ (views . ((subs . ((map . ,subs-func)))
+ (revs . ((map . ,revs-func)))
+ (bytimesubs . ((map . ,bytimesubs-func)))
+ (bytime . ((map . ,bytime-func)))
+ (groups . ((map . ,groups-func)))))))))))
+
+(defun gnus-sync-lesync-find-prop (prop url key)
+ "Retrieve a PROPerty of a document KEY at URL.
+Calls `gnus-sync-lesync-set-prop'.
+For the 'rev PROP, uses '_rev against the document."
+ (gnus-sync-lesync-set-prop
+ prop key (cdr (assq (if (eq prop 'rev) '_rev prop)
+ (gnus-sync-lesync-GET url nil)))))
+
+(defun gnus-sync-lesync-set-prop (prop key val)
+ "Update the PROPerty of document KEY at URL to VAL.
+Updates `gnus-sync-lesync-props-hash'."
+ (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-lesync-get-prop (prop key)
+ "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'."
+ (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash))
+
+(defun gnus-sync-deep-print (data)
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-circle nil)
+ (print-escape-newlines t))
+ (format "%S" data)))
+
+(defun gnus-sync-newsrc-loader-builder (&optional only-modified)
+ (let* ((entries (cdr gnus-newsrc-alist))
+ entry name ret)
+ (while entries
+ (setq entry (pop entries)
+ name (car entry))
+ (when (gnus-grep-in-list name gnus-sync-newsrc-groups)
+ (if only-modified
+ (when (not (equal (gnus-sync-deep-print entry)
+ (gnus-sync-lesync-get-prop 'checksum name)))
+ (gnus-message 9 "%s: add %s, it's modified"
+ "gnus-sync-newsrc-loader-builder" name)
+ (push entry ret))
+ (push entry ret))))
+ ret))
+
+; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)))
+(defun gnus-sync-range2invlist (ranges)
+ (append '(invlist)
+ (let ((ranges (delq nil ranges))
+ ret range from to)
+ (while ranges
+ (setq range (pop ranges))
+ (if (atom range)
+ (setq from range
+ to range)
+ (setq from (car range)
+ to (cdr range)))
+ (push from ret)
+ (push (1+ to) ret))
+ (reverse ret))))
+
+; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j))
+(defun gnus-sync-invlist2range (inv)
+ (setq inv (append inv nil))
+ (if (equal (format "%s" (car inv)) "invlist")
+ (let ((i (cdr inv))
+ (start 0)
+ ret cur top flip)
+ (while i
+ (setq cur (pop i))
+ (when flip
+ (setq top (1- cur))
+ (if (= start top)
+ (push start ret)
+ (push (cons start top) ret)))
+ (setq flip (not flip))
+ (setq start cur))
+ (reverse ret))
+ inv))
+
+(defun gnus-sync-position (search list &optional test)
+ "Find the position of SEARCH in LIST using TEST, defaulting to `eq'."
+ (let ((pos 0)
+ (test (or test 'eq)))
+ (while (and list (not (funcall test (car list) search)))
+ (pop list)
+ (incf pos))
+ (if (funcall test (car list) search) pos nil)))
+
+(defun gnus-sync-topic-group-position (group topic-name)
+ (gnus-sync-position
+ group (cdr (assoc topic-name gnus-topic-alist)) 'equal))
+
+(defun gnus-sync-fix-topic-group-position (group topic-name position)
+ (unless (equal position (gnus-sync-topic-group-position group topic-name))
+ (let* ((loc "gnus-sync-fix-topic-group-position")
+ (groups (delete group (cdr (assoc topic-name gnus-topic-alist))))
+ (position (min position (1- (length groups))))
+ (old (nth position groups)))
+ (when (and old (not (equal old group)))
+ (setf (nth position groups) group)
+ (setcdr (assoc topic-name gnus-topic-alist)
+ (append groups (list old)))
+ (gnus-message 9 "%s: %s moved to %d, swap with %s"
+ loc group position old)))))
+
+(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props)
+ (let* ((loc "gnus-sync-lesync-save-group-entry")
+ (k (car nentry))
+ (revision (gnus-sync-lesync-get-prop 'rev k))
+ (sname gnus-sync-lesync-name)
+ (topic (gnus-group-topic k))
+ (topic-offset (gnus-sync-topic-group-position k topic))
+ (sources (gnus-sync-lesync-get-prop 'source k)))
+ ;; set the revision so we don't have a conflict
+ `(,@(when revision
+ (list (cons '_rev revision)))
+ (_id . ,k)
+ ;; the time we saved
+ ,@passed-props
+ ;; add our name to the sources list for this key
+ (source ,@(if (member gnus-sync-lesync-name sources)
+ sources
+ (cons gnus-sync-lesync-name sources)))
+ ,(cons 'level (nth 1 nentry))
+ ,@(if topic (list (cons 'topic topic)) nil)
+ ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil)
+ ;; the read marks
+ ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry)))
+ ;; the other marks
+ ,@(delq nil (mapcar (lambda (mark-entry)
+ (gnus-message 12 "%s: prep param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ (if (listp (cdr mark-entry))
+ (cons (car mark-entry)
+ (gnus-sync-range2invlist
+ (cdr mark-entry)))
+ (progn ; else this is not a list
+ (gnus-message 9 "%s: non-list param %s in %s"
+ loc
+ (car mark-entry)
+ (nth 3 nentry))
+ nil)))
+ (nth 3 nentry))))))
+
+(defun gnus-sync-lesync-post-save-group-entry (url entry)
+ (let* ((loc "gnus-sync-lesync-post-save-group-entry")
+ (k (cdr (assq 'id entry))))
+ (cond
+ ;; success!
+ ((and (assq 'rev entry) (assq 'id entry))
+ (progn
+ (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry)))
+ (gnus-sync-lesync-set-prop 'checksum
+ k
+ (gnus-sync-deep-print
+ (assoc k gnus-newsrc-alist)))
+ (gnus-message 9 "%s: successfully synced %s to %s"
+ loc k url)))
+ ;; specifically check for document conflicts
+ ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry))))
+ (gnus-error
+ 1
+ "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s"
+ loc "gnus-sync-read" k url (cdr (assq 'reason entry))))
+ ;; generic errors
+ ((assq 'error entry)
+ (gnus-error 1 "%s: got error while synchronizing %s to %s: %s"
+ loc k url (cdr (assq 'reason entry))))
+
+ (t
+ (gnus-message 2 "%s: unknown sync status after %s to %s: %S"
+ loc k url entry)))
+ (assoc 'error entry)))
+
+(defun gnus-sync-lesync-groups-builder (url)
+ (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups")))
+ (cdr (assq 'rows (gnus-sync-lesync-GET u nil)))))
+
+(defun gnus-sync-subscribe-group (name)
+ "Subscribe to group NAME. Returns NAME on success, nil otherwise."
+ (gnus-subscribe-newsgroup name))
+
+(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props)
+ "Read ENTRY information for NAME. Returns NAME if successful.
+Skips entries whose sources don't contain
+`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a
+`subscribe-all' element that evaluates to true, we attempt to
+subscribe to unknown groups. The user is also allowed to delete
+unwanted groups via the LeSync URL."
+ (let* ((loc "gnus-sync-lesync-read-group-entry")
+ (entry (gnus-sync-lesync-normalize-group-entry entry passed-props))
+ (subscribe-all (cdr (assq 'subscribe-all passed-props)))
+ (sources (cdr (assq 'source entry)))
+ (rev (cdr (assq 'rev entry)))
+ (in-sources (member gnus-sync-lesync-name sources))
+ (known (assoc name gnus-newsrc-alist))
+ cell)
+ (unless known
+ (if (and subscribe-all
+ (y-or-n-p (format "Subscribe to group %s?" name)))
+ (setq known (gnus-sync-subscribe-group name)
+ in-sources t)
+ ;; else...
+ (when (y-or-n-p (format "Delete group %s from server?" name))
+ (if (equal name (gnus-sync-lesync-delete-group url name))
+ (gnus-message 1 "%s: removed group %s from server %s"
+ loc name url)
+ (gnus-error 1 "%s: could not remove group %s from server %s"
+ loc name url)))))
+ (when known
+ (unless in-sources
+ (setq in-sources
+ (y-or-n-p
+ (format "Read group %s even though %s is not in sources %S?"
+ name gnus-sync-lesync-name (or sources ""))))))
+ (when rev
+ (gnus-sync-lesync-set-prop 'rev name rev))
+
+ ;; if the source matches AND we have this group
+ (if (and known in-sources)
+ (progn
+ (gnus-message 10 "%s: reading LeSync entry %s, sources %S"
+ loc name sources)
+ (while entry
+ (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (gnus-sync-lesync-set-prop k name val)))
+ name)
+ ;; else...
+ (unless known
+ (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s"
+ loc name "Call `gnus-sync-read' with C-u to force it."))
+ (unless in-sources
+ (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S"
+ loc name gnus-sync-lesync-name (or sources "")))
+ nil)))
+
+(defun gnus-sync-lesync-install-group-entry (name)
+ (let* ((master (assoc name gnus-newsrc-alist))
+ (old-topic-name (gnus-group-topic name))
+ (old-topic (assoc old-topic-name gnus-topic-alist))
+ (target-topic-name (gnus-sync-lesync-get-prop 'topic name))
+ (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name))
+ (target-topic (assoc target-topic-name gnus-topic-alist))
+ (loc "gnus-sync-lesync-install-group-entry"))
+ (if master
+ (progn
+ (when (eq 'ask gnus-sync-lesync-install-topics)
+ (setq gnus-sync-lesync-install-topics
+ (y-or-n-p "Install topics from LeSync?")))
+ (when (and (eq t gnus-sync-lesync-install-topics)
+ target-topic-name)
+ (if (equal old-topic-name target-topic-name)
+ (gnus-message 12 "%s: %s is already in topic %s"
+ loc name target-topic-name)
+ ;; see `gnus-topic-move-group'
+ (when (and old-topic target-topic)
+ (setcdr old-topic (gnus-delete-first name (cdr old-topic)))
+ (gnus-message 5 "%s: removing %s from topic %s"
+ loc name old-topic-name))
+ (unless target-topic
+ (when (y-or-n-p (format "Create missing topic %s?"
+ target-topic-name))
+ (gnus-topic-create-topic target-topic-name nil)
+ (setq target-topic (assoc target-topic-name
+ gnus-topic-alist))))
+ (if target-topic
+ (prog1
+ (nconc target-topic (list name))
+ (gnus-message 5 "%s: adding %s to topic %s"
+ loc name (car target-topic))
+ (gnus-topic-enter-dribble))
+ (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s"
+ loc name target-topic-name)))
+ (when (and target-topic-offset target-topic)
+ (gnus-sync-fix-topic-group-position
+ name target-topic-name target-topic-offset)))
+ ;; install the subscription level
+ (when (gnus-sync-lesync-get-prop 'level name)
+ (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name)))
+ ;; install the read and other marks
+ (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name))
+ (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name))
+ (gnus-sync-lesync-set-prop 'checksum
+ name
+ (gnus-sync-deep-print master))
+ nil)
+ (gnus-error 1 "%s: invalid LeSync group %s" loc name)
+ 'invalid-name)))
+
+; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot")
+
+(defun gnus-sync-lesync-delete-group (url name)
+ "Returns NAME if successful deleting it from URL, an error otherwise."
+ (interactive "sEnter URL to set up: \rsEnter group name: ")
+ (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name)))
+ (del (gnus-sync-lesync-DELETE
+ u
+ `(,@(when (gnus-sync-lesync-get-prop 'rev name)
+ (list (cons "If-Match"
+ (gnus-sync-lesync-get-prop 'rev name))))))))
+ (or (cdr (assq 'id del)) del)))
+
+;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil)))
+
+(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props)
+ (let (ret
+ marks
+ cell)
+ (setq entry (append passed-props entry))
+ (while (setq cell (pop entry))
+ (let ((k (car cell))
+ (val (cdr cell)))
+ (cond
+ ((eq k 'read)
+ (push (cons k (gnus-sync-invlist2range val)) ret))
+ ;; we ignore these parameters
+ ((member k '(_id subscribe-all _deleted_conflicts))
+ nil)
+ ((eq k '_rev)
+ (push (cons 'rev val) ret))
+ ((eq k 'source)
+ (push (cons 'source (append val nil)) ret))
+ ((or (eq k 'float-time)
+ (eq k 'level)
+ (eq k 'topic)
+ (eq k 'topic-offset)
+ (eq k 'read-time))
+ (push (cons k val) ret))
+;;; "How often have I said to you that when you have eliminated the
+;;; impossible, whatever remains, however improbable, must be the
+;;; truth?" --Sherlock Holmes
+ ;; everything remaining must be a mark
+ (t (push (cons k (gnus-sync-invlist2range val)) marks)))))
+ (cons (cons 'marks marks) ret)))
+
+(defun gnus-sync-save (&optional force)
+"Save the Gnus sync data to the backend.
+With a prefix, FORCE is set and all groups will be saved."
+ (interactive "P")
(cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+
+ ;; refresh the revisions if we're forcing the save
+ (when force
+ (mapc (lambda (entry)
+ (when (and (assq 'key entry)
+ (assq 'value entry))
+ (gnus-sync-lesync-set-prop
+ 'rev
+ (cdr (assq 'key entry))
+ (cdr (assq 'value entry)))))
+ ;; the revs view is key = name, value = rev
+ (cdr (assq 'rows (gnus-sync-lesync-GET
+ (concat (nth 1 gnus-sync-backend)
+ gnus-sync-lesync-design-prefix
+ "/_view/revs")
+ nil)))))
+
+ (let* ((ftime (float-time))
+ (url (nth 1 gnus-sync-backend))
+ (entries
+ (mapcar (lambda (entry)
+ (gnus-sync-lesync-pre-save-group-entry
+ (cadr gnus-sync-backend)
+ entry
+ (cons 'float-time ftime)))
+ (gnus-sync-newsrc-loader-builder (not force))))
+ ;; when there are no entries, there's nothing to save
+ (sync (if entries
+ (gnus-sync-lesync-POST
+ (concat url "/_bulk_docs")
+ '(("Content-Type" . "application/json"))
+ `((docs . ,(vconcat entries nil))))
+ (gnus-message
+ 2 "gnus-sync-save: nothing to save to the LeSync backend")
+ nil)))
+ (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e))
+ sync)))
((stringp gnus-sync-backend)
- (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+ (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend)
;; populate gnus-sync-newsrc-loader from all but the first dummy
;; entry in gnus-newsrc-alist whose group matches any of the
;; gnus-sync-newsrc-groups
;; TODO: keep the old contents for groups we don't have!
- (let ((gnus-sync-newsrc-loader
- (loop for entry in (cdr gnus-newsrc-alist)
- when (gnus-grep-in-list
- (car entry) ;the group name
- gnus-sync-newsrc-groups)
- collect (cons (car entry)
- (mapcar (lambda (offset)
- (cons offset (nth offset entry)))
- gnus-sync-newsrc-offsets)))))
+ (let ((gnus-sync-newsrc-loader (gnus-sync-newsrc-loader-builder)))
(with-temp-file gnus-sync-backend
(progn
(let ((coding-system-for-write gnus-ding-file-coding-system)
(princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
gnus-ding-file-coding-system))
(princ ";; Gnus sync data v. 0.0.1\n")
+ ;; TODO: replace with `gnus-sync-deep-print'
(let* ((print-quoted t)
(print-readably t)
(print-escape-multibyte nil)
(princ (symbol-name variable)))))
(gnus-message
7
- "gnus-sync: stored variables %s and %d groups in %s"
+ "gnus-sync-save: stored variables %s and %d groups in %s"
gnus-sync-global-vars
(length gnus-sync-newsrc-loader)
gnus-sync-backend)
;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
;; Save the .eld file with extra line breaks.
- (gnus-message 8 "gnus-sync: adding whitespace to %s"
+ (gnus-message 8 "gnus-sync-save: adding whitespace to %s"
gnus-sync-backend)
(save-excursion
(goto-char (point-min))
;; the pass-through case: gnus-sync-backend is not a known choice
(nil)))
-(defun gnus-sync-read ()
-"Load the Gnus sync data from the backend."
- (interactive)
+(defun gnus-sync-read (&optional subscribe-all)
+ "Load the Gnus sync data from the backend.
+With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed."
+ (interactive "P")
(when gnus-sync-backend
- (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
- (cond ((stringp gnus-sync-backend)
- ;; read data here...
- (if (or debug-on-error debug-on-quit)
- (load gnus-sync-backend nil t)
- (condition-case var
- (load gnus-sync-backend nil t)
- (error
- (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
- (let ((valid-count 0)
- invalid-groups)
- (dolist (node gnus-sync-newsrc-loader)
- (if (gnus-gethash (car node) gnus-newsrc-hashtb)
- (progn
- (incf valid-count)
- (loop for store in (cdr node)
- do (setf (nth (car store)
- (assoc (car node) gnus-newsrc-alist))
- (cdr store))))
- (push (car node) invalid-groups)))
- (gnus-message
- 7
- "gnus-sync: loaded %d groups (out of %d) from %s"
- valid-count (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (when invalid-groups
- (gnus-message
- 7
- "gnus-sync: skipped %d groups (out of %d) from %s"
- (length invalid-groups)
- (length gnus-sync-newsrc-loader)
- gnus-sync-backend)
- (gnus-message 9 "gnus-sync: skipped groups: %s"
- (mapconcat 'identity invalid-groups ", ")))))
- (nil))
- ;; make the hashtable again because the newsrc-alist may have been modified
- (when gnus-sync-newsrc-offsets
- (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
- (gnus-make-hashtable-from-newsrc-alist))))
+ (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend)
+ (cond
+ ((and (listp gnus-sync-backend)
+ (eq (nth 0 gnus-sync-backend) 'lesync)
+ (stringp (nth 1 gnus-sync-backend)))
+ (let ((errored nil)
+ name ftime)
+ (mapc (lambda (entry)
+ (setq name (cdr (assq 'id entry)))
+ ;; set ftime the FIRST time through this loop, that
+ ;; way it reflects the time we FINISHED reading
+ (unless ftime (setq ftime (float-time)))
+
+ (unless errored
+ (setq errored
+ (when (equal name
+ (gnus-sync-lesync-read-group-entry
+ (nth 1 gnus-sync-backend)
+ name
+ (cdr (assq 'value entry))
+ `(read-time ,ftime)
+ `(subscribe-all ,subscribe-all)))
+ (gnus-sync-lesync-install-group-entry
+ (cdr (assq 'id entry)))))))
+ (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend)))))
+
+ ((stringp gnus-sync-backend)
+ ;; read data here...
+ (if (or debug-on-error debug-on-quit)
+ (load gnus-sync-backend nil t)
+ (condition-case var
+ (load gnus-sync-backend nil t)
+ (error
+ (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
+ (cdr store))))
+ (push (car node) invalid-groups)))
+ (gnus-message
+ 7
+ "gnus-sync-read: loaded %d groups (out of %d) from %s"
+ valid-count (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync-read: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync-read: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))))
+ (nil))
+
+ (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable")
+ (gnus-make-hashtable-from-newsrc-alist)))
;;;###autoload
(defun gnus-sync-initialize ()
(defun gnus-sync-unload-hook ()
"Uninstall the sync hooks."
(interactive)
- (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
- (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save))
(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
-;; this is harmless by default, until the gnus-sync-backend is set
-(gnus-sync-initialize)
+(when gnus-sync-backend (gnus-sync-initialize))
(provide 'gnus-sync)
`(delete-region (point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
-(defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (indirect-function func)))
- (if (byte-code-function-p fval)
- (let ((flist (append fval nil)))
- (setcar flist 'byte-code)
- flist)
- (cons 'progn (cddr fval)))))
-
(defun gnus-extract-address-components (from)
"Extract address components from a From header.
Given an RFC-822 address FROM, extract full name and canonical address.
image)))
image)))
+(defun gnus-recursive-directory-files (dir)
+ "Return all regular files below DIR."
+ (let (files)
+ (dolist (file (directory-files dir t))
+ (when (and (not (member (file-name-nondirectory file) '("." "..")))
+ (file-readable-p file))
+ (cond
+ ((file-regular-p file)
+ (push file files))
+ ((file-directory-p file)
+ (setq files (append (gnus-recursive-directory-files file) files))))))
+ files))
+
(defun gnus-list-memq-of-list (elements list)
"Return non-nil if any of the members of ELEMENTS are in LIST."
(let ((found nil))
(purp "#9999cc" "#666699")
(no "#ff0000" "#ffff00")
(neutral "#b4b4b4" "#878787")
+ (ma "#2020e0" "#8080ff")
(september "#bf9900" "#ffcc00"))
"Color alist used for the Gnus logo.")
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
"*Color styles used for the Gnus logo."
:type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
gnus-logo-color-alist))
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+ ("gnus-registry" gnus-try-warping-via-registry
+ gnus-registry-handle-action)
("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
(defun message-goto-to ()
"Move point to the To header."
(interactive)
+ (push-mark)
(message-position-on-field "To"))
(defun message-goto-from ()
"Move point to the From header."
(interactive)
+ (push-mark)
(message-position-on-field "From"))
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
+ (push-mark)
(message-position-on-field "Subject"))
(defun message-goto-cc ()
"Move point to the Cc header."
(interactive)
+ (push-mark)
(message-position-on-field "Cc" "To"))
(defun message-goto-bcc ()
"Move point to the Bcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
"Move point to the Fcc header."
(interactive)
+ (push-mark)
(message-position-on-field "Fcc" "To" "Newsgroups"))
(defun message-goto-reply-to ()
"Move point to the Reply-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Reply-To" "Subject"))
(defun message-goto-newsgroups ()
"Move point to the Newsgroups header."
(interactive)
+ (push-mark)
(message-position-on-field "Newsgroups"))
(defun message-goto-distribution ()
"Move point to the Distribution header."
(interactive)
+ (push-mark)
(message-position-on-field "Distribution"))
(defun message-goto-followup-to ()
"Move point to the Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Followup-To" "Newsgroups"))
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
(interactive)
+ (push-mark)
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
(interactive)
+ (push-mark)
(message-position-on-field "Keywords" "Subject"))
(defun message-goto-summary ()
"Move point to the Summary header."
(interactive)
+ (push-mark)
(message-position-on-field "Summary" "Subject"))
(eval-when-compile
(when (and (message-called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
+ (push-mark)
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
If there is no signature in the article, go to the end and
return nil."
(interactive)
+ (push-mark)
(goto-char (point-min))
(if (re-search-forward message-signature-separator nil t)
(forward-line 1)
(save-current-buffer
(dolist (buffer (buffer-list t))
(set-buffer buffer)
- (when (and (eq major-mode 'message-mode)
+ (when (and (derived-mode-p 'message-mode)
(null message-sent-message-via))
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
(end-of-line)
(insert (format " (%d/%d)" n total))
(widen)
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
")))
(progn
(message "Sending via mail...")
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
+ (if message-send-mail-real-function
+ (funcall message-send-mail-real-function)
+ (message-multi-smtp-send-mail)))
(message-send-mail-partially))
(setq options message-options))
(kill-buffer tembuf))
(push 'mail message-sent-message-via)))
(defvar sendmail-program)
+(defvar smtpmail-smtp-user)
+
+(defun message-multi-smtp-send-mail ()
+ "Send the current buffer to `message-send-mail-function'.
+Or, if there's a header that specifies a different method, use
+that instead."
+ (let ((method (message-field-value "X-Message-SMTP-Method")))
+ (if (not method)
+ (funcall message-send-mail-function)
+ (message-remove-header "X-Message-SMTP-Method")
+ (setq method (split-string method))
+ (cond
+ ((equal (car method) "sendmail")
+ (message-send-mail-with-sendmail))
+ ((equal (car method) "smtp")
+ (require 'smtpmail)
+ (let ((smtpmail-smtp-server (nth 1 method))
+ (smtpmail-smtp-service (nth 2 method))
+ (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
+ (message-smtpmail-send-it)))
+ (t
+ (error "Unknown method %s" method))))))
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
- beg)
+ gcc beg)
;; We first set up a normal mail buffer.
(unless (message-mail-user-agent)
(set-buffer (get-buffer-create " *message resend*"))
;; Insert our usual headers.
(message-generate-headers '(From Date To Message-ID))
(message-narrow-to-headers)
+ (when (setq gcc (mail-fetch-field "gcc" nil t))
+ (message-remove-header "gcc"))
;; Remove X-Draft-From header etc.
(message-remove-header message-ignored-mail-headers t)
;; Rename them all to "Resent-*".
message-generate-hashcash
rfc2047-encode-encoded-words)
(message-send-mail))
+ (when gcc
+ (message-goto-eoh)
+ (insert "Gcc: " gcc "\n"))
+ (run-hooks 'message-sent-hook)
(kill-buffer (current-buffer)))
(message "Resending message to %s...done" address)))
(autoload 'mm-extern-cache-contents "mm-extern")
(autoload 'mm-insert-inline "mm-view")
+(autoload 'mm-archive-decoders "mm-archive")
+(autoload 'mm-archive-dissect-and-inline "mm-archive")
+(autoload 'mm-dissect-archive "mm-archive")
+
(defvar gnus-current-window-configuration)
(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
("message/partial" mm-inline-partial identity)
("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
+ ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+ ("application/zip" mm-archive-dissect-and-inline identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(and (or (featurep 'nas-sound) (featurep 'native-sound))
(ignore-errors
(if (fboundp 'create-image)
(create-image (buffer-string) 'imagemagick 'data-p)
- (mm-create-image-xemacs (mm-handle-media-subtype handle))))))
+ (mm-create-image-xemacs
+ (mm-handle-media-subtype handle))))))
(when image
(setcar (cdr handle) (list "image/imagemagick"))
(mm-image-fit-p handle)))))))
"application/pgp-signature" "application/x-pkcs7-signature"
"application/pkcs7-signature" "application/x-pkcs7-mime"
"application/pkcs7-mime"
+ "application/x-gtar-compressed"
+ "application/x-tar"
+ "application/zip"
;; Mutt still uses this even though it has already been withdrawn.
"application/pgp")
"List of media types that are to be displayed inline.
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
(defvar mm-postponed-undisplay-list nil)
+(defvar mm-inhibit-auto-detect-attachment nil)
;; According to RFC2046, in particular, in a digest, the default
;; Content-Type value for a body part is changed from "text/plain" to
(autoload 'message-fetch-field "message")
(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
- "Dissect the current buffer and return a list of MIME handles."
+ "Dissect the current buffer and return a list of MIME handles.
+If NO-STRICT-MIME, don't require the message to have a
+MIME-Version header before proceeding."
(save-excursion
(let (ct ctl type subtype cte cd description id result)
(save-restriction
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+ ;; Guess what the type of application/octet-stream parts should
+ ;; really be.
+ (let ((filename (cdr (assq 'filename (cdr cdl)))))
+ (when (and (not mm-inhibit-auto-detect-attachment)
+ (equal (car ctl) "application/octet-stream")
+ filename
+ (string-match "\\.\\([^.]+\\)$" filename))
+ (let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+ (when new-type
+ (setcar ctl new-type)))))
+ (let ((handle
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+ (decoder (assoc (car ctl) (mm-archive-decoders))))
+ (if (and decoder
+ ;; Do automatic decoding
+ (cadr decoder)
+ (executable-find (caddr decoder)))
+ (mm-dissect-archive handle)
+ handle))))
(defun mm-dissect-multipart (ctl from)
(goto-char (point-min))
(goto-char (point-max))
(if (re-search-backward close-delimiter nil t)
(match-beginning 0)
- (point-max)))))
+ (point-max))))
+ (mm-inhibit-auto-detect-attachment
+ (equal (car ctl) "multipart/encrypted")))
(setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
(while (and (< (point) end) (re-search-forward boundary end t))
(goto-char (match-beginning 0))
(mail-content-type-get
(mm-handle-type handle) 'name)
"<file>"))
- (external mm-enable-external))
- (if (and (mm-inlinable-p ehandle)
- (mm-inlined-p ehandle))
- (progn
- (forward-line 1)
- (mm-display-inline handle)
- 'inline)
- (when (or method
- (not no-default))
- (if (and (not method)
- (equal "text" (car (split-string type "/"))))
- (progn
- (forward-line 1)
- (mm-insert-inline handle (mm-get-part handle))
- 'inline)
- (setq external
- (and method ;; If nil, we always use "save".
+ (external mm-enable-external)
+ (decoder (assoc (car (mm-handle-type handle))
+ (mm-archive-decoders))))
+ (cond
+ ((and decoder
+ (executable-find (caddr decoder)))
+ (mm-archive-dissect-and-inline handle)
+ 'inline)
+ ((and (mm-inlinable-p ehandle)
+ (mm-inlined-p ehandle))
+ (forward-line 1)
+ (mm-display-inline handle)
+ 'inline)
+ ((or method
+ (not no-default))
+ (if (and (not method)
+ (equal "text" (car (split-string type "/"))))
+ (progn
+ (forward-line 1)
+ (mm-insert-inline handle (mm-get-part handle))
+ 'inline)
+ (setq external
+ (and method ;; If nil, we always use "save".
(stringp method) ;; 'mailcap-save-binary-file
(or (eq mm-enable-external t)
(and (eq mm-enable-external 'ask)
(concat
" \"" (format method filename) "\"")
"")
- "? "))))))
- (if external
- (mm-display-external
- handle (or method 'mailcap-save-binary-file))
+ "? "))))))
+ (if external
(mm-display-external
- handle 'mailcap-save-binary-file)))))))))
+ handle (or method 'mailcap-save-binary-file))
+ (mm-display-external
+ handle 'mailcap-save-binary-file)))))))))
(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
(defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads
shell-command-switch command)
(set-process-sentinel
(get-buffer-process buffer)
- (lexical-let ;; Don't use `let'.
- ;; Function used to remove temp file and directory.
- ((fn `(lambda nil
- ;; Don't use `ignore-errors'.
- (condition-case nil
- (delete-file ,file)
- (error))
- (condition-case nil
- (delete-directory
- ,(file-name-directory file))
- (error))))
- ;; Form uses to kill the process buffer and
- ;; remove the undisplayer.
- (fm `(progn
- (kill-buffer ,buffer)
- ,(macroexpand
- (list 'mm-handle-set-undisplayer
- (list 'quote handle)
- nil))))
- ;; Message to be issued when the process exits.
- (done (format "Displaying %s...done" command))
- ;; In particular, the timer object (which is
- ;; a vector in Emacs but is a list in XEmacs)
- ;; requires that it is lexically scoped.
- (timer (run-at-time 30.0 nil 'ignore)))
- (if (featurep 'xemacs)
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer itimer-list)
- (set-itimer-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer timer-list)
- (timer-set-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))))))
+ (lexical-let ((outbuf outbuf)
+ (file file)
+ (buffer buffer)
+ (command command)
+ (handle handle))
+ (run-at-time
+ 30.0 nil
+ (lambda ()
+ (ignore-errors
+ (delete-file file))
+ (ignore-errors
+ (delete-directory (file-name-directory file)))))
+ (lambda (process state)
+ (when (eq (process-status process) 'exit)
+ (condition-case nil
+ (delete-file file)
+ (error))
+ (condition-case nil
+ (delete-directory (file-name-directory file))
+ (error))
+ (when (buffer-live-p outbuf)
+ (with-current-buffer outbuf
+ (let ((buffer-read-only nil)
+ (point (point)))
+ (forward-line 2)
+ (mm-insert-inline
+ handle (with-current-buffer buffer
+ (buffer-string)))
+ (goto-char point))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer)))
+ (message "Displaying %s...done" command)))))
(mm-handle-set-external-undisplayer
handle (cons file buffer)))
(message "Displaying %s..." command))
(while (search-forward "" nil t)
(replace-match "" t t))
(libxml-parse-html-region (point-min) (point-max))))
+ (unless (bobp)
+ (insert "\n"))
(mm-handle-set-undisplayer
handle
`(lambda ()
(provide 'mm-decode)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
;;; mm-decode.el ends here
(unless filename
(setq filename buffer-file-name))
(save-excursion
- (let ((decomp (unless ;; No worth to examine charset of tar files.
+ (let ((decomp (unless ;; Not worth it to examine charset of tar files.
(and filename
(string-match
"\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'"
(defvar mml-multipart-number 0)
(defvar mml-inhibit-compute-boundary nil)
-(defun mml-generate-mime ()
- "Generate a MIME message based on the current MML document."
+(defun mml-generate-mime (&optional multipart-type)
+ "Generate a MIME message based on the current MML document.
+MULTIPART-TYPE defaults to \"mixed\", but can also
+be \"related\" or \"alternate\"."
(let ((cont (mml-parse))
(mml-multipart-number mml-multipart-number)
(options message-options))
(if (and (consp (car cont))
(= (length cont) 1))
(mml-generate-mime-1 (car cont))
- (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
- cont)))
+ (mml-generate-mime-1
+ (nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
+ cont)))
(setq options message-options)
(buffer-string))
(setq message-options options)))))
;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Author: Simon Josefsson <simon@josefsson.org>
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
;; Scott Byer <byer@mv.us.adobe.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
"The name of the nnfolder NOV directory.
If nil, `nnfolder-directory' is used.")
-(defvoo nnfolder-marks-directory nil
- "The name of the nnfolder MARKS directory.
-If nil, `nnfolder-directory' is used.")
-
(defvoo nnfolder-active-file
(nnheader-concat nnfolder-directory "active")
"The name of the active file.")
(defvar nnfolder-nov-buffer-file-name nil)
-(defvoo nnfolder-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail groups.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set
-this to t, and want to set it to nil again, you should always remove
-the corresponding marks file (usually base nnfolder file name
-concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group. Then the marks file will be regenerated properly by Gnus.")
-
-(defvoo nnfolder-marks nil)
-
-(defvoo nnfolder-marks-file-suffix ".mrk")
-
-(defvar nnfolder-marks-modtime (gnus-make-hashtable))
-
\f
;;; Interface functions
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
(and nnfolder-nov-directory
(gnus-make-directory nnfolder-nov-directory)))
- (unless nnfolder-marks-is-evil
- (and nnfolder-marks-directory
- (gnus-make-directory nnfolder-marks-directory)))
(cond
((not (file-exists-p nnfolder-directory))
(nnfolder-close-server)
() ; Don't delete the articles.
;; Delete the file that holds the group.
(let ((data (nnfolder-group-pathname group))
- (nov (nnfolder-group-nov-pathname group))
- (mrk (nnfolder-group-marks-pathname group)))
+ (nov (nnfolder-group-nov-pathname group)))
(ignore-errors (delete-file data))
- (ignore-errors (delete-file nov))
- (ignore-errors (delete-file mrk))))
+ (ignore-errors (delete-file nov))))
;; Remove the group from all structures.
(setq nnfolder-group-alist
(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
(when (file-exists-p (nnfolder-group-nov-pathname group))
(setq new-file (nnfolder-group-nov-pathname new-name))
(gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-nov-pathname group) new-file))
- (when (file-exists-p (nnfolder-group-marks-pathname group))
- (setq new-file (nnfolder-group-marks-pathname new-name))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-marks-pathname group) new-file)))
+ (rename-file (nnfolder-group-nov-pathname group) new-file)))
t)
;; That went ok, so we change the internal structures.
(let ((entry (assoc group nnfolder-group-alist)))
(defun nnfolder-save-buffer ()
"Save the buffer."
- (when (buffer-modified-p)
- (run-hooks 'nnfolder-save-buffer-hook)
- (gnus-make-directory (file-name-directory (buffer-file-name)))
- (let ((coding-system-for-write
- (or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system)))
- (set (make-local-variable 'copyright-update) nil)
- (save-buffer)))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-save-nov)))
+ (let ((delete-old-versions t))
+ (when (buffer-modified-p)
+ (run-hooks 'nnfolder-save-buffer-hook)
+ (gnus-make-directory (file-name-directory (buffer-file-name)))
+ (let ((coding-system-for-write
+ (or nnfolder-file-coding-system-for-write
+ nnfolder-file-coding-system)))
+ (set (make-local-variable 'copyright-update) nil)
+ (save-buffer)))
+ (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
+ (nnfolder-save-nov))))
(defun nnfolder-save-active (group-alist active-file)
(let ((nnmail-active-file-coding-system
(mail-header-set-number headers article)
(nnheader-insert-nov headers)))
-(deffoo nnfolder-request-set-mark (group actions &optional server)
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (unless nnfolder-marks-is-evil
- (nnfolder-open-marks group server)
- (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions))
- (nnfolder-save-marks group server))
- nil)
-
-(deffoo nnfolder-request-marks (group info &optional server)
- ;; Change servers.
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnfolder-open-marks group server)
- ;; Update info using `nnfolder-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnfolder-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnfolder-group-marks-pathname (group)
- "Make pathname for GROUP NOV."
- (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
- (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
-
-(defun nnfolder-marks-changed-p (group)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (null (gnus-gethash file nnfolder-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnfolder-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnfolder-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnfolder-group-marks-pathname group)))
- (condition-case err
- (progn
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnfolder-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnfolder-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnfolder-open-marks (group server)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnfolder-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnfolder-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnfolder marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nnfolder:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
- (setq nnfolder-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnfolder-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
- (nnfolder-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
(provide 'nnfolder)
;;; nnfolder.el ends here
(defvoo nnimap-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
+If t, Gnus 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.")
(autoload 'gnus-add-buffer "gnus")
(autoload 'gnus-kill-buffer "gnus")
+(eval-when-compile
+ (autoload 'mail-send-and-exit "sendmail" nil t))
(defgroup nnmail nil
"Reading mail with Gnus."
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers '(To Newsgroups)
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
"Extra headers to parse.
In addition to the standard headers, these extra headers will be
included in NOV headers (and the like) when backends parse headers."
- :version "21.1"
+ :version "24.2"
:group 'nnmail
:type '(repeat symbol))
;; Foundation, Inc.
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
-;; Simon Josefsson <simon@josefsson.org> (adding MARKS)
+;; Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
through all nnml directories and generate nov databases for them
all. This may very well take some time.")
-(defvoo nnml-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group. Then the
-marks file will be regenerated properly by Gnus.")
-
(defvoo nnml-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
"nnml version.")
(defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
(defvoo nnml-current-directory nil)
(defvoo nnml-current-group nil)
(defvoo nnml-file-coding-system nnmail-file-coding-system)
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
\f
;;; Interface functions.
nnml-current-directory t
(concat
nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$"
- "\\|" (regexp-quote nnml-marks-file-name) "$")))
+ "\\|" (regexp-quote nnml-nov-file-name) "$")))
(decoded (nnml-decoded-group-name group server)))
(dolist (article articles)
(when (file-writable-p article)
(let ((overview (concat old-dir nnml-nov-file-name)))
(when (file-exists-p overview)
(rename-file overview (concat new-dir nnml-nov-file-name))))
- ;; Move .marks file.
- (let ((marks (concat old-dir nnml-marks-file-name)))
- (when (file-exists-p marks)
- (rename-file marks (concat new-dir nnml-marks-file-name))))
(when (<= (length (directory-files old-dir)) 2)
(ignore-errors (delete-directory old-dir)))
;; That went ok, so we change the internal structures.
(forward-line 1))
alist))))
-(deffoo nnml-request-set-mark (group actions &optional server)
- (nnml-possibly-change-directory group server)
- (unless nnml-marks-is-evil
- (nnml-open-marks group server)
- (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions))
- (nnml-save-marks group server))
- nil)
-
-(deffoo nnml-request-marks (group info &optional server)
- (nnml-possibly-change-directory group server)
- (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnml-open-marks group server)
- ;; Update info using `nnml-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnml-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnml-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnml-marks-changed-p (group server)
- (let ((file (nnml-group-pathname group nnml-marks-file-name server)))
- (if (null (gnus-gethash file nnml-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnml-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnml-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnml-group-pathname group nnml-marks-file-name server)))
- (condition-case err
- (progn
- (nnml-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnml-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnml-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnml-open-marks (group server)
- (let* ((decoded (nnml-decoded-group-name group server))
- (file (nnmail-group-pathname decoded nnml-directory
- nnml-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnml-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnml-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnml marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method
- (format "nnml:%s" (or server "")))))))
- (setq decoded (if (member server '(nil ""))
- (concat "nnml:" decoded)
- (format "nnml+%s:%s" server decoded)))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded)
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" decoded)))))
-
-
;;;
;;; Group and server compaction. -- dvl
;;;
(gnus-set-active group-full-name active))
;; 1 bis/
;; #### NOTE: normally, we should save the overview (NOV) file
- ;; #### here, just like we save the marks file. However, there is no
- ;; #### such function as nnml-save-nov for a single group. Only for
- ;; #### all groups. Gnus inconsistency is getting worse every day...
- ;; 2/ Rebuild marks file:
- (unless nnml-marks-is-evil
- ;; #### NOTE: this constant use of global variables everywhere is
- ;; #### truly disgusting. Gnus really needs a *major* cleanup.
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server))
- ;; 3/ Save everything if this was not part of a bigger operation:
+ ;; #### here. However, there is no such function as
+ ;; #### nnml-save-nov for a single group. Only for all
+ ;; #### groups. Gnus inconsistency is getting worse every
+ ;; #### day... ;; 3/ Save everything if this was not part of
+ ;; #### a bigger operation:
(if (not save)
;; Nothing to save (yet):
t
(nnml-save-nov)
;; b/ Save the active file:
(nnmail-save-active nnml-group-alist nnml-active-file)
- (let ((marks (nnml-group-pathname group nnml-marks-file-name server)))
- (when (file-exists-p marks)
- (delete-file marks)))
t)))))
(defun nnml-request-compact (&optional server)
server there that you can connect to. See also
`nntp-open-connection-function'")
-(defvoo nntp-coding-system-for-read 'binary
- "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
- "*Coding system to write to NNTP.")
-
-;; Marks
-(defvoo nntp-marks-is-evil nil
- "*If non-nil, Gnus will never generate and use marks file for nntp groups.
-See `nnml-marks-is-evil' for more information.")
-
-(defvoo nntp-marks-file-name ".marks")
-(defvoo nntp-marks nil)
-(defvar nntp-marks-modtime (gnus-make-hashtable))
-
-(defcustom nntp-marks-directory
- (nnheader-concat gnus-directory "marks/")
- "*The directory where marks for nntp groups will be stored."
- :group 'nntp
- :type 'directory)
-
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
:group 'nntp
(progn
(nntp-copy-to-buffer nntp-server-buffer
(point-min) (point-max))
- (gnus-groups-to-gnus-format method gnus-active-hashtb t))
+ (with-current-buffer nntp-server-buffer
+ (gnus-groups-to-gnus-format method gnus-active-hashtb t)))
;; We have read active entries, so we just delete the
;; superfluous gunk.
(goto-char (point-min))
(deffoo nntp-asynchronous-p ()
t)
-(deffoo nntp-request-set-mark (group actions &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (nntp-open-marks group server)
- (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions))
- (nntp-save-marks group server))
- nil)
-
-(deffoo nntp-request-marks (group info &optional server)
- (when (and (not nntp-marks-is-evil)
- nntp-marks-file-name)
- (nntp-possibly-create-directory group server)
- (when (nntp-marks-changed-p group server)
- (nnheader-message 8 "Updating marks for %s..." group)
- (nntp-open-marks group server)
- ;; Update info using `nntp-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nntp-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nntp-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group)))
- nil)
-
-
;;; Hooky functions.
(nntp-kill-buffer ,pbuffer)))))
(process
(condition-case err
- (let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
(map '((nntp-open-network-stream network)
(network-only plain) ; compat
(nntp-open-plain-stream plain)
(delete-region (point) (point-max)))
proc)))
-;; Marks handling
-
-(defun nntp-marks-directory (server)
- (expand-file-name server nntp-marks-directory))
-
-(defvar nntp-server-to-method-cache nil
- "Alist of servers and select methods.")
-
-(defun nntp-group-pathname (server group &optional file)
- "Return an absolute file name of FILE for GROUP on SERVER."
- (let ((method (cdr (assoc server nntp-server-to-method-cache))))
- (unless method
- (push (cons server (setq method (or (gnus-server-to-method server)
- (gnus-find-method-for-group group))))
- nntp-server-to-method-cache))
- (nnmail-group-pathname
- (mm-decode-coding-string group
- (inline (gnus-group-name-charset method group)))
- (nntp-marks-directory server)
- file)))
-
-(defun nntp-possibly-create-directory (group server)
- (let ((dir (nntp-group-pathname server group))
- (file-name-coding-system nnmail-pathname-coding-system))
- (unless (file-exists-p dir)
- (make-directory (directory-file-name dir) t)
- (nnheader-message 5 "Creating nntp marks directory %s" dir))))
-
-(autoload 'time-less-p "time-date")
-
-(defun nntp-marks-changed-p (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (null (gnus-gethash file nntp-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (time-less-p (gnus-gethash file nntp-marks-modtime)
- (nth 5 (file-attributes file))))))
-
-(defun nntp-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nntp-group-pathname server group nntp-marks-file-name)))
- (condition-case err
- (progn
- (nntp-possibly-create-directory group server)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nntp-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nntp-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nntp-open-marks (group server)
- (let ((file (nntp-group-pathname server group nntp-marks-file-name))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nntp-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nntp-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nntp marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nntp:%s" server)))))
- (decoded-name (mm-decode-coding-string
- group
- (gnus-group-name-charset
- (gnus-server-to-method server) group))))
- (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name)
- (setq nntp-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nntp-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nntp-marks (gnus-remassoc el nntp-marks)))
- (nntp-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done"
- decoded-name)))))
-
(provide 'nntp)
;;; nntp.el ends here
(unless (memq (process-status process) '(open run))
(error "pop3 process died"))
(when total-size
- (message "pop3 retrieved %dKB (%d%%)"
- (truncate (/ (buffer-size) 1000))
- (truncate (* (/ (* (buffer-size) 1.0)
- total-size) 100))))
+ (let ((size 0))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK.*\n" nil t)
+ (setq size (+ size (- (point))
+ (if (re-search-forward "^\\.\r?\n" nil 'move)
+ (match-beginning 0)
+ (point)))))
+ (message "pop3 retrieved %dKB (%d%%)"
+ (truncate (/ size 1000))
+ (truncate (* (/ (* size 1.0) total-size) 100)))))
(pop3-accept-process-output process))
start-point)
(eval-when-compile (require 'cl))
-(eval-when-compile
- (when (null (ignore-errors (require 'ert)))
- (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
-
-(ignore-errors
- (require 'ert))
(eval-and-compile
(or (ignore-errors (progn
(require 'eieio)
collect k)))
(list limit candidates))))
-(ert-deftest registry-instantiation-test ()
- (should (registry-db "Testing")))
-
-(ert-deftest registry-match-test ()
- (let ((entry '((hello "goodbye" "bye") (blank))))
-
- (message "Testing :regex matching")
- (should (registry--match :regex entry '((hello "nye" "bye"))))
- (should (registry--match :regex entry '((hello "good"))))
- (should-not (registry--match :regex entry '((hello "nye"))))
- (should-not (registry--match :regex entry '((hello))))
-
- (message "Testing :member matching")
- (should (registry--match :member entry '((hello "bye"))))
- (should (registry--match :member entry '((hello "goodbye"))))
- (should-not (registry--match :member entry '((hello "good"))))
- (should-not (registry--match :member entry '((hello "nye"))))
- (should-not (registry--match :member entry '((hello)))))
- (message "Done with matching testing."))
-
-(defun registry-make-testable-db (n &optional name file)
- (let* ((db (registry-db
- (or name "Testing")
- :file (or file "unused")
- :max-hard n
- :max-soft 0 ; keep nothing not precious
- :precious '(extra more-extra)
- :tracked '(sender subject groups))))
- (dotimes (i n)
- (registry-insert db i `((sender "me")
- (subject "about you")
- (more-extra) ; empty data key should be pruned
- ;; first 5 entries will NOT have this extra data
- ,@(when (< 5 i) (list (list 'extra "more data")))
- (groups ,(number-to-string i)))))
- db))
-
-(ert-deftest registry-usage-test ()
- (let* ((n 100)
- (db (registry-make-testable-db n)))
- (message "size %d" n)
- (should (= n (registry-size db)))
- (message "max-hard test")
- (should-error (registry-insert db "new" '()))
- (message "Individual lookup")
- (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
- (message "Grouped individual lookup")
- (should (= 3 (length (registry-lookup db '(1 58 99)))))
- (when (boundp 'lexical-binding)
- (message "Individual lookup (breaks before lexbind)")
- (should (= 58
- (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
- (message "Grouped individual lookup (breaks before lexbind)")
- (should (= 3
- (length (registry-lookup-breaks-before-lexbind db
- '(1 58 99))))))
- (message "Search")
- (should (= n (length (registry-search db :all t))))
- (should (= n (length (registry-search db :member '((sender "me"))))))
- (message "Secondary index search")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
- (message "Delete")
- (should (registry-delete db '(1) t))
- (decf n)
- (message "Search after delete")
- (should (= n (length (registry-search db :all t))))
- (message "Secondary search after delete")
- (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
- ;; (message "Pruning")
- ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
- ;; (count (- n (length tokeep)))
- ;; (pruned (registry-prune db))
- ;; (prune-count (length pruned)))
- ;; (message "Expecting to prune %d entries and pruned %d"
- ;; count prune-count)
- ;; (should (and (= count 5)
- ;; (= count prune-count))))
- (message "Done with usage testing.")))
-
-(ert-deftest registry-persistence-test ()
- (let* ((n 100)
- (tempfile (make-temp-file "registry-persistence-"))
- (name "persistence tester")
- (db (registry-make-testable-db n name tempfile))
- size back)
- (message "Saving to %s" tempfile)
- (eieio-persistent-save db)
- (setq size (nth 7 (file-attributes tempfile)))
- (message "Saved to %s: size %d" tempfile size)
- (should (< 0 size))
- (with-temp-buffer
- (insert-file-contents-literally tempfile)
- (should (looking-at (concat ";; Object "
- name
- "\n;; EIEIO PERSISTENT OBJECT"))))
- (message "Reading object back")
- (setq back (eieio-persistent-read tempfile))
- (should back)
- (message "Read object back: %d keys, expected %d==%d"
- (registry-size back) n (registry-size db))
- (should (= (registry-size back) n))
- (should (= (registry-size back) (registry-size db)))
- (delete-file tempfile))
- (message "Done with persistence testing."))
-
(provide 'registry)
;;; registry.el ends here
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
(define-key map "i" 'shr-browse-image)
+ (define-key map "z" 'shr-zoom-image)
(define-key map "I" 'shr-insert-image)
(define-key map "u" 'shr-copy-url)
(define-key map "v" 'shr-browse-url)
(list (current-buffer) (1- (point)) (point-marker))
t t))))
+(defun shr-zoom-image ()
+ "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+ (interactive)
+ (let ((url (get-text-property (point) 'image-url))
+ (size (get-text-property (point) 'image-size))
+ (buffer-read-only nil))
+ (if (not url)
+ (message "No image under point")
+ ;; Delete the old picture.
+ (while (get-text-property (point) 'image-url)
+ (forward-char -1))
+ (forward-char 1)
+ (let ((start (point)))
+ (while (get-text-property (point) 'image-url)
+ (forward-char 1))
+ (forward-char -1)
+ (put-text-property start (point) 'display nil)
+ (when (> (- (point) start) 2)
+ (delete-region start (1- (point)))))
+ (message "Inserting %s..." url)
+ (url-retrieve url 'shr-image-fetched
+ (list (current-buffer) (1- (point)) (point-marker)
+ (list (cons 'size
+ (cond ((or (eq size 'default)
+ (null size))
+ 'original)
+ ((eq size 'original)
+ 'full)
+ ((eq size 'full)
+ 'default)))))
+ t))))
+
;;; Utility functions.
(defun shr-transform-dom (dom)
(defun shr-insert (text)
(when (and (eq shr-state 'image)
+ (not (bolp))
(not (string-match "\\`[ \t\n]+\\'" text)))
(insert "\n")
(setq shr-state nil))
((eq shr-folding-mode 'none)
(insert text))
(t
- (when (and (string-match "\\`[ \t\n]" text)
+ (when (and (string-match "\\`[ \t\n ]" text)
(not (bolp))
(not (eq (char-after (1- (point))) ? )))
(insert " "))
- (dolist (elem (split-string text))
+ (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
(when (and (bolp)
(> shr-indentation 0))
(shr-indent))
(shr-indent))
(end-of-line))
(insert " ")))
- (unless (string-match "[ \t\n]\\'" text)
+ (unless (string-match "[ \t\n ]\\'" text)
(delete-char -1)))))
(defun shr-find-fill-point ()
(shr-char-kinsoku-eol-p (following-char)))))
(goto-char bp)))
((shr-char-kinsoku-eol-p (preceding-char))
- (if (shr-char-kinsoku-eol-p (following-char))
- ;; There are consecutive kinsoku-eol characters.
- (setq failed t)
- (let ((count 4))
- (while
- (progn
- (backward-char 1)
- (and (> (setq count (1- count)) 0)
- (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (or (shr-char-kinsoku-eol-p (preceding-char))
- (shr-char-kinsoku-bol-p (following-char)))))))
- (if (setq failed (= (current-column) shr-indentation))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1)))))
- (t
- (if (shr-char-kinsoku-bol-p (preceding-char))
- ;; There are consecutive kinsoku-bol characters.
- (setq failed t)
- (let ((count 4))
- (while (and (>= (setq count (1- count)) 0)
+ ;; Find backward the point where kinsoku-eol characters begin.
+ (let ((count 4))
+ (while
+ (progn
+ (backward-char 1)
+ (and (> (setq count (1- count)) 0)
+ (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+ (or (shr-char-kinsoku-eol-p (preceding-char))
+ (shr-char-kinsoku-bol-p (following-char)))))))
+ (if (setq failed (= (current-column) shr-indentation))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
+ ((shr-char-kinsoku-bol-p (following-char))
+ ;; Find forward the point where kinsoku-bol characters end.
+ (let ((count 4))
+ (while (progn
+ (forward-char 1)
+ (and (>= (setq count (1- count)) 0)
(shr-char-kinsoku-bol-p (following-char))
- (shr-char-breakable-p (following-char)))
- (forward-char 1))))))
+ (shr-char-breakable-p (following-char))))))))
(when (eq (following-char) ? )
(forward-char 1))))
(not failed)))
(if (save-excursion
(beginning-of-line)
(looking-at " *$"))
- (insert "\n")
+ (delete-region (match-beginning 0) (match-end 0))
(insert "\n\n")))))
(defun shr-indent ()
(expand-file-name (file-name-nondirectory url)
directory)))))
-(defun shr-image-fetched (status buffer start end)
+(defun shr-image-fetched (status buffer start end &optional flags)
(let ((image-buffer (current-buffer)))
(when (and (buffer-name buffer)
(not (plist-get status :error)))
(with-current-buffer buffer
(save-excursion
(let ((alt (buffer-substring start end))
+ (properties (text-properties-at start))
(inhibit-read-only t))
(delete-region start end)
(goto-char start)
- (funcall shr-put-image-function data alt)))))))
+ (funcall shr-put-image-function data alt flags)
+ (while properties
+ (let ((type (pop properties))
+ (value (pop properties)))
+ (unless (memq type '(display image-size))
+ (put-text-property start (point) type value))))))))))
(kill-buffer image-buffer)))
-(defun shr-put-image (data alt)
+(defun shr-put-image (data alt &optional flags)
"Put image DATA with a string ALT. Return image."
(if (display-graphic-p)
- (let ((image (ignore-errors
- (shr-rescale-image data))))
+ (let* ((size (cdr (assq 'size flags)))
+ (start (point))
+ (image (cond
+ ((eq size 'original)
+ (create-image data nil t :ascent 100))
+ ((eq size 'full)
+ (ignore-errors
+ (shr-rescale-image data t)))
+ (t
+ (ignore-errors
+ (shr-rescale-image data))))))
(when image
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
(when (and (> (current-column) 0)
(> (car (image-size image t)) 400))
(insert "\n"))
- (insert-image image (or alt "*"))
+ (if (eq size 'original)
+ (let ((overlays (overlays-at (point))))
+ (insert-sliced-image image (or alt "*") nil 20 1)
+ (dolist (overlay overlays)
+ (overlay-put overlay 'face 'default)))
+ (insert-image image (or alt "*")))
+ (put-text-property start (point) 'image-size size)
(when (image-animated-p image)
(image-animate image nil 60)))
image)
(insert alt)))
-(defun shr-rescale-image (data)
+(defun shr-rescale-image (data &optional force)
+ "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
(let ((image (create-image data nil t :ascent 100)))
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
(window-height (truncate (* shr-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))
scaled-image)
- (when (> height window-height)
+ (when (or force
+ (> height window-height))
(setq image (or (create-image data 'imagemagick t
:height window-height
:ascent 100)
(shr-generic cont)))
(defun shr-tag-br (cont)
- (unless (bobp)
+ (when (and (not (bobp))
+ ;; Only add a newline if we break the current line, or
+ ;; the previous line isn't a blank line.
+ (or (not (bolp))
+ (and (> (- (point) 2) (point-min))
+ (not (= (char-after (- (point) 2)) ?\n)))))
(insert "\n")
(shr-indent))
(shr-generic cont))
;; all this is done inside a condition-case to trap errors
-(eval-when-compile
- (autoload 'bbdb-buffer "bbdb")
- (autoload 'bbdb-create-internal "bbdb")
- (autoload 'bbdb-search-simple "bbdb"))
-
;; Autoloaded in message, which we require.
(declare-function gnus-extract-address-components "gnus-util" (from))
(file-error
;; `bbdb-records' should not be bound as an autoload function
;; before loading bbdb because of `bbdb-hashtable-size'.
+ (defalias 'bbdb-buffer 'ignore)
+ (defalias 'bbdb-create-internal 'ignore)
(defalias 'bbdb-records 'ignore)
(defalias 'spam-BBDB-register-routine 'ignore)
(defalias 'spam-enter-ham-BBDB 'ignore)
+ (defalias 'spam-exists-in-BBDB-p 'ignore)
+ (defalias 'bbdb-gethash 'ignore)
nil))
;; when the BBDB changes, we want to clear out our cache
'ignore))
(net-address (nth 1 parsed-address))
(record (and net-address
- (bbdb-search-simple nil net-address))))
+ (spam-exists-in-BBDB-p net-address))))
(when net-address
(gnus-message 6 "%s address %s %s BBDB"
(if remove "Deleting" "Adding")
(defun spam-BBDB-unregister-routine (articles)
(spam-BBDB-register-routine articles t))
+ (defsubst spam-exists-in-BBDB-p (net)
+ (when (and (stringp net) (not (zerop (length net))))
+ (bbdb-records)
+ (bbdb-gethash (downcase net))))
+
(defun spam-check-BBDB ()
"Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (message-fetch-field "from")))
- (when who
- (setq who (nth 1 (gnus-extract-address-components who)))
- (if
- (if (fboundp 'bbdb-search)
- (bbdb-search (bbdb-records) who) ;; v3
- (bbdb-search-simple nil who)) ;; v2
+ (let ((net (message-fetch-field "from")))
+ (when net
+ (setq net (nth 1 (gnus-extract-address-components net)))
+ (if (spam-exists-in-BBDB-p net)
t
(if spam-use-BBDB-exclusive
spam-split-group