# HG changeset patch # User Miles Bader # Date 1193563119 0 # Node ID a3c27999decb8ffd71a89e4c65733d4282ba8dfa # Parent b6f5dc84b2e1743f7508c8d4490a641e5b37bb93 Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Revision: emacs@sv.gnu.org/emacs--devo--0--patch-911 diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/ChangeLog --- a/doc/misc/ChangeLog Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/ChangeLog Sun Oct 28 09:18:39 2007 +0000 @@ -1,3 +1,456 @@ +2007-10-28 Miles Bader + + * gnus-news.texi, gnus-coding.texi, sasl.texi: New files. + +2007-10-28 Emanuele Giaquinta (tiny change) + + * gnus-faq.texi ([5.12]): Remove reference to discontinued service. + +2007-10-28 Reiner Steib + + * gnus.texi (Sorting the Summary Buffer): Remove + gnus-article-sort-by-date-reverse. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Non-ASCII Group Names): New node. + (Misc Group Stuff): Move gnus-group-name-charset-method-alist and + gnus-group-name-charset-group-alist to Non-ASCII Group Names node. + +2007-10-28 Micha,Ak(Bl Cadilhac + + * gnus.texi (Mail Source Specifiers, IMAP): Add a notice on the need to + clean the output of the program `imap-shell-program'. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (IMAP): Mention nnimap-logout-timeout. + +2007-10-28 Tassilo Horn + + * gnus.texi (Sticky Articles): Documentation for sticky article + buffers. + +2007-10-28 Micha,Ak(Bl Cadilhac + + * gnus.texi (RSS): Document nnrss-ignore-article-fields. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Various Various): Mention gnus-add-timestamp-to-message. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Archived Messages): Document + gnus-update-message-archive-method. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Limiting): Document gnus-summary-limit-to-address. + +2007-10-28 Micha,Ak(Bl Cadilhac + + * gnus.texi (Group Maneuvering): Document + `gnus-summary-next-group-on-exit'. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Really Various Summary Commands): Mention + gnus-auto-select-on-ephemeral-exit. + +2007-10-28 Reiner Steib + + * gnus.texi, message.texi: Bump version number. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Group Line Specification, Misc Group Stuff) + (Server Commands): Parenthesize @pxref{Mail Spool}. + +2007-10-28 Didier Verna + + New user option: message-signature-directory. + * message.texi (Insertion Variables): Document it. + * gnus.texi (Posting Styles): Ditto. + +2007-10-28 Didier Verna + + * gnus.texi (Group Line Specification): + * gnus.texi (Misc Group Stuff): + * gnus.texi (Server Commands): Document the group compaction feature. + +2007-10-28 Reiner Steib + + * gnus-faq.texi ([5.2]): Adjust for message-fill-column. + + * message.texi (Various Message Variables): Add message-fill-column. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi: Untabify. + +2007-10-28 Didier Verna + + * gnus.texi (Group Parameters): Document the posting-style merging + process in topic-mode. + +2007-10-28 Reiner Steib + + * gnus.texi (Scoring On Other Headers): Add gnus-inhibit-slow-scoring. + +2007-10-28 Romain Francoise + + * gnus.texi (Mail Spool): Fix typo. + Update copyright. + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Limiting): Add gnus-summary-limit-to-singletons. + +2007-10-28 Andreas Seltenreich + + * gnus.texi (Summary Generation Commands): + Add gnus-summary-insert-ticked-articles. + +2007-10-28 Reiner Steib + + * gnus.texi + (SpamAssassin back end): Rename spam-spamassassin-path to + spam-spamassassin-program. + +2007-10-28 Reiner Steib + + * gnus.texi (Mail and Post): Add gnus-message-highlight-citation. + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Limiting): Add gnus-summary-limit-to-headers. + +2007-10-28 Lars Magne Ingebrigtsen + + * message.texi (Mail Headers): Document `opportunistic'. + +2007-10-28 Reiner Steib + + * emacs-mime.texi (Encoding Customization): Explain how to set + mm-coding-system-priorities per hierarchy. + +2007-10-28 Reiner Steib + + * gnus.texi (Washing Mail): Add nnmail-ignore-broken-references and + nnmail-broken-references-mailers instead of nnmail-fix-eudora-headers. + +2007-10-28 Didier Verna + + * message.texi (Wide Reply): Update documentation of + message-dont-reply-to-names (now allowing a list of regexps). + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Spam Package Introduction): Fix spam menu and links. + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (SpamAssassin back end): Fix typo. + + * sieve.texi (Examples): Fix grammar. + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Searching for Articles): Document M-S and M-R. + (Limiting): Document / b. + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Thread Commands): T M-^. + +2007-10-28 Lars Magne Ingebrigtsen + + * message.texi (Mail Aliases): Document ecomplete. + (Mail Aliases): Fix typo. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Face): Restore xref to gnus-face-properties-alist; + fix typo. + +2007-10-28 Romain Francoise + + * gnus.texi (Mail Spool): Grammar fix. + +2007-10-28 Reiner Steib + + * gnus.texi (Mail Spool): nnml-use-compressed-files can be a + string. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Group Parameters): Fix description. + +2007-10-28 Reiner Steib + + * gnus.texi (Gmane Spam Reporting): Fix + spam-report-gmane-use-article-number. Add + spam-report-user-mail-address. + +2007-10-28 Katsumi Yamaoka + + * emacs-mime.texi (Non-MIME): x-gnus-verbatim -> x-verbatim. + +2007-10-28 Reiner Steib + + * gnus.texi (Group Parameters): Add simplified sorting example based on + example for `Sorting the Summary Buffer' from Jari Aalto + . + (Example Methods): Add example for an indirect connection. + +2007-10-28 Kevin Greiner + + * gnus.texi (nntp-open-via-telnet-and-telnet): Fixed grammar. + (Agent Parameters): Updated parameter names to match code. + (Group Agent Commands): Corrected 'gnus-agent-fetch-series' as + 'gnus-agent-summary-fetch-series'. + (Agent and flags): New section providing a generalized discussion + of flag handling. + (Agent and IMAP): Removed flag discussion. + (Agent Variables): Added 'gnus-agent-synchronize-flags' + +2007-10-28 Romain Francoise + + * gnus.texi (Exiting the Summary Buffer): Add new function + `gnus-summary-catchup-and-goto-prev-group', bound to `Z p'. + +2007-10-28 Reiner Steib + + * gnus.texi (Conformity): Fix typo. + (Customizing Articles): Document `first'. + +2007-10-28 Jari Aalto + + * gnus.texi (Sorting the Summary Buffer): + Add `gnus-thread-sort-by-date-reverse'. Add example + host to different sorting in NNTP and RSS groups. + +2007-10-28 Reiner Steib + + * message.texi (Insertion): Describe prefix for + message-mark-inserted-region and message-mark-insert-file. + +2007-10-28 Reiner Steib + + * emacs-mime.texi (Non-MIME): Add Slrn-style verbatim marks and + LaTeX documents. Describe "text/x-gnus-verbatim". + +2007-10-28 Teodor Zlatanov + + * gnus.texi (Blacklists and Whitelists) + (Blacklists and Whitelists, BBDB Whitelists) + (Gmane Spam Reporting, Bogofilter, spam-stat spam filtering) + (spam-stat spam filtering, SpamOracle) + (Extending the Spam ELisp package): Removed extra quote symbol for + clarity. + +2007-10-28 Reiner Steib + + * gnus.texi (MIME Commands): Add gnus-article-save-part-and-strip, + gnus-article-delete-part and gnus-article-replace-part. + (Using MIME): Add gnus-mime-replace-part. + +2007-10-28 Romain Francoise + + * gnus.texi (Mail Spool): Mention that `nnml-use-compressed-files' + requires `auto-compression-mode' to be enabled. Add new nnml + variable `nnml-compressed-files-size-threshold'. + +2007-10-28 Reiner Steib + + * gnus.texi (Sorting the Summary Buffer): Added + gnus-thread-sort-by-recipient. + +2007-10-28 Romain Francoise + + * message.texi (Insertion Variables): Mention new variable + `message-yank-empty-prefix'. Change `message-yank-cited-prefix' + documentation accordingly. + +2007-10-28 Romain Francoise + + * gnus.texi (To From Newsgroups): Mention new variables + `gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Using MIME): gnus-mime-copy-part supports the charset + stuff; gnus-mime-inline-part does the automatic decompression. + +2007-10-28 Teodor Zlatanov + + * gnus.texi (Spam ELisp Package Configuration Examples): + "training.ham" should be "training.spam" + +2007-10-28 Katsumi Yamaoka + + * message.texi (Mail Variables): Fix the default value for + message-send-mail-function. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (Optional Back End Functions): nntp-request-update-info + always returns nil exceptionally. + +2007-10-28 Simon Josefsson + + * gnus.texi (Article Washing): Add libidn URL. Suggested by + Michael Cook . + +2007-10-28 Lars Magne Ingebrigtsen + + * gnus.texi (Topic Commands): Fix next/previous. + +2007-10-28 Simon Josefsson + + * gnus.texi (Article Washing): Mention `W i'. + +2007-10-28 Jochen K,A|(Bpper + + * gnus.texi (Group Parameters): Slight extension of sieve + parameter description. + +2007-10-28 Reiner Steib + + * gnus.texi (Score Decays): `gnus-decay-scores' can be a regexp + matching score files as well. + (Picons): Describe `gnus-picon-style'. + +2007-10-28 Romain Francoise + + * message.texi (Message Headers): Mention that headers are hidden + using narrowing, and how to expose them. + Update copyright. + +2007-10-28 Reiner Steib + + * gnusref.tex: Mention `gnus-summary-limit-to-recipient' and + `gnus-summary-sort-by-recipient'. + +2007-10-28 Romain Francoise + + * gnus.texi (NNTP marks): New node. + (NNTP): Move NNTP marks variables to the new node. + +2007-10-28 Jesper Harder + + * gnus.texi, gnus-news.texi, pgg.texi, sasl.texi: backend -> back + end. + + * gnus.texi (MIME Commands, Hashcash): Markup fix. + +2007-10-28 Teodor Zlatanov + + * gnus.texi: replaced @file{spam.el} with @code{spam.el} + everywhere for consistency. + (Filtering Spam Using The Spam ELisp Package): admonish again. + (Spam ELisp Package Sequence of Events): this is Gnus, say so. + Say "regular expression" instead of "regex." Admonish. Pick + other words to sound better (s/so/thus/). + (Spam ELisp Package Filtering of Incoming Mail): mention + statistical filters. Remove old TODO. + (Spam ELisp Package Sorting and Score Display in Summary Buffer): + new section on sorting and displaying the spam score + (BBDB Whitelists): mention spam-use-BBDB-exclusive is not a + backend but an alias to spam-use-BBDB + (Extending the Spam ELisp package): rewrite the example using the + new backend functionality. + +2007-10-28 Simon Josefsson + + * gnus.texi (NNTP): Mention nntp-marks-is-evil and + nntp-marks-directory, from Romain Francoise + . + +2007-10-28 Magnus Henoch + + * gnus.texi (Hashcash): New default value of + hashcash-default-payment. + +2007-10-28 Simon Josefsson + + * gnus.texi (Hashcash): Fix URL. Add pref to spam section. + (Anti-spam Hashcash Payments): No need to load hashcash.el now. + +2007-10-28 Reiner Steib + + * gnus.texi (Adaptive Scoring): Added gnus-adaptive-pretty-print. + +2007-10-28 Simon Josefsson + + * gnus.texi (documentencoding): Add, to avoid warnings. + +2007-10-28 Simon Josefsson + + * message.texi (Mail Headers): Add. + + * gnus.texi (Hashcash): Fix. + +2007-10-28 Teodor Zlatanov + + * gnus.texi (Hashcash): changed location of library, also mention + that payments can be verified and fix the name of the + hashcash-path variable + +2007-10-28 Reiner Steib + + * gnus.texi + (Article Display): Add `gnus-picon-style'. + +2007-10-28 Katsumi Yamaoka + + * gnus.texi (SpamAssassin backend): Add it to the detailmenu. + +2007-10-28 Teodor Zlatanov + + * gnus.texi (Blacklists and Whitelists, BBDB Whitelists) + (Bogofilter, spam-stat spam filtering, SpamOracle): old incorrect + warning about ham processors in spam groups removed + +2007-10-28 Teodor Zlatanov + From Hubert Chan + + * gnus.texi (SpamAssassin backend): added new node about SpamAssassin + +2007-10-28 Jesper Harder + + * gnus.texi (Spam ELisp Package Sequence of Events): Index. + (Mailing List): Typo. + (Customizing Articles): Add gnus-treat-ansi-sequences. + (Article Washing): Index. + + * message.texi: Use m-dash consistently. + +2007-10-28 Jesper Harder + + * gnus.texi (GroupLens): Remove. + +2007-10-28 Kevin Greiner + + * gnus.texi (Outgoing Messages, Agent Variables): Add + gnus-agent-queue-mail and gnus-agent-prompt-send-queue. + Suggested by Gaute Strokkenes + +2007-10-28 Jesper Harder + + * gnus.texi (Limiting): Add gnus-summary-limit-to-replied. + +2007-10-28 Reiner Steib + + * gnus.texi (Article Washing): Add `gnus-article-treat-ansi-sequences'. + + * gnus.texi (No Gnus): New node. Includes `gnus-news.texi'. + +2007-10-28 Simon Josefsson + + * gnus.texi (Top): Add SASL. + 2007-10-27 Jay Belanger * calc.texi (Formulas, Composition Basics): Lower the diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/emacs-mime.texi --- a/doc/misc/emacs-mime.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/emacs-mime.texi Sun Oct 28 09:18:39 2007 +0000 @@ -180,8 +180,27 @@ are automatically sent to. It only works in groups matching @code{mm-uu-diff-groups-regexp}. +@item verbatim-marks +@cindex verbatim-marks +Slrn-style verbatim marks. + +@item LaTeX +@cindex LaTeX +LaTeX documents. It only works in groups matching +@code{mm-uu-tex-groups-regexp}. + @end table +@cindex text/x-verbatim +@c Is @vindex suitable for a face? +@vindex mm-uu-extract +Some inlined non-@acronym{MIME} attachments are displayed using the face +@code{mm-uu-extract}. By default, no @acronym{MIME} button for these +parts is displayed. You can force displaying a button using @kbd{K b} +(@code{gnus-summary-display-buttonized}) or add @code{text/x-verbatim} +to @code{gnus-buttonized-mime-types}, @xref{MIME Commands, ,MIME +Commands, gnus, Gnus Manual}. + @node Handles @section Handles @@ -849,6 +868,36 @@ @code{(iso-8859-1)}. You can override this setting on a per-message basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}). +As different hierarchies prefer different charsets, you may want to set +@code{mm-coding-system-priorities} according to the hierarchy in Gnus. +Here's an example: + +@c Corrections about preferred charsets are welcome. de, fr and fj +@c should be correct, I don't know about the rest (so these are only +@c examples): +@lisp +(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities) +(setq gnus-parameters + (nconc + ;; Some charsets are just examples! + '(("^cn\\." ;; Chinese + (mm-coding-system-priorities + '(iso-8859-1 cn-big5 chinese-iso-7bit utf-8))) + ("^cz\\.\\|^pl\\." ;; Central and Eastern European + (mm-coding-system-priorities '(iso-8859-2 utf-8))) + ("^de\\." ;; German language + (mm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8))) + ("^fr\\." ;; French + (mm-coding-system-priorities '(iso-8859-15 iso-8859-1 utf-8))) + ("^fj\\." ;; Japanese + (mm-coding-system-priorities + '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))) + ("^ru\\." ;; Cyrillic + (mm-coding-system-priorities + '(koi8-r iso-8859-5 iso-8859-1 utf-8)))) + gnus-parameters)) +@end lisp + @item mm-content-transfer-encoding-defaults @vindex mm-content-transfer-encoding-defaults Mapping from @acronym{MIME} types to encoding to use. This variable is usually @@ -1155,7 +1204,7 @@ @item mail-encode-encoded-word-region @findex mail-encode-encoded-word-region Encode the non-@acronym{ASCII} words in the region. For instance, -@samp{Naïve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}. +@samp{Na@"{@dotless{i}}ve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}. @item mail-encode-encoded-word-buffer @findex mail-encode-encoded-word-buffer @@ -1168,7 +1217,7 @@ @example (mail-encode-encoded-word-string - "This is naïve, baby") + "This is na@"{@dotless{i}}ve, baby") @result{} "This is =?iso-8859-1?q?na=EFve,?= baby" @end example @@ -1183,7 +1232,7 @@ @example (mail-decode-encoded-word-string "This is =?iso-8859-1?q?na=EFve,?= baby") -@result{} "This is naïve, baby" +@result{} "This is na@"{@dotless{i}}ve, baby" @end example @end table diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/gnus-coding.texi --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/misc/gnus-coding.texi Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,381 @@ +\input texinfo + +@setfilename gnus-coding +@settitle Gnus Coding Style and Maintainance Guide +@syncodeindex fn cp +@syncodeindex vr cp +@syncodeindex pg cp + +@copying +Copyright (c) 2004, 2005, 2007 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.1 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover texts being ``A GNU +Manual'', and with the Back-Cover Texts as in (a) below. A copy of the +license is included in the section entitled ``GNU Free Documentation +License'' in the Emacs manual. + +(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify +this GNU Manual, like GNU software. Copies published by the Free +Software Foundation raise funds for GNU development.'' + +This document is part of a collection distributed under the GNU Free +Documentation License. If you want to distribute this document +separately from the collection, you can do so by adding a copy of the +license to the document, as described in section 6 of the license. +@end quotation +@end copying + + +@titlepage +@title Gnus Coding Style and Maintainance Guide + +@author by Reiner Steib + +@insertcopying +@end titlepage + +@c Obviously this is only a very rudimentary draft. We put it in CVS +@c anyway hoping that it might annoy someone enough to fix it. ;-) +@c Fixing only a paragraph also is appreciated. + +@node Top +@top Gnus Coding Style and Maintainance Guide +This manual describes @dots{} +@menu +* Gnus Coding Style:: Gnus Coding Style +* Gnus Maintainance Guide:: Gnus Maintainance Guide +@end menu + +@c @ref{Gnus Reference Guide, ,Gnus Reference Guide, gnus, The Gnus Newsreader} + +@node Gnus Coding Style +@chapter Gnus Coding Style +@section Dependencies + +The Gnus distribution contains a lot of libraries that have been written +for Gnus and used intensively for Gnus. But many of those libraries are +useful on their own. E.g. other Emacs Lisp packages might use the +@acronym{MIME} library @xref{Top, ,Top, emacs-mime, The Emacs MIME +Manual}. + +@subsection General purpose libraries + +@table @file + +@item netrc.el +@file{.netrc} parsing functionality. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item format-spec.el +Functions for formatting arbitrary formatting strings. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item hex-util.el +Functions to encode/decode hexadecimal string. +@c As of 2007-08-25... +There are no Gnus dependencies in these files. +@end table + +@subsection Encryption and security + +@table @file +@item encrypt.el +File encryption routines +@c As of 2005-10-25... +There are no Gnus dependencies in this file. + +@item password.el +Read passwords from user, possibly using a password cache. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item tls.el +TLS/SSL support via wrapper around GnuTLS +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item pgg*.el +Glue for the various PGP implementations. +@c As of 2005-10-21... +There are no Gnus dependencies in these files. + +@item sha1.el +SHA1 Secure Hash Algorithm. +@c As of 2007-08-25... +There are no Gnus dependencies in these files. +@end table + +@subsection Networking + +@table @file +@item dig.el +Domain Name System dig interface. +@c As of 2005-10-21... +There are no serious Gnus dependencies in this file. Uses +@code{gnus-run-mode-hooks} (a wrapper function). + +@item dns.el, dns-mode.el +Domain Name Service lookups. +@c As of 2005-10-21... +There are no Gnus dependencies in these files. +@end table + +@subsection Mail and News related RFCs + +@table @file +@item pop3.el +Post Office Protocol (RFC 1460) interface. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item imap.el +@acronym{IMAP} library. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item ietf-drums.el +Functions for parsing RFC822bis headers. +@c As of 2005-10-21... +There are no Gnus dependencies in this file. + +@item rfc1843.el +HZ (rfc1843) decoding. HZ is a data format for exchanging files of +arbitrarily mixed Chinese and @acronym{ASCII} characters. +@c As of 2005-10-21... +@code{rfc1843-gnus-setup} seem to be useful only for Gnus. Maybe this +function should be relocated to remove dependencies on Gnus. Other +minor dependencies: @code{gnus-newsgroup-name} could be eliminated by +using an optional argument to @code{rfc1843-decode-article-body}. + +@item rfc2045.el +Functions for decoding rfc2045 headers +@c As of 2007-08-25... +There are no Gnus dependencies in these files. + +@item rfc2047.el +Functions for encoding and decoding rfc2047 messages +@c As of 2007-08-25... +There are no Gnus dependencies in these files. +@c +Only a couple of tests for gnusy symbols. + +@item rfc2104.el +RFC2104 Hashed Message Authentication Codes +@c As of 2007-08-25... +There are no Gnus dependencies in these files. + +@item rfc2231.el +Functions for decoding rfc2231 headers +@c As of 2007-08-25... +There are no Gnus dependencies in these files. + +@item flow-fill.el +Interpret RFC2646 "flowed" text. +@c As of 2005-10-27... +There are no Gnus dependencies in this file. + +@item uudecode.el +Elisp native uudecode. +@c As of 2005-12-06... +There are no Gnus dependencies in this file. +@c ... but the custom group is gnus-extract. + +@item canlock.el +Functions for Cancel-Lock feature +@c Cf. draft-ietf-usefor-cancel-lock-01.txt +@c Although this draft has expired, Canlock-Lock revived in 2007 when +@c major news providers (e.g. news.individual.org) started to use it. +@c As of 2007-08-25... +There are no Gnus dependencies in these files. + +@end table + +@subsection message + +All message composition from Gnus (both mail and news) takes place in +Message mode buffers. Message mode is intended to be a replacement for +Emacs mail mode. There should be no Gnus dependencies in +@file{message.el}. Alas it is not anymore. Patches and suggestions to +remove the dependencies are welcome. + +@c message.el requires nnheader which requires gnus-util. + +@subsection Emacs @acronym{MIME} + +The files @file{mml*.el} and @file{mm-*.el} provide @acronym{MIME} +functionality for Emacs. + +@acronym{MML} (@acronym{MIME} Meta Language) is supposed to be +independent from Gnus. Alas it is not anymore. Patches and suggestions +to remove the dependencies are welcome. + +@subsection Gnus backends + +The files @file{nn*.el} provide functionality for accessing NNTP +(@file{nntp.el}), IMAP (@file{nnimap.el}) and several other Mail back +ends (probably @file{nnml.el}, @file{nnfolder.el} and +@file{nnmaildir.el} are the most widely used mail back ends). + +@c mm-uu requires nnheader which requires gnus-util. message.el also +@c requires nnheader. + + +@section Compatibility + +No Gnus and Gnus 5.10.10 and up should work on: +@itemize @bullet +@item +Emacs 21.1 and up. +@item +XEmacs 21.4 and up. +@end itemize + +Gnus 5.10.8 and below should work on: +@itemize @bullet +@item +Emacs 20.7 and up. +@item +XEmacs 21.1 and up. +@end itemize + +@node Gnus Maintainance Guide +@chapter Gnus Maintainance Guide + +@section Stable and development versions + +The development of Gnus normally is done on the CVS trunk, i.e. there +are no separate branches to develop and test new features. Most of the +time, the trunk is developed quite actively with more or less daily +changes. Only after a new major release, e.g. 5.10.1, there's usually a +feature period of several months. After the release of Gnus 5.10.6 the +development of new features started again on the trunk while the 5.10 +series is continued on the stable branch (v5-10) from which more stable +releases will be done when needed (5.10.7, @dots{}). +@ref{Gnus Development, ,Gnus Development, gnus, The Gnus Newsreader} + +Stable releases of Gnus finally become part of Emacs. E.g. Gnus 5.8 +became a part of Emacs 21 (relabeled to Gnus 5.9). The 5.10 series +became part of Emacs 22 as Gnus 5.11. + +@section Syncing + +@c Some MIDs related to this follow. Use http://thread.gmane.org/MID +@c (and click on the subject) to get the thread on Gmane. + +@c Some quotes from Miles Bader follow... + +@c +@c + +In the past, the inclusion of Gnus into Emacs was quite cumbersome. For +each change made to Gnus in Emacs repository, it had to be checked that +it was applied to the new Gnus version, too. Else, bug fixes done in +Emacs repository might have been lost. + +With the inclusion of Gnus 5.10, Miles Bader has set up an Emacs-Gnus +gateway to ensure the bug fixes from Emacs CVS are propagated to Gnus +CVS semi-automatically. These bug fixes are installed on the stable +branch and on the trunk. Basically the idea is that the gateway will +cause all common files in Emacs and Gnus v5-10 to be identical except +when there's a very good reason (e.g., the Gnus version string in Emacs +says @samp{5.11}, but the v5-10 version string remains @samp{5.10.x}). +Furthermore, all changes in these files in either Emacs or the v5-10 +branch will be installed into the Gnus CVS trunk, again except where +there's a good reason. +@c (typically so far the only exception has been that the changes +@c already exist in the trunk in modified form). +Because of this, when the next major version of Gnus will be included in +Emacs, it should be very easy -- just plonk in the files from the Gnus +trunk without worrying about lost changes from the Emacs tree. + +The effect of this is that as hacker, you should generally only have to +make changes in one place: + +@itemize +@item +If it's a file which is thought of as being outside of Gnus (e.g., the +new @file{encrypt.el}), you should probably make the change in the Emacs +tree, and it will show up in the Gnus tree a few days later. + +If you don't have Emacs CVS access (or it's inconvenient), you can +change such a file in the v5-10 branch, and it should propagate to Emacs +CVS -- however, it will get some extra scrutiny (by Miles) to see if the +changes are possibly controversial and need discussion on the mailing +list. Many changes are obvious bug-fixes however, so often there won't +be any problem. + +@item +If it's to a Gnus file, and it's important enough that it should be part +of Emacs and the v5-10 branch, then you can make the change on the v5-10 +branch, and it will go into Emacs CVS and the Gnus CVS trunk (a few days +later). The most prominent examples for such changes are bug-fixed +including improvements on the documentation. + +If you know that there will be conflicts (perhaps because the affected +source code is different in v5-10 and the Gnus CVS trunk), then you can +install your change in both places, and when I try to sync them, there +will be a conflict -- however, since in most such cases there would be a +conflict @emph{anyway}, it's often easier for me to resolve it simply if +I see two @samp{identical} changes, and can just choose the proper one, +rather than having to actually fix the code. + +@item +For general Gnus development changes, of course you just make the +change on the Gnus CVS trunk and it goes into Emacs a few years +later... :-) +@end itemize + +Of course in any case, if you just can't wait for me to sync your +change, you can commit it in more than one place and probably there will +be no problem; usually the changes are textually identical anyway, so +can be easily resolved automatically (sometimes I notice silly things in +such multiple commits, like whitespace differences, and unify those ;-). + + +@c I do Emacs->Gnus less often (than Gnus->Emacs) because it tends to +@c require more manual work. + +@c By default I sync about once a week. I also try to follow any Gnus +@c threads on the mailing lists and make sure any changes being discussed +@c are kept more up-to-date (so say 1-2 days delay for "topical" changes). + +@c + +@c BTW, just to add even more verbose explanation about the syncing thing: + +@section Miscellanea + +@heading @file{GNUS-NEWS} + +Starting from No Gnus, the @file{GNUS-NEWS} is created from +@file{texi/gnus-news.texi}. Don't edit @file{GNUS-NEWS}. Edit +@file{texi/gnus-news.texi}, type @command{make GNUS-NEWS} in the +@file{texi} directory and commit @file{GNUS-NEWS} and +@file{texi/gnus-news.texi}. + +@heading Conventions for version information in defcustoms + +For new customizable variables introduced in Oort Gnus (including the +v5-10 branch) use @code{:version "22.1" ;; Oort Gnus} (including the +comment) or e.g. @code{:version "22.2" ;; Gnus 5.10.10} if the feature +was added for Emacs 22.2 and Gnus 5.10.10. +@c +If the variable is new in No Gnus use @code{:version "23.0" ;; No Gnus}. + +The same applies for customizable variables when its default value was +changed. + +@c Local Variables: +@c mode: texinfo +@c coding: iso-8859-1 +@c End: + +@ignore + arch-tag: ab15234c-2c8a-4cbd-8111-1811bcc6f931 +@end ignore diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/gnus-faq.texi --- a/doc/misc/gnus-faq.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/gnus-faq.texi Sun Oct 28 09:18:39 2007 +0000 @@ -1286,18 +1286,23 @@ @subsubheading Answer -Say +Starting from No Gnus, automatic word-wrap is already enabled by +default, see the variable message-fill-column. + +For other versions of Gnus, say @example -(add-hook 'message-mode-hook - (lambda () - (setq fill-column 72) - (turn-on-auto-fill))) +(unless (boundp 'message-fill-column) + (add-hook 'message-mode-hook + (lambda () + (setq fill-column 72) + (turn-on-auto-fill)))) @end example @noindent -in ~/.gnus.el. You can reformat a paragraph by hitting -@samp{M-q} (as usual) +in ~/.gnus.el. + +You can reformat a paragraph by hitting @samp{M-q} (as usual). @node [5.3] @subsubheading Question 5.3 @@ -1676,10 +1681,7 @@ yourUserName.userfqdn.provider.net, or you can use somethingUnique.yourdomain.tld if you own the domain yourdomain.tld, or you can register at a service which -gives private users a FQDN for free, e.g. -@uref{http://www.stura.tu-freiberg.de/~dlx/addfqdn.html}. -(Sorry but this website is in German, if you know of an -English one offering the same, drop me a note). +gives private users a FQDN for free. Finally you can tell Gnus not to generate a Message-ID for News at all (and letting the server do the job) by saying diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/gnus-news.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/misc/gnus-news.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,121 @@ +;;; gnus-news.el --- a hack to create GNUS-NEWS from texinfo source +;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Author: Reiner Steib +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Code: + +(defvar gnus-news-header-disclaimer +"GNUS NEWS -- history of user-visible changes. + +Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Gnus bug reports to bugs@gnus.org. +For older news, see Gnus info node \"New Features\".\n\n") + +(defvar gnus-news-trailer +" +* For older news, see Gnus info node \"New Features\". + +---------------------------------------------------------------------- + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. + + \nLocal variables:\nmode: outline +paragraph-separate: \"[ ]*$\"\nend:\n") + +(defvar gnus-news-makeinfo-command "makeinfo") + +(defvar gnus-news-fill-column 80) + +(defvar gnus-news-makeinfo-switches + (concat " --no-headers --paragraph-indent=0" + " --no-validate" ;; Allow unresolved references. + " --fill-column=" (number-to-string + (+ 3 ;; will strip leading spaces later + (or gnus-news-fill-column 80))))) + +(defun batch-gnus-news () + "Make GNUS-NEWS in batch mode." + (let (infile outfile) + (setq infile (car command-line-args-left) + command-line-args-left (cdr command-line-args-left) + outfile (car command-line-args-left) + command-line-args-left nil) + (if (and infile outfile) + (message "Creating `%s' from `%s'..." outfile infile) + (error "Not enough files given.")) + (gnus-news-translate-file infile outfile))) + +(defun gnus-news-translate-file (infile outfile) + "Translate INFILE (texinfo) to OUTFILE (GNUS-NEWS)." + (let* ((dir (concat (or (getenv "srcdir") ".") "/")) + (infile (concat dir infile)) + (buffer (find-file-noselect (concat dir outfile)))) + (with-temp-buffer + ;; Could be done using `texinfmt' stuff as in `infohack.el'. + (insert + (shell-command-to-string + (concat gnus-news-makeinfo-command " " + gnus-news-makeinfo-switches " " infile))) + (goto-char (point-max)) + (delete-char -1) + (goto-char (point-min)) + (save-excursion + (while (re-search-forward "^ \\* " nil t) + (replace-match "\f\n* "))) + (save-excursion + (while (re-search-forward "^ \\* " nil t) + (replace-match "** "))) + (save-excursion + (while (re-search-forward "^ " nil t) + (replace-match ""))) + ;; Avoid `*' from @ref at beginning of line: + (save-excursion + (while (re-search-forward "^\\*Note" nil t) + (replace-match " \\&"))) + (goto-char (point-min)) + (insert gnus-news-header-disclaimer) + (goto-char (point-max)) + (insert gnus-news-trailer) + (write-region (point-min) (point-max) outfile)))) + +;;; arch-tag: e23cdd27-eafd-4ba0-816f-98f5edb0dc29 +;;; gnus-news.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/gnus-news.texi --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/misc/gnus-news.texi Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,264 @@ +@c -*-texinfo-*- + +@c Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc. + +@c Permission is granted to anyone to make or distribute verbatim copies +@c of this document as received, in any medium, provided that the +@c copyright notice and this permission notice are preserved, +@c thus giving the recipient permission to redistribute in turn. + +@c Permission is granted to distribute modified versions +@c of this document, or of portions of it, +@c under the above conditions, provided also that they +@c carry prominent notices stating who last changed them. + +@c This file contains a list of news features Gnus. It is supposed to be +@c included in `gnus.texi'. `GNUS-NEWS' is automatically generated from +@c this file (see `gnus-news.el'). + +@itemize @bullet + +@item Installation changes + +@itemize @bullet +@item Upgrading from previous (stable) version if you have used No Gnus. + +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 +@file{~/News/marks} directory (perhaps selectively), so that flags are +read from your @file{~/.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. + +@item Lisp files are now installed in @file{.../site-lisp/gnus/} by default. +It defaulted to @file{.../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 @code{make +remove-installed-shadows}. +@end itemize + +@item New packages and libraries within Gnus + +@itemize @bullet + +@item Gnus includes the Emacs Lisp @acronym{SASL} library. + +This provides a clean @acronym{API} to @acronym{SASL} mechanisms from +within Emacs. The user visible aspects of this, compared to the earlier +situation, include support for @acronym{DIGEST}-@acronym{MD5} and +@acronym{NTLM}. @xref{Top, ,Emacs SASL, sasl, Emacs SASL}. + +@item ManageSieve connections uses the @acronym{SASL} library by default. + +The primary change this brings is support for @acronym{DIGEST-MD5} and +@acronym{NTLM}, when the server supports it. + +@item Gnus includes a password cache mechanism in password.el. + +It is enabled by default (see @code{password-cache}), with a short +timeout of 16 seconds (see @code{password-cache-expiry}). If +@acronym{PGG} is used as the @acronym{PGP} back end, the @acronym{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. +@end itemize + +@item Changes in summary and article mode + +@itemize @bullet + +@item Gnus now supports sticky article buffers. Those are article buffers +that are not reused when you select another article. @xref{Sticky +Articles}. + +@item International host names (@acronym{IDNA}) can now be decoded +inside article bodies using @kbd{W i} +(@code{gnus-summary-idna-message}). This requires that GNU Libidn +(@url{http://www.gnu.org/software/libidn/}) has been installed. +@c FIXME: Also mention @code{message-use-idna}? + +@item The non-@acronym{ASCII} group names handling has been much +improved. The back ends that fully support non-@acronym{ASCII} group +names are now @code{nntp}, @code{nnml}, and @code{nnrss}. Also the +agent, the cache, and the marks features work with those back ends. +@xref{Non-ASCII Group Names}. + +@item Gnus now displays @acronym{DNS} master files sent as text/dns +using dns-mode. + +@item Gnus supports new limiting commands in the Summary buffer: +@kbd{/ r} (@code{gnus-summary-limit-to-replied}) and @kbd{/ R} +(@code{gnus-summary-limit-to-recipient}). @xref{Limiting}. + +@item You can now fetch all ticked articles from the server using +@kbd{Y t} (@code{gnus-summary-insert-ticked-articles}). @xref{Summary +Generation Commands}. + +@item Gnus supports a new sort command in the Summary buffer: +@kbd{C-c C-s C-t} (@code{gnus-summary-sort-by-recipient}). @xref{Summary +Sorting}. + +@item @acronym{S/MIME} now features @acronym{LDAP} user certificate searches. +You need to configure the server in @code{smime-ldap-host-list}. + +@item URLs inside Open@acronym{PGP} headers are retrieved and imported +to your PGP key ring when you click on them. + +@item +Picons can be displayed right from the textual address, see +@code{gnus-picon-style}. @xref{Picons}. + +@item @acronym{ANSI} @acronym{SGR} control sequences can be transformed +using @kbd{W A}. + +@acronym{ANSI} sequences are used in some Chinese hierarchies for +highlighting articles (@code{gnus-article-treat-ansi-sequences}). + +@item Gnus now MIME decodes articles even when they lack "MIME-Version" header. +This changes the default of @code{gnus-article-loose-mime}. + +@item @code{gnus-decay-scores} can be a regexp matching score files. +For example, set it to @samp{\\.ADAPT\\'} and only adaptive score files +will be decayed. @xref{Score Decays}. + +@item Strings prefixing to the @code{To} and @code{Newsgroup} headers in +summary lines when using @code{gnus-ignored-from-addresses} can be +customized with @code{gnus-summary-to-prefix} and +@code{gnus-summary-newsgroup-prefix}. @xref{To From Newsgroups}. + +@item You can replace @acronym{MIME} parts with external bodies. +See @code{gnus-mime-replace-part} and @code{gnus-article-replace-part}. +@xref{MIME Commands}, @ref{Using MIME}. + +@item +The option @code{mm-fill-flowed} can be used to disable treatment of +format=flowed messages. Also, flowed text is disabled when sending +inline @acronym{PGP} signed messages. @xref{Flowed text, ,Flowed text, +emacs-mime, The Emacs MIME Manual}. (New in Gnus 5.10.7) +@c This entry is also present in the node "Oort Gnus". + +@end itemize + +@item Changes in Message mode + +@itemize @bullet +@item Gnus now supports the ``hashcash'' client puzzle anti-spam mechanism. +Use @code{(setq message-generate-hashcash t)} to enable. +@xref{Hashcash}. + +@item You can now drag and drop attachments to the Message buffer. +See @code{mml-dnd-protocol-alist} and @code{mml-dnd-attach-options}. +@xref{MIME, ,MIME, message, Message Manual}. + +@item The option @code{message-yank-empty-prefix} now controls how +empty lines are prefixed in cited text. @xref{Insertion Variables, +,Insertion Variables, message, Message Manual}. + +@item Gnus uses narrowing to hide headers in Message buffers. +The @code{References} header is hidden by default. To make all +headers visible, use @code{(setq message-hidden-headers nil)}. +@xref{Message Headers, ,Message Headers, message, Message Manual}. + +@item You can highlight different levels of citations like in the +article buffer. See @code{gnus-message-highlight-citation}. + +@item @code{auto-fill-mode} is enabled by default in Message mode. +See @code{message-fill-column}. @xref{Various Message Variables, , +Message Headers, message, Message Manual}. + +@item You can now store signature files in a special directory +named @code{message-signature-directory}. + +@item The option @code{message-citation-line-format} controls the format +of the "Whomever writes:" line. You need to set +@code{message-citation-line-function} to +@code{message-insert-formated-citation-line} as well. +@end itemize + +@item Changes in back ends + +@itemize @bullet +@item The nntp back end stores article marks in @file{~/News/marks}. + +The directory can be changed using the (customizable) variable +@code{nntp-marks-directory}, and marks can be disabled using the +(back end) variable @code{nntp-marks-is-evil}. The advantage of this +is that you can copy @file{~/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 @file{~/News/marks} +has priority over the same data in @file{~/.newsrc.eld}. + +@item +You can import and export your @acronym{RSS} subscriptions from +@acronym{OPML} files. @xref{RSS}. + +@item @acronym{IMAP} identity (@acronym{RFC} 2971) is supported. + +By default, Gnus does not send any information about itself, but you can +customize it using the variable @code{nnimap-id}. + +@item The @code{nnrss} back end now supports multilingual text. +Non-@acronym{ASCII} group names for the @code{nnrss} groups are also +supported. @xref{RSS}. + +@item Retrieving mail with @acronym{POP3} is supported over @acronym{SSL}/@acronym{TLS} and with StartTLS. + +@item The nnml back end allows other compression programs beside @file{gzip} +for compressed message files. @xref{Mail Spool}. + +@item The nnml back end supports group compaction. + +This feature, accessible via the functions +@code{gnus-group-compact-group} (@kbd{G z} in the group buffer) and +@code{gnus-server-compact-server} (@kbd{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). +@end itemize + +@item Appearance +@c Maybe it's not worth to separate this from "Miscellaneous"? + +@itemize @bullet + +@item The tool bar has been updated to use GNOME icons. +You can also customize the tool bar. There's no documentation in the +manual yet, but @kbd{M-x customize-apropos RET -tool-bar$} should get +you started. (Only for Emacs, not in XEmacs.) +@c FIXME: Document this in the manual + +@item The tool bar icons are now (de)activated correctly +in the group buffer, see the variable @code{gnus-group-update-tool-bar}. +Its default value depends on your Emacs version. +@c FIXME: Document this in the manual + +@item You can change the location of XEmacs' toolbars in Gnus buffers. +See @code{gnus-use-toolbar} and @code{message-use-toolbar}. + +@end itemize + +@item Miscellaneous changes + +@itemize @bullet +@item 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 +@code{nntp-via-address} into @samp{bar.example.com} from +@samp{foo.example.com}, Gnus will connect to the news host by way of the +intermediate host @samp{bar.example.com} from next time. + +@item The @file{all.SCORE} file can be edited from the group buffer +using @kbd{W e}. + +@end itemize + +@end itemize + +@c gnus-news.texi ends here. + +@ignore + arch-tag: 872c7569-4340-4d73-9d1d-7826d9f94a51 +@end ignore diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/gnus.texi --- a/doc/misc/gnus.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/gnus.texi Sun Oct 28 09:18:39 2007 +0000 @@ -6,6 +6,8 @@ @syncodeindex vr cp @syncodeindex pg cp +@documentencoding ISO-8859-1 + @copying Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. @@ -50,7 +52,7 @@ \begin{document} % Adjust ../Makefile.in if you change the following line: -\newcommand{\gnusversionname}{Gnus v5.11} +\newcommand{\gnusversionname}{No Gnus v0.7} \newcommand{\gnuschaptername}{} \newcommand{\gnussectionname}{} @@ -360,7 +362,7 @@ luck. @c Adjust ../Makefile.in if you change the following line: -This manual corresponds to Gnus v5.11. +This manual corresponds to No Gnus v0.7. @end ifinfo @@ -412,6 +414,7 @@ * Emacs-MIME:(emacs-mime). Composing messages; @acronym{MIME}-specific parts. * Sieve:(sieve). Managing Sieve scripts in Emacs. * PGG:(pgg). @acronym{PGP/MIME} with Gnus. +* SASL:(sasl). @acronym{SASL} authentication in Emacs. @detailmenu --- The Detailed Node Listing --- @@ -454,6 +457,7 @@ * Browse Foreign Server:: You can browse a server. See what it has to offer. * Exiting Gnus:: Stop reading news and get some work done. * Group Topics:: A folding group mode divided into topics. +* Non-ASCII Group Names:: Accessing groups of non-English names. * Misc Group Stuff:: Other stuff that you can to do. Group Buffer Format @@ -493,6 +497,7 @@ * Asynchronous Fetching:: Gnus might be able to pre-fetch articles. * Article Caching:: You may store articles in a cache. * Persistent Articles:: Making articles expiry-resistant. +* Sticky Articles:: Article buffers that are not reused. * Article Backlog:: Having already read articles hang around. * Saving Articles:: Ways of customizing article saving. * Decoding Articles:: Gnus can treat series of (uu)encoded articles. @@ -646,6 +651,7 @@ * 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 @@ -749,6 +755,7 @@ * Agent as Cache:: The Agent is a big cache too. * Agent Expiry:: How to make old articles go away. * Agent Regeneration:: How to recover from lost connections and other accidents. +* Agent and flags:: How the Agent maintains flags. * Agent and IMAP:: How to use the Agent with @acronym{IMAP}. * Outgoing Messages:: What happens when you post/mail something? * Agent Variables:: Customizing is fun. @@ -784,17 +791,9 @@ * Global Score Files:: Earth-spanning, ear-splitting score files. * Kill Files:: They are still here, but they can be ignored. * Converting Kill Files:: Translating kill files to score files. -* GroupLens:: Getting predictions on what you like to read. * Advanced Scoring:: Using logical expressions to build score rules. * Score Decays:: It can be useful to let scores wither away. -GroupLens - -* Using GroupLens:: How to make Gnus use GroupLens. -* Rating Articles:: Letting GroupLens know how you rate articles. -* Displaying Predictions:: Displaying predictions given by GroupLens. -* GroupLens Variables:: Customizing GroupLens. - Advanced Scoring * Advanced Scoring Syntax:: A definition. @@ -901,6 +900,7 @@ * 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. Customization @@ -1067,6 +1067,11 @@ (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 First Time @section The First Time @@ -1718,6 +1723,7 @@ * Browse Foreign Server:: You can browse a server. See what it has to offer. * Exiting Gnus:: Stop reading news and get some work done. * Group Topics:: A folding group mode divided into topics. +* Non-ASCII Group Names:: Accessing groups of non-English names. * Misc Group Stuff:: Other stuff that you can to do. @end menu @@ -1819,8 +1825,15 @@ hysterical raisins, even the mail back ends, where the true number of unread messages might be available efficiently, use the same limited interface. To remove this restriction from Gnus means that the back -end interface has to be changed, which is not an easy job. If you -want to work on this, please contact the Gnus mailing list. +end interface has to be changed, which is not an easy job. + +The nnml backend (@pxref{Mail Spool}) has a feature called ``group +compaction'' which circumvents this deficiency: the idea is to +renumber all articles from 1, removing all gaps between numbers, hence +getting a correct total count. Other backends may support this in the +future. In order to keep your total article count relatively up to +date, you might want to compact your groups (or even directly your +server) from time to time. @xref{Misc Group Stuff}, @xref{Server Commands}. @item y Number of unread, unticked, non-dormant articles. @@ -1886,6 +1899,12 @@ A string that says when you last read the group (@pxref{Group Timestamp}). +@item F +The disk space used by the articles fetched by both the cache and +agent. The value is automatically scaled to bytes(B), kilobytes(K), +megabytes(M), or gigabytes(G) to minimize the column width. A format +of %7F is sufficient for a fixed-width column. + @item u User defined specifier. The next character in the format string should be a letter. Gnus will call the function @@ -2071,6 +2090,11 @@ the commands that say they move to the next unread group. The default is @code{t}. +@vindex gnus-summary-next-group-on-exit +If @code{gnus-summary-next-group-on-exit} is @code{t}, when a summary is +exited, the point in the group buffer is moved to the next unread group. +Otherwise, the point is set to the group just exited. The default is +@code{t}. @node Selecting a Group @section Selecting a Group @@ -2988,6 +3012,15 @@ (signature "Funky Signature")) @end example +If you're using topics to organize your group buffer +(@pxref{Group Topics}), note that posting styles can also be set in +the topics parameters. Posting styles in topic parameters apply to all +groups in this topic. More precisely, the posting-style settings for a +group result from the hierarchical merging of all posting-style +entries in the parameters of this group and all the topics it belongs +to. + + @item post-method @cindex post-method If it is set, the value is used as the method for posting message @@ -3014,11 +3047,25 @@ Commands}) the following Sieve code is generated: @example -if address \"sender\" \"sieve-admin@@extundo.com\" @{ - fileinto \"INBOX.list.sieve\"; +if address "sender" "sieve-admin@@extundo.com" @{ + fileinto "INBOX.list.sieve"; @} @end example +To generate tests for multiple email-addresses use a group parameter +like @code{(sieve address "sender" ("name@@one.org" else@@two.org"))}. +When generating a sieve script (@pxref{Sieve Commands}) Sieve code +like the following is generated: + +@example +if address "sender" ["name@@one.org", "else@@two.org"] @{ + fileinto "INBOX.list.sieve"; +@} +@end example + +See @pxref{Sieve Commands} for commands and variables that might be of +interest in relation to the sieve parameter. + The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve, Top, sieve, Emacs Sieve}. @@ -3132,6 +3179,33 @@ @code{nil}. Otherwise, set it to @code{t} if you want to compare them always in a case-insensitive manner. +You can define different sorting to different groups via +@code{gnus-parameters}. Here is an example to sort an @acronym{NNTP} +group by reverse date to see the latest news at the top and an +@acronym{RSS} group by subject. In this example, the first group is the +Debian daily news group @code{gmane.linux.debian.user.news} from +news.gmane.org. The @acronym{RSS} group corresponds to the Debian +weekly news RSS feed +@url{http://packages.debian.org/unstable/newpkg_main.en.rdf}, +@xref{RSS}. + +@lisp +(setq + gnus-parameters + '(("nntp.*gmane\\.debian\\.user\\.news" + (gnus-show-threads nil) + (gnus-article-sort-functions '((not gnus-article-sort-by-date))) + (gnus-use-adaptive-scoring nil) + (gnus-use-scoring nil)) + ("nnrss.*debian" + (gnus-show-threads nil) + (gnus-article-sort-functions 'gnus-article-sort-by-subject) + (gnus-use-adaptive-scoring nil) + (gnus-use-scoring t) + (gnus-score-find-score-files-function 'gnus-score-find-single) + (gnus-summary-line-format "%U%R%z%d %I%(%[ %s %]%)\n")))) +@end lisp + @node Listing Groups @section Listing Groups @@ -3847,7 +3921,7 @@ @item T M-p @kindex T M-p (Topic) @findex gnus-topic-goto-previous-topic -Go to the next topic (@code{gnus-topic-goto-previous-topic}). +Go to the previous topic (@code{gnus-topic-goto-previous-topic}). @item G p @kindex G p (Topic) @@ -4086,6 +4160,132 @@ happens. You just have to be careful if you do stuff like that. +@node Non-ASCII Group Names +@section Accessing groups of non-English names +@cindex non-ascii group names + +There are some news servers that provide groups of which the names are +expressed with their native languages in the world. For instance, in a +certain news server there are some newsgroups of which the names are +spelled in Chinese, where people are talking in Chinese. You can, of +course, subscribe to such news groups using Gnus. Currently Gnus +supports non-@acronym{ASCII} group names not only with the @code{nntp} +back end but also with the @code{nnml} back end and the @code{nnrss} +back end. + +Every such group name is encoded by a certain charset in the server +side (in an @acronym{NNTP} server its administrator determines the +charset, but for groups in the other back ends it is determined by you). +Gnus has to display the decoded ones for you in the group buffer and the +article buffer, and needs to use the encoded ones when communicating +with servers. However, Gnus doesn't know what charset is used for each +non-@acronym{ASCII} group name. The following two variables are just +the ones for telling Gnus what charset should be used for each group: + +@table @code +@item gnus-group-name-charset-method-alist +@vindex gnus-group-name-charset-method-alist +An alist of select methods and charsets. The default value is +@code{nil}. The names of groups in the server specified by that select +method are all supposed to use the corresponding charset. For example: + +@lisp +(setq gnus-group-name-charset-method-alist + '(((nntp "news.com.cn") . cn-gb-2312))) +@end lisp + +Charsets specified for groups with this variable are preferred to the +ones specified for the same groups with the +@code{gnus-group-name-charset-group-alist} variable (see below). + +A select method can be very long, like: + +@lisp +(nntp "gmane" + (nntp-address "news.gmane.org") + (nntp-end-of-line "\n") + (nntp-open-connection-function + nntp-open-via-rlogin-and-telnet) + (nntp-via-rlogin-command "ssh") + (nntp-via-rlogin-command-switches + ("-C" "-t" "-e" "none")) + (nntp-via-address @dots{})) +@end lisp + +In that case, you can truncate it into @code{(nntp "gmane")} in this +variable. That is, it is enough to contain only the back end name and +the server name. + +@item gnus-group-name-charset-group-alist +@cindex UTF-8 group names +@vindex gnus-group-name-charset-group-alist +An alist of regexp of group name and the charset for group names. +@code{((".*" . utf-8))} is the default value if UTF-8 is supported, +otherwise the default is @code{nil}. For example: + +@lisp +(setq gnus-group-name-charset-group-alist + '(("\\.com\\.cn:" . cn-gb-2312) + (".*" . utf-8))) +@end lisp + +Note that this variable is ignored if the match is made with +@code{gnus-group-name-charset-method-alist}. +@end table + +Those two variables are used also to determine the charset for encoding +and decoding non-@acronym{ASCII} group names that are in the back ends +other than @code{nntp}. It means that it is you who determine it. If +you do nothing, the charset used for group names in those back ends will +all be @code{utf-8} because of the last element of +@code{gnus-group-name-charset-group-alist}. + +There is one more important variable for non-@acronym{ASCII} group +names. @emph{XEmacs users must set this}. Emacs users necessarily need +not do: + +@table @code +@item nnmail-pathname-coding-system +The value of this variable should be a coding system or @code{nil} +(which is the default). 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. + +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 +file names. Therefore, @emph{you, XEmacs users, have to set it} to the +coding system that is suitable to encode and decode non-@acronym{ASCII} +group names. On the other hand, Emacs uses the value of +@code{default-file-name-coding-system} if @code{file-name-coding-system} +is @code{nil}. Normally the value of +@code{default-file-name-coding-system} is initialized according to the +locale, so you will need to do nothing if the value is suitable to +encode and decode non-@acronym{ASCII} group names. + +The value of this variable (or @code{default-file-name-coding-system}) +does not necessarily need to be the same value that is determined by +@code{gnus-group-name-charset-method-alist} and +@code{gnus-group-name-charset-group-alist}. + +If you want to subscribe to the groups spelled in Chinese but +@code{default-file-name-coding-system} is initialized by default to +@code{iso-latin-1} for example, that is the most typical case where you +have to set @code{nnmail-pathname-coding-system} even if you are an +Emacs user. The @code{utf-8} coding system is a good candidate for it. +Otherwise, you may change the locale in your system so that +@code{default-file-name-coding-system} may be initialized to an +appropriate value, instead of specifying this variable. +@end table + +Note that when you copy or move articles from a non-@acronym{ASCII} +group to another group, the charset used to encode and decode group +names should be the same in both groups. Otherwise the Newsgroups +header will be displayed incorrectly in the article buffer. + + @node Misc Group Stuff @section Misc Group Stuff @@ -4152,6 +4352,15 @@ in question. The corresponding back end must have a request-post method for this to work though. +@item G z +@kindex G z (Group) +@findex gnus-group-compact-group + +Compact the group under point (@code{gnus-group-compact-group}). +Currently implemented only in nnml (@pxref{Mail Spool}). This removes +gaps between article numbers, hence getting a correct total article +count. + @end table Variables for the group buffer: @@ -4179,31 +4388,6 @@ Groups matching this regexp will always be listed in the group buffer, whether they are empty or not. -@item gnus-group-name-charset-method-alist -@vindex gnus-group-name-charset-method-alist -An alist of method and the charset for group names. It is used to show -non-@acronym{ASCII} group names. - -For example: -@lisp -(setq gnus-group-name-charset-method-alist - '(((nntp "news.com.cn") . cn-gb-2312))) -@end lisp - -@item gnus-group-name-charset-group-alist -@cindex UTF-8 group names -@vindex gnus-group-name-charset-group-alist -An alist of regexp of group name and the charset for group names. It -is used to show non-@acronym{ASCII} group names. @code{((".*" -utf-8))} is the default value if UTF-8 is supported, otherwise the -default is @code{nil}. - -For example: -@lisp -(setq gnus-group-name-charset-group-alist - '(("\\.com\\.cn:" . cn-gb-2312))) -@end lisp - @end table @node Scanning New Messages @@ -4536,6 +4720,7 @@ * Asynchronous Fetching:: Gnus might be able to pre-fetch articles. * Article Caching:: You may store articles in a cache. * Persistent Articles:: Making articles expiry-resistant. +* Sticky Articles:: Article buffers that are not reused. * Article Backlog:: Having already read articles hang around. * Saving Articles:: Ways of customizing article saving. * Decoding Articles:: Gnus can treat series of (uu)encoded articles. @@ -4838,6 +5023,13 @@ @code{From} header, the value of the @code{To} or @code{Newsreader} headers are used instead. +To distinguish regular articles from those where the @code{From} field +has been swapped, a string is prefixed to the @code{To} or +@code{Newsgroups} header in the summary line. By default the string is +@samp{-> } for @code{To} and @samp{=> } for @code{Newsgroups}, you can +customize these strings with @code{gnus-summary-to-prefix} and +@code{gnus-summary-newsgroup-prefix}. + @end enumerate @vindex nnmail-extra-headers @@ -6362,6 +6554,27 @@ (@code{gnus-summary-limit-to-author}). If given a prefix, exclude matching articles. +@item / R +@kindex / R (Summary) +@findex gnus-summary-limit-to-recipient +Limit the summary buffer to articles that match some recipient +(@code{gnus-summary-limit-to-recipient}). If given a prefix, exclude +matching articles. + +@item / A +@kindex / A (Summary) +@findex gnus-summary-limit-to-address +Limit the summary buffer to articles in which contents of From, To or Cc +header match a given address (@code{gnus-summary-limit-to-address}). If +given a prefix, exclude matching articles. + +@item / S +@kindex / S (Summary) +@findex gnus-summary-limit-to-singletons +Limit the summary buffer to articles that aren't part of any displayed +threads (@code{gnus-summary-limit-to-singletons}). If given a prefix, +limit to articles that are part of displayed threads. + @item / x @kindex / x (Summary) @findex gnus-summary-limit-to-extra @@ -6427,6 +6640,13 @@ (@code{gnus-summary-limit-to-display-predicate}). @xref{Group Parameters}, for more on this predicate. +@item / r +@kindex / r (Summary) +@findex gnus-summary-limit-to-replied +Limit the summary buffer to replied articles +(@code{gnus-summary-limit-to-replied}). If given a prefix, exclude +replied articles. + @item / E @itemx M S @kindex M S (Summary) @@ -6488,6 +6708,20 @@ Insert all old articles in the summary buffer. If given a numbered prefix, fetch this number of articles. +@item / b +@kindex / b (Summary) +@findex gnus-summary-limit-to-bodies +Limit the summary buffer to articles that have bodies that match a +certain regexp (@code{gnus-summary-limit-to-bodies}). If given a +prefix, reverse the limit. This command is quite slow since it +requires selecting each article to find the matches. + +@item / h +@kindex / h (Summary) +@findex gnus-summary-limit-to-headers +Like the previous command, only limit to headers instead +(@code{gnus-summary-limit-to-headers}). + @end table @@ -6988,6 +7222,12 @@ Make the current article the child of the marked (or previous) article (@code{gnus-summary-reparent-thread}). +@item T M-^ +@kindex T M-^ (Summary) +@findex gnus-summary-reparent-children +Make the current article the parent of the marked articles +(@code{gnus-summary-reparent-children}). + @end table The following commands are thread movement commands. They all @@ -7052,6 +7292,7 @@ @findex gnus-thread-sort-by-score @findex gnus-thread-sort-by-subject @findex gnus-thread-sort-by-author +@findex gnus-thread-sort-by-recipient @findex gnus-thread-sort-by-number @findex gnus-thread-sort-by-random @vindex gnus-thread-sort-functions @@ -7064,8 +7305,10 @@ By default, sorting is done on article numbers. Ready-made sorting predicate functions include @code{gnus-thread-sort-by-number}, -@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, -@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, +@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-recipient}, +@code{gnus-thread-sort-by-subject}, +@code{gnus-thread-sort-by-date}, +@code{gnus-thread-sort-by-score}, @code{gnus-thread-sort-by-most-recent-number}, @code{gnus-thread-sort-by-most-recent-date}, @code{gnus-thread-sort-by-random} and @@ -7103,8 +7346,7 @@ @lisp (setq gnus-thread-sort-functions - '((lambda (t1 t2) - (not (gnus-thread-sort-by-number t1 t2))) + '((not gnus-thread-sort-by-number) gnus-thread-sort-by-score)) @end lisp @@ -7141,6 +7383,8 @@ gnus-article-sort-by-subject)) @end lisp +You can define group specific sorting via @code{gnus-parameters}, +@xref{Group Parameters}. @node Asynchronous Fetching @@ -7362,6 +7606,53 @@ (setq gnus-use-cache 'passive) @end lisp +@node Sticky Articles +@section Sticky Articles +@cindex sticky articles + +When you select an article the current article buffer will be reused +according to the value of the variable +@code{gnus-single-article-buffer}. If its value is non-@code{nil} (the +default) all articles reuse the same article buffer. Else each group +has its own article buffer. + +This implies that it's not possible to have more than one article buffer +in a group at a time. But sometimes you might want to display all the +latest emails from your mother, your father, your aunt, your uncle and +your 17 cousins to coordinate the next christmas party. + +That's where sticky articles come in handy. A sticky article buffer +basically is a normal article buffer, but it won't be reused when you +select another article. You can make an article sticky with: + +@table @kbd +@item A S +@kindex A S (Summary) +@findex gnus-sticky-article +Make the current article sticky. If a prefix arg is given, ask for a +name for this sticky article buffer. +@end table + +To close a sticky article buffer you can use these commands: + +@table @kbd +@item q +@kindex q (Article) +@findex bury-buffer +Puts this sticky article buffer at the end of the list of all buffers. + +@item k +@kindex k (Article) +@findex gnus-kill-sticky-article-buffer +Kills this sticky article buffer. +@end table + +To kill all sticky article buffers you can use: + +@defun gnus-kill-sticky-article-buffers ARG +Kill all sticky article buffers. +If a prefix ARG is given, ask for confirmation. +@end defun @node Article Backlog @section Article Backlog @@ -8555,6 +8846,16 @@ @findex gnus-summary-morse-message Morse decode the article buffer (@code{gnus-summary-morse-message}). +@item W i +@kindex W i (Summary) +@findex gnus-summary-idna-message +Decode IDNA encoded domain names in the current articles. IDNA +encoded domain names looks like @samp{xn--bar}. If a string remain +unencoded after running invoking this, it is likely an invalid IDNA +string (@samp{xn--bar} is invalid). You must have GNU Libidn +(@url{http://www.gnu.org/software/libidn/}) installed for this command +to work. + @item W t @item t @kindex W t (Summary) @@ -8657,9 +8958,9 @@ Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). Quoted-Printable is one common @acronym{MIME} encoding employed when sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically -makes strings like @samp{déjà vu} look like @samp{d=E9j=E0 vu}, which -doesn't look very readable to me. Note that this is usually done -automatically by Gnus if the message in question has a +makes strings like @samp{d@'ej@`a vu} look like @samp{d=E9j=E0 vu}, +which doesn't look very readable to me. Note that this is usually +done automatically by Gnus if the message in question has a @code{Content-Transfer-Encoding} header that says that this encoding has been done. If a prefix is given, a charset will be asked for. @@ -8680,6 +8981,14 @@ common encoding employed when sending Chinese articles. It typically makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}. +@item W A +@kindex W A (Summary) +@findex gnus-article-treat-ansi-sequences +@cindex @acronym{ANSI} control sequences +Translate @acronym{ANSI} SGR control sequences into overlays or +extents (@code{gnus-article-treat-ansi-sequences}). @acronym{ANSI} +sequences are used in some Chinese hierarchies for highlighting. + @item W u @kindex W u (Summary) @findex gnus-article-unsplit-urls @@ -9307,7 +9616,7 @@ @cindex viewing attachments The following commands all understand the numerical prefix. For -instance, @kbd{3 b} means ``view the third @acronym{MIME} part''. +instance, @kbd{3 K v} means ``view the third @acronym{MIME} part''. @table @kbd @item b @@ -9320,6 +9629,21 @@ @kindex K o (Summary) Save the @acronym{MIME} part. +@item K O +@kindex K O (Summary) +Prompt for a file name, then save the @acronym{MIME} part and strip it +from the article. The stripped @acronym{MIME} object will be referred +via the message/external-body @acronym{MIME} type. + +@item K r +@kindex K r (Summary) +Replace the @acronym{MIME} part with an external body. + +@item K d +@kindex K d (Summary) +Delete the @acronym{MIME} part and add some information about the +removed part. + @item K c @kindex K c (Summary) Copy the @acronym{MIME} part. @@ -9677,6 +10001,11 @@ @findex gnus-summary-sort-by-author Sort by author (@code{gnus-summary-sort-by-author}). +@item C-c C-s C-t +@kindex C-c C-s C-t (Summary) +@findex gnus-summary-sort-by-recipient +Sort by recipient (@code{gnus-summary-sort-by-recipient}). + @item C-c C-s C-s @kindex C-c C-s C-s (Summary) @findex gnus-summary-sort-by-subject @@ -10401,6 +10730,18 @@ Search through all previous (raw) articles for a regexp (@code{gnus-summary-search-article-backward}). +@item M-S +@kindex M-S (Summary) +@findex gnus-summary-repeat-search-article-forward +Repeat the previous search forwards +(@code{gnus-summary-repeat-search-article-forward}). + +@item M-R +@kindex M-R (Summary) +@findex gnus-summary-repeat-search-article-backward +Repeat the previous search backwards +(@code{gnus-summary-repeat-search-article-backward}). + @item & @kindex & (Summary) @findex gnus-summary-execute-command @@ -10442,6 +10783,12 @@ Pull all dormant articles (for the current group) into the summary buffer (@code{gnus-summary-insert-dormant-articles}). +@item Y t +@kindex Y t (Summary) +@findex gnus-summary-insert-ticked-articles +Pull all ticked articles (for the current group) into the summary buffer +(@code{gnus-summary-insert-ticked-articles}). + @end table @@ -10464,6 +10811,28 @@ some format, you @kbd{C-d} and read these messages in a more convenient fashion. +@vindex gnus-auto-select-on-ephemeral-exit +The variable @code{gnus-auto-select-on-ephemeral-exit} controls what +article should be selected after exiting a digest group. Valid values +include: + +@table @code +@item next +Select the next article. + +@item next-unread +Select the next unread article. + +@item next-noselect +Move the cursor to the next article. This is the default. + +@item next-unread-noselect +Move the cursor to the next unread article. +@end table + +If it has any other value or there is no next (unread) article, the +article selected before entering to the digest group will appear. + @item C-M-d @kindex C-M-d (Summary) @findex gnus-summary-read-document @@ -10562,6 +10931,12 @@ Mark all articles as read and go to the next group (@code{gnus-summary-catchup-and-goto-next-group}). +@item Z p +@kindex Z p (Summary) +@findex gnus-summary-catchup-and-goto-prev-group +Mark all articles as read and go to the previous group +(@code{gnus-summary-catchup-and-goto-prev-group}). + @item Z R @itemx C-x C-s @kindex Z R (Summary) @@ -10891,7 +11266,7 @@ @item C-c C-n a @kindex C-c C-n a (Summary) -@findex gnus-mailing-list-owner +@findex gnus-mailing-list-archive Browse the mailing list archive, if List-Archive field exists. @end table @@ -11111,6 +11486,13 @@ message/external-body @acronym{MIME} type. (@code{gnus-mime-save-part-and-strip}). +@findex gnus-mime-replace-part +@item r (Article) +@kindex r (Article) +Prompt for a file name, replace the @acronym{MIME} object with an +external body refering to the file via the message/external-body +@acronym{MIME} type. (@code{gnus-mime-replace-part}). + @findex gnus-mime-delete-part @item d (Article) @kindex d (Article) @@ -11118,11 +11500,16 @@ information about the removed @acronym{MIME} object (@code{gnus-mime-delete-part}). +@c FIXME: gnus-auto-select-part should be documented here + @findex gnus-mime-copy-part @item c (Article) @kindex c (Article) Copy the @acronym{MIME} object to a fresh buffer and display this buffer -(@code{gnus-mime-copy-part}). Compressed files like @file{.gz} and +(@code{gnus-mime-copy-part}). If given a prefix, copy the raw contents +without decoding. If given a numerical prefix, you can do semi-manual +charset stuff (see @code{gnus-summary-show-article-charset-alist} in +@ref{Paging the Article}). Compressed files like @file{.gz} and @file{.bz2} are automatically decompressed if @code{auto-compression-mode} is enabled (@pxref{Compressed Files,, Accessing Compressed Files, emacs, The Emacs Editor}). @@ -11142,7 +11529,10 @@ the raw contents without decoding. If given a numerical prefix, you can do semi-manual charset stuff (see @code{gnus-summary-show-article-charset-alist} in @ref{Paging the -Article}). +Article}). Compressed files like @file{.gz} and @file{.bz2} are +automatically decompressed depending on @code{jka-compr} regardless of +@code{auto-compression-mode} (@pxref{Compressed Files,, Accessing +Compressed Files, emacs, The Emacs Editor}). @findex gnus-mime-view-part-internally @item E (Article) @@ -11217,7 +11607,10 @@ @code{head}: Do the treatment on the headers. @item -@code{last}: Do this treatment on the last part. +@code{first}: Do this treatment on the first body part. + +@item +@code{last}: Do this treatment on the last body part. @item An integer: Do this treatment on all body parts that have a length less @@ -11322,7 +11715,7 @@ @item gnus-treat-overstrike (t, integer) @item gnus-treat-strip-cr (t, integer) @item gnus-treat-strip-headers-in-body (t, integer) -@item gnus-treat-strip-leading-blank-lines (t, integer) +@item gnus-treat-strip-leading-blank-lines (t, first, integer) @item gnus-treat-strip-multiple-blank-lines (t, integer) @item gnus-treat-strip-pem (t, last, integer) @item gnus-treat-strip-trailing-blank-lines (t, last, integer) @@ -11403,6 +11796,7 @@ @item gnus-treat-play-sounds @vindex gnus-treat-translate @item gnus-treat-translate +@item gnus-treat-ansi-sequences (t) @vindex gnus-treat-x-pgp-sig @item gnus-treat-x-pgp-sig (head) @@ -11615,7 +12009,8 @@ @item gnus-use-idna This variable controls whether Gnus performs IDNA decoding of internationalized domain names inside @samp{From}, @samp{To} and -@samp{Cc} headers. This requires +@samp{Cc} headers. @xref{IDNA, ,IDNA,message, The Message Manual}, +for how to compose such messages. This requires @uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this variable is only enabled if you have installed it. @@ -11873,6 +12268,10 @@ Modify to suit your needs. +@vindex gnus-message-highlight-citation +If @code{gnus-message-highlight-citation} is t, different levels of +citations are highlighted like in Gnus article buffers also in message +mode buffers. @node Archived Messages @section Archived Messages @@ -11891,7 +12290,8 @@ @vindex gnus-message-archive-method @code{gnus-message-archive-method} says what virtual server Gnus is to -use to store sent messages. The default is: +use to store sent messages. The default is @code{"archive"}, and when +actually being used it is expanded into: @lisp (nnfolder "archive" @@ -11901,6 +12301,22 @@ (nnfolder-inhibit-expiry t)) @end lisp +@quotation +@vindex gnus-update-message-archive-method +Note: a server like this is saved in the @file{~/.newsrc.eld} file first +so that it may be used as a real method of the server which is named +@code{"archive"} (that is, for the case where +@code{gnus-message-archive-method} is set to @code{"archive"}) ever +since. If it once has been saved, it will never be updated by default +even if you change the value of @code{gnus-message-archive-method} +afterward. Therefore, the server @code{"archive"} doesn't necessarily +mean the @code{nnfolder} server like this at all times. If you want the +saved method to reflect always the value of +@code{gnus-message-archive-method}, set the +@code{gnus-update-message-archive-method} variable to a non-@code{nil} +value. The default value of this variable is @code{nil}. +@end quotation + You can, however, use any mail select method (@code{nnml}, @code{nnmbox}, etc.). @code{nnfolder} is a quite likable select method for doing this sort of thing, though. If you don't like the default @@ -12104,6 +12520,9 @@ @item @code{body} @end itemize +Note that the @code{signature-file} attribute honors the variable +@code{message-signature-directory}. + The attribute name can also be a string or a symbol. In that case, this will be used as a header name, and the value will be inserted in the headers of the article; if the value is @code{nil}, the header @@ -12535,6 +12954,15 @@ (@code{gnus-server-regenerate-server}). This can be useful if you have a mail back end that has gotten out of sync. +@item z +@kindex z (Server) +@findex gnus-server-compact-server + +Compact all groups in the server under point +(@code{gnus-server-compact-server}). Currently implemented only in +nnml (@pxref{Mail Spool}). This removes gaps between article numbers, +hence getting a correct total article count. + @end table @@ -12616,7 +13044,19 @@ (nntp-via-rlogin-command "ssh") @end lisp -See also @code{nntp-via-rlogin-command-switches}. +See also @code{nntp-via-rlogin-command-switches}. Here's an example for +an indirect connection: +@lisp +(setq gnus-select-method + '(nntp "indirect" + (nntp-address "news.server.example") + (nntp-via-user-name "intermediate_user_name") + (nntp-via-address "intermediate.host.example") + (nntp-via-rlogin-command "ssh") + (nntp-end-of-line "\n") + (nntp-via-rlogin-command-switches ("-C" "-t" "-e" "none")) + (nntp-open-connection-function nntp-open-via-rlogin-and-telnet))) +@end lisp If you're behind a firewall, but have direct access to the outside world through a wrapper command like "runsocks", you could open a socksified @@ -13006,9 +13446,9 @@ It is possible to customize how the connection to the nntp server will be opened. If you specify an @code{nntp-open-connection-function} parameter, Gnus will use that function to establish the connection. -Six pre-made functions are supplied. These functions can be grouped in -two categories: direct connection functions (four pre-made), and -indirect ones (two pre-made). +Seven pre-made functions are supplied. These functions can be grouped +in two categories: direct connection functions (four pre-made), and +indirect ones (three pre-made). @item nntp-never-echoes-commands @vindex nntp-never-echoes-commands @@ -13049,6 +13489,7 @@ * 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 @@ -13158,6 +13599,41 @@ host. @end table +Note that you may want to change the value for @code{nntp-end-of-line} +to @samp{\n} (@pxref{Common Variables}). + +@item nntp-open-via-rlogin-and-netcat +@findex nntp-open-via-rlogin-and-netcat +Does essentially the same, but uses +@uref{http://netcat.sourceforge.net/, netcat} instead of @samp{telnet} +to connect to the real @acronym{NNTP} server from the intermediate host. + +@code{nntp-open-via-rlogin-and-netcat}-specific variables: + +@table @code +@item nntp-via-netcat-command +@vindex nntp-via-netcat-command +Command used to connect to the real @acronym{NNTP} server from the +intermediate host. The default is @samp{nc}. You can also use other +programs like @uref{http://www.imasy.or.jp/~gotoh/ssh/connect.html, +connect} instead. + +@item nntp-via-netcat-switches +@vindex nntp-via-netcat-switches +List of strings to be used as the switches to the +@code{nntp-via-telnet-command} command. The default is @code{nil}. + +@item nntp-via-rlogin-command +@vindex nntp-via-rlogin-command +Command used to log in on the intermediate host. The default is +@samp{rsh}, but @samp{ssh} is a popular alternative. + +@item nntp-via-rlogin-command-switches +@vindex nntp-via-rlogin-command-switches +List of strings to be used as the switches to +@code{nntp-via-rlogin-command}. The default is @code{nil}. +@end table + @item nntp-open-via-telnet-and-telnet @findex nntp-open-via-telnet-and-telnet Does essentially the same, but uses @samp{telnet} instead of @@ -13193,6 +13669,8 @@ @end table +Note that you may want to change the value for @code{nntp-end-of-line} +to @samp{\n} (@pxref{Common Variables}). @end table @@ -13247,7 +13725,7 @@ @vindex nntp-end-of-line String to use as end-of-line marker when talking to the @acronym{NNTP} server. This is @samp{\r\n} by default, but should be @samp{\n} when -using a non native connection function. +using a non native telnet connection function. @item nntp-telnet-command @vindex nntp-telnet-command @@ -13263,6 +13741,52 @@ @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 @@ -13926,7 +14450,9 @@ ssh %s imapd @end example -The valid format specifier characters are: +Make sure nothing is interfering with the output of the program, e.g., +don't forget to redirect the error output to the void. The valid format +specifier characters are: @table @samp @item s @@ -14342,7 +14868,7 @@ The buffer is narrowed to the message in question when @var{function} is run. That's why @code{(widen)} needs to be called after @code{save-excursion} and @code{save-restriction} in the example -above. Also note that with the nnimap backend, message bodies will +above. Also note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that (@pxref{Splitting in IMAP}). @@ -14956,12 +15482,16 @@ @findex nnmail-remove-tabs Translate all @samp{TAB} characters into @samp{SPACE} characters. -@item nnmail-fix-eudora-headers -@findex nnmail-fix-eudora-headers +@item nnmail-ignore-broken-references +@findex nnmail-ignore-broken-references +@c @findex nnmail-fix-eudora-headers @cindex Eudora -Eudora produces broken @code{References} headers, but OK -@code{In-Reply-To} headers. This function will get rid of the -@code{References} headers. +@cindex Pegasus +Some mail user agents (e.g. Eudora and Pegasus) produce broken +@code{References} headers, but correct @code{In-Reply-To} headers. This +function will get rid of the @code{References} header if the headers +contain a line matching the regular expression +@code{nnmail-broken-references-mailers}. @end table @@ -15186,7 +15716,7 @@ 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 is usually stored in the @code{.marks} file (but see +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 @@ -15245,7 +15775,18 @@ @item nnml-use-compressed-files @vindex nnml-use-compressed-files If non-@code{nil}, @code{nnml} will allow using compressed message -files. +files. This requires @code{auto-compression-mode} to be enabled +(@pxref{Compressed Files, ,Compressed Files, emacs, The Emacs Manual}). +If the value of @code{nnml-use-compressed-files} is a string, it is used +as the file extension specifying the compression program. You can set it +to @samp{.bz2} if your Emacs supports it. A value of @code{t} is +equivalent to @samp{.gz}. + +@item nnml-compressed-files-size-threshold +@vindex nnml-compressed-files-size-threshold +Default size threshold for compressed message files. Message files with +bodies larger than that many characters will be automatically compressed +if @code{nnml-use-compressed-files} is non-@code{nil}. @end table @@ -15958,7 +16499,7 @@ If the search engine changes its output substantially, @code{nnweb} won't be able to parse it and will fail. One could hardly fault the Web -providers if they were to do this---their @emph{raison d'être} is to +providers if they were to do this---their @emph{raison d'@^etre} is to make money off of advertisements, not to provide services to the community. Since @code{nnweb} washes the ads off all the articles, one might think that the providers might be somewhat miffed. We'll see. @@ -16238,6 +16779,15 @@ @code{mm-universal-coding-system} (which defaults to @code{emacs-mule} in Emacs or @code{escape-quoted} in XEmacs). +@item nnrss-ignore-article-fields +@vindex nnrss-ignore-article-fields +Some feeds update constantly article fields during their publications, +e.g. to indicate the number of comments. However, if there is +a difference between the local article and the distant one, the latter +is considered to be new. To avoid this and discard some fields, set this +variable to the list of fields to be ignored. The default is +@code{'(slash:comments)}. + @item nnrss-use-local @vindex nnrss-use-local @findex nnrss-generate-download-script @@ -16275,7 +16825,7 @@ @lisp (require 'browse-url) -(defun browse-nnrss-url( arg ) +(defun browse-nnrss-url (arg) (interactive "p") (let ((url (assq nnrss-url-field (mail-header-extra @@ -16529,8 +17079,10 @@ @vindex imap-shell-program @vindex imap-shell-host -For @acronym{IMAP} connections using the @code{shell} stream, the variable -@code{imap-shell-program} specify what program to call. +For @acronym{IMAP} connections using the @code{shell} stream, the +variable @code{imap-shell-program} specify what program to call. Make +sure nothing is interfering with the output of the program, e.g., don't +forget to redirect the error output to the void. @item nnimap-authenticator @vindex nnimap-authenticator @@ -16709,6 +17261,30 @@ if you get a lot of email within a week, setting this variable will cause a lot of network traffic between Gnus and the IMAP server. +@item nnimap-logout-timeout +@vindex nnimap-logout-timeout + +There is a case where a connection to a @acronym{IMAP} server is unable +to close, when connecting to the server via a certain kind of network, +e.g. @acronym{VPN}. In that case, it will be observed that a connection +between Emacs and the local network looks alive even if the server has +closed a connection for some reason (typically, a timeout). +Consequently, Emacs continues waiting for a response from the server for +the @code{LOGOUT} command that Emacs sent, or hangs in other words. If +you are in such a network, setting this variable to a number of seconds +will be helpful. If it is set, a hung connection will be closed +forcibly, after this number of seconds from the time Emacs sends the +@code{LOGOUT} command. It should not be too small value but too large +value will be inconvenient too. Perhaps the value 1.0 will be a good +candidate but it might be worth trying some other values. + +Example server specification: + +@lisp +(nnimap "mail.server.com" + (nnimap-logout-timeout 1.0)) +@end lisp + @end table @menu @@ -18350,7 +18926,8 @@ reading news on a machine. Setting up Gnus as an ``offline'' newsreader is quite simple. In -fact, you don't even have to configure anything. +fact, you don't have to configure anything as the agent is now enabled +by default (@pxref{Agent Variables, gnus-agent}). Of course, to use it as such, you have to learn a few new commands. @@ -18362,6 +18939,7 @@ * Agent as Cache:: The Agent is a big cache too. * Agent Expiry:: How to make old articles go away. * Agent Regeneration:: How to recover from lost connections and other accidents. +* Agent and flags:: How the Agent maintains flags. * Agent and IMAP:: How to use the Agent with @acronym{IMAP}. * Outgoing Messages:: What happens when you post/mail something? * Agent Variables:: Customizing is fun. @@ -18526,55 +19104,46 @@ @cindex Agent Parameters @table @code -@item gnus-agent-cat-name -The name of the category. - -@item gnus-agent-cat-groups +@item agent-groups The list of groups that are in this category. -@item gnus-agent-cat-predicate +@item agent-predicate A predicate which (generally) gives a rough outline of which articles are eligible for downloading; and -@item gnus-agent-cat-score-file +@item agent-score a score rule which (generally) gives you a finer granularity when deciding what articles to download. (Note that this @dfn{download score} is not necessarily related to normal scores.) -@item gnus-agent-cat-enable-expiration +@item agent-enable-expiration a boolean indicating whether the agent should expire old articles in this group. Most groups should be expired to conserve disk space. In fact, its probably safe to say that the gnus.* hierarchy contains the only groups that should not be expired. -@item gnus-agent-cat-days-until-old +@item agent-days-until-old an integer indicating the number of days that the agent should wait before deciding that a read article is safe to expire. -@item gnus-agent-cat-low-score +@item agent-low-score an integer that overrides the value of @code{gnus-agent-low-score}. -@item gnus-agent-cat-high-score +@item agent-high-score an integer that overrides the value of @code{gnus-agent-high-score}. -@item gnus-agent-cat-length-when-short +@item agent-short-article an integer that overrides the value of @code{gnus-agent-short-article}. -@item gnus-agent-cat-length-when-long +@item agent-long-article an integer that overrides the value of @code{gnus-agent-long-article}. -@c @item gnus-agent-cat-disable-undownloaded-faces -@c a symbol indicating whether the summary buffer should @emph{not} display -@c undownloaded articles using the gnus-summary-*-undownloaded-face -@c faces. The symbol nil will enable the use of undownloaded faces while -@c all other symbols disable them. - -@item gnus-agent-cat-enable-undownloaded-faces +@item agent-enable-undownloaded-faces a symbol indicating whether the summary buffer should display -undownloaded articles using the gnus-summary-*-undownloaded-face -faces. The symbol nil will disable the use of undownloaded faces while -all other symbols enable them. +undownloaded articles using the @code{gnus-summary-*-undownloaded-face} +faces. Any symbol other than @code{nil} will enable the use of +undownloaded faces. @end table The name of a category can not be changed once the category has been @@ -19079,9 +19648,9 @@ @item J s @kindex J s (Agent Summary) -@findex gnus-agent-fetch-series +@findex gnus-agent-summary-fetch-series Download all processable articles in this group. -(@code{gnus-agent-fetch-series}). +(@code{gnus-agent-summary-fetch-series}). @item J u @kindex J u (Agent Summary) @@ -19157,21 +19726,28 @@ each time you visit it or to minimize your connection time), the undownloaded face will probably seem like a good idea. The reason being that you do all of our work (marking, reading, deleting) with -downloaded articles so the normal faces always appear. - -For occasional Agent users, the undownloaded faces may appear to be an -absolutely horrible idea. The issue being that, since most of their -articles have not been fetched into the Agent, most of the normal -faces will be obscured by the undownloaded faces. If this is your -situation, you have two choices available. First, you can completely -disable the undownload faces by customizing -@code{gnus-summary-highlight} to delete the three cons-cells that -refer to the @code{gnus-summary-*-undownloaded-face} faces. Second, -if you prefer to take a more fine-grained approach, you may set the -@code{agent-disable-undownloaded-faces} group parameter to @code{t}. -This parameter, like all other agent parameters, may be set on an -Agent Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic -Parameters}), or an individual group (@pxref{Group Parameters}). +downloaded articles so the normal faces always appear. For those +users using the agent to improve online performance by caching the NOV +database (most users since 5.10.2), the undownloaded faces may appear +to be an absolutely horrible idea. The issue being that, since none +of their articles have been fetched into the Agent, all of the +normal faces will be obscured by the undownloaded faces. + +If you would like to use the undownloaded faces, you must enable the +undownloaded faces by setting the @code{agent-enable-undownloaded-faces} +group parameter to @code{t}. This parameter, like all other agent +parameters, may be set on an Agent Category (@pxref{Agent Categories}), +a Group Topic (@pxref{Topic Parameters}), or an individual group +(@pxref{Group Parameters}). + +The one problem common to all users using the agent is how quickly it +can consume disk space. If you using the agent on many groups, it is +even more difficult to effectively recover disk space. One solution +is the @samp{%F} format available in @code{gnus-group-line-format}. +This format will display the actual disk space used by articles +fetched into both the agent and cache. By knowing which groups use +the most space, users know where to focus their efforts when ``agent +expiring'' articles. @node Agent as Cache @subsection Agent as Cache @@ -19267,23 +19843,19 @@ are stored locally. An optional argument will mark articles in the agent as unread. -@node Agent and IMAP -@subsection Agent and IMAP - -The Agent works with any Gnus back end, including nnimap. However, -since there are some conceptual differences between @acronym{NNTP} and -@acronym{IMAP}, this section (should) provide you with some information to -make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client. - -The first thing to keep in mind is that all flags (read, ticked, etc) -are kept on the @acronym{IMAP} server, rather than in @file{.newsrc} as is the -case for nntp. Thus Gnus need to remember flag changes when -disconnected, and synchronize these flags when you plug back in. - -Gnus keeps track of flag changes when reading nnimap groups under the -Agent. When you plug back in, Gnus will check if you have any changed -any flags and ask if you wish to synchronize these with the server. -The behavior is customizable by @code{gnus-agent-synchronize-flags}. +@node Agent and flags +@subsection Agent and flags + +The Agent works with any Gnus back end including those, such as +nnimap, that store flags (read, ticked, etc) on the server. Sadly, +the Agent does not actually know which backends keep their flags in +the backend server rather than in @file{.newsrc}. This means that the +Agent, while unplugged or disconnected, will always record all changes +to the flags in its own files. + +When you plug back in, Gnus will then check to see if you have any +changed any flags and ask if you wish to synchronize these with the +server. This behavior is customizable by @code{gnus-agent-synchronize-flags}. @vindex gnus-agent-synchronize-flags If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will @@ -19297,6 +19869,23 @@ @code{gnus-agent-synchronize-flags} command that is bound to @kbd{J Y} in the group buffer. +Technical note: the synchronization algorithm does not work by ``pushing'' +all local flags to the server, but rather by incrementally updated the +server view of flags by changing only those flags that were changed by +the user. Thus, if you set one flag on an article, quit the group then +re-select the group and remove the flag; the flag will be set and +removed from the server when you ``synchronize''. The queued flag +operations can be found in the per-server @code{flags} file in the Agent +directory. It's emptied when you synchronize flags. + +@node Agent and IMAP +@subsection Agent and IMAP + +The Agent works with any Gnus back end, including nnimap. However, +since there are some conceptual differences between @acronym{NNTP} and +@acronym{IMAP}, this section (should) provide you with some information to +make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client. + Some things are currently not implemented in the Agent that you'd might expect from a disconnected @acronym{IMAP} client, including: @@ -19310,34 +19899,43 @@ @end itemize -Technical note: the synchronization algorithm does not work by ``pushing'' -all local flags to the server, but rather incrementally update the -server view of flags by changing only those flags that were changed by -the user. Thus, if you set one flag on an article, quit the group and -re-select the group and remove the flag; the flag will be set and -removed from the server when you ``synchronize''. The queued flag -operations can be found in the per-server @code{flags} file in the Agent -directory. It's emptied when you synchronize flags. - - @node Outgoing Messages @subsection Outgoing Messages -When Gnus is unplugged, all outgoing messages (both mail and news) are -stored in the draft group ``queue'' (@pxref{Drafts}). You can view -them there after posting, and edit them at will. - -When Gnus is plugged again, you can send the messages either from the -draft group with the special commands available there, or you can use -the @kbd{J S} command in the group buffer to send all the sendable -messages in the draft group. - - +By default, when Gnus is unplugged, all outgoing messages (both mail +and news) are stored in the draft group ``queue'' (@pxref{Drafts}). +You can view them there after posting, and edit them at will. + +You can control the circumstances under which outgoing mail is queued +(see @code{gnus-agent-queue-mail}, @pxref{Agent Variables}). Outgoing +news is always queued when Gnus is unplugged, and never otherwise. + +You can send the messages either from the draft group with the special +commands available there, or you can use the @kbd{J S} command in the +group buffer to send all the sendable messages in the draft group. +Posting news will only work when Gnus is plugged, but you can send +mail at any time. + +If sending mail while unplugged does not work for you and you worry +about hitting @kbd{J S} by accident when unplugged, you can have Gnus +ask you to confirm your action (see +@code{gnus-agent-prompt-send-queue}, @pxref{Agent Variables}). @node Agent Variables @subsection Agent Variables @table @code +@item gnus-agent +@vindex gnus-agent +Is the agent enabled? The default is @code{t}. When first enabled, +the agent will use @code{gnus-agent-auto-agentize-methods} to +automatically mark some back ends as agentized. You may change which +back ends are agentized using the agent commands in the server buffer. + +To enter the server buffer, use the @kbd{^} +(@code{gnus-group-enter-server-mode}) command in the group buffer. + + @item gnus-agent-directory @vindex gnus-agent-directory Where the Gnus Agent will store its files. The default is @@ -19384,6 +19982,14 @@ thing to do as the newly downloaded article has obviously not been read. The default is @code{t}. +@item gnus-agent-synchronize-flags +@vindex gnus-agent-synchronize-flags +If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will +never automatically synchronize flags. If it is @code{ask}, which is +the default, the Agent will check if you made any changes and if so +ask if you wish to synchronize these when you re-connect. If it has +any other value, all flags will be synchronized automatically. + @item gnus-agent-consider-all-articles @vindex gnus-agent-consider-all-articles If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the @@ -19432,13 +20038,26 @@ ignores articles that have not been fetched), @code{unfetched} (maneuvering ignores articles whose headers have not been fetched). +@item gnus-agent-queue-mail +@vindex gnus-agent-queue-mail +When @code{gnus-agent-queue-mail} is @code{always}, Gnus will always +queue mail rather than sending it straight away. When @code{t}, Gnus +will queue mail when unplugged only. When @code{nil}, never queue +mail. The default is @code{t}. + +@item gnus-agent-prompt-send-queue +@vindex gnus-agent-prompt-send-queue +When @code{gnus-agent-prompt-send-queue} is non-@code{nil} Gnus will +prompt you to confirm that you really wish to proceed if you hit +@kbd{J S} while unplugged. The default is @code{nil}. + @item gnus-agent-auto-agentize-methods @vindex gnus-agent-auto-agentize-methods If you have never used the Agent before (or more technically, if @file{~/News/agent/lib/servers} does not exist), Gnus will automatically agentize a few servers for you. This variable control -which backends should be auto-agentized. It is typically only useful -to agentize remote backends. The auto-agentizing has the same effect +which back ends should be auto-agentized. It is typically only useful +to agentize remote back ends. The auto-agentizing has the same effect as running @kbd{J a} on the servers (@pxref{Server Agent Commands}). If the file exist, you must manage the servers manually by adding or removing them, this variable is only applicable the first time you @@ -19578,7 +20197,6 @@ * Global Score Files:: Earth-spanning, ear-splitting score files. * Kill Files:: They are still here, but they can be ignored. * Converting Kill Files:: Translating kill files to score files. -* GroupLens:: Getting predictions on what you like to read. * Advanced Scoring:: Using logical expressions to build score rules. * Score Decays:: It can be useful to let scores wither away. @end menu @@ -19849,6 +20467,12 @@ @table @kbd +@item W e +@kindex W e (Group) +@findex gnus-score-edit-all-score +Edit the apply-to-all-groups all.SCORE file. You will be popped into +a @code{gnus-score-mode} buffer (@pxref{Score File Editing}). + @item W f @kindex W f (Group) @findex gnus-score-flush-cache @@ -20453,6 +21077,11 @@ group name with @code{gnus-adaptive-file-suffix} appended. The default is @file{ADAPT}. +@vindex gnus-adaptive-pretty-print +Adaptive score files can get huge and are not meant to be edited by +human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the +deafult) those files will not be written in a human readable way. + @vindex gnus-score-exact-adapt-limit When doing adaptive scoring, substring or fuzzy matching would probably give you the best results in most cases. However, if the header one @@ -20705,6 +21334,13 @@ See? Simple. +@vindex gnus-inhibit-slow-scoring +You can inhibit scoring the slow scoring on headers or body by setting +the variable @code{gnus-inhibit-slow-scoring}. If +@code{gnus-inhibit-slow-scoring} is regexp, slow scoring is inhibited if +the group matches the regexp. If it is t, slow scoring on it is +inhibited for all groups. + @node Scoring Tips @section Scoring Tips @@ -20967,205 +21603,6 @@ before. -@node GroupLens -@section GroupLens -@cindex GroupLens - -@sc{Note:} Unfortunately the GroupLens system seems to have shut down, -so this section is mostly of historical interest. - -@uref{http://www.cs.umn.edu/Research/GroupLens/, GroupLens} is a -collaborative filtering system that helps you work together with other -people to find the quality news articles out of the huge volume of -news articles generated every day. - -To accomplish this the GroupLens system combines your opinions about -articles you have already read with the opinions of others who have done -likewise and gives you a personalized prediction for each unread news -article. Think of GroupLens as a matchmaker. GroupLens watches how you -rate articles, and finds other people that rate articles the same way. -Once it has found some people you agree with it tells you, in the form -of a prediction, what they thought of the article. You can use this -prediction to help you decide whether or not you want to read the -article. - -@menu -* Using GroupLens:: How to make Gnus use GroupLens. -* Rating Articles:: Letting GroupLens know how you rate articles. -* Displaying Predictions:: Displaying predictions given by GroupLens. -* GroupLens Variables:: Customizing GroupLens. -@end menu - - -@node Using GroupLens -@subsection Using GroupLens - -To use GroupLens you must register a pseudonym with your local -@uref{http://www.cs.umn.edu/Research/GroupLens/bbb.html, Better Bit -Bureau (BBB)} is the only better bit in town at the moment. - -Once you have registered you'll need to set a couple of variables. - -@table @code - -@item gnus-use-grouplens -@vindex gnus-use-grouplens -Setting this variable to a non-@code{nil} value will make Gnus hook into -all the relevant GroupLens functions. - -@item grouplens-pseudonym -@vindex grouplens-pseudonym -This variable should be set to the pseudonym you got when registering -with the Better Bit Bureau. - -@item grouplens-newsgroups -@vindex grouplens-newsgroups -A list of groups that you want to get GroupLens predictions for. - -@end table - -That's the minimum of what you need to get up and running with GroupLens. -Once you've registered, GroupLens will start giving you scores for -articles based on the average of what other people think. But, to get -the real benefit of GroupLens you need to start rating articles -yourself. Then the scores GroupLens gives you will be personalized for -you, based on how the people you usually agree with have already rated. - - -@node Rating Articles -@subsection Rating Articles - -In GroupLens, an article is rated on a scale from 1 to 5, inclusive. -Where 1 means something like this article is a waste of bandwidth and 5 -means that the article was really good. The basic question to ask -yourself is, ``on a scale from 1 to 5 would I like to see more articles -like this one?'' - -There are four ways to enter a rating for an article in GroupLens. - -@table @kbd - -@item r -@kindex r (GroupLens) -@findex bbb-summary-rate-article -This function will prompt you for a rating on a scale of one to five. - -@item k -@kindex k (GroupLens) -@findex grouplens-score-thread -This function will prompt you for a rating, and rate all the articles in -the thread. This is really useful for some of those long running giant -threads in rec.humor. - -@end table - -The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be -the score of the article you're reading. - -@table @kbd - -@item 1-5 n -@kindex n (GroupLens) -@findex grouplens-next-unread-article -Rate the article and go to the next unread article. - -@item 1-5 , -@kindex , (GroupLens) -@findex grouplens-best-unread-article -Rate the article and go to the next unread article with the highest score. - -@end table - -If you want to give the current article a score of 4 and then go to the -next article, just type @kbd{4 n}. - - -@node Displaying Predictions -@subsection Displaying Predictions - -GroupLens makes a prediction for you about how much you will like a -news article. The predictions from GroupLens are on a scale from 1 to -5, where 1 is the worst and 5 is the best. You can use the predictions -from GroupLens in one of three ways controlled by the variable -@code{gnus-grouplens-override-scoring}. - -@vindex gnus-grouplens-override-scoring -There are three ways to display predictions in grouplens. You may -choose to have the GroupLens scores contribute to, or override the -regular Gnus scoring mechanism. override is the default; however, some -people prefer to see the Gnus scores plus the grouplens scores. To get -the separate scoring behavior you need to set -@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the -GroupLens predictions combined with the grouplens scores set it to -@code{'override} and to combine the scores set -@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use -the combine option you will also want to set the values for -@code{grouplens-prediction-offset} and -@code{grouplens-score-scale-factor}. - -@vindex grouplens-prediction-display -In either case, GroupLens gives you a few choices for how you would like -to see your predictions displayed. The display of predictions is -controlled by the @code{grouplens-prediction-display} variable. - -The following are valid values for that variable. - -@table @code -@item prediction-spot -The higher the prediction, the further to the right an @samp{*} is -displayed. - -@item confidence-interval -A numeric confidence interval. - -@item prediction-bar -The higher the prediction, the longer the bar. - -@item confidence-bar -Numerical confidence. - -@item confidence-spot -The spot gets bigger with more confidence. - -@item prediction-num -Plain-old numeric value. - -@item confidence-plus-minus -Prediction +/- confidence. - -@end table - - -@node GroupLens Variables -@subsection GroupLens Variables - -@table @code - -@item gnus-summary-grouplens-line-format -The summary line format used in GroupLens-enhanced summary buffers. It -accepts the same specs as the normal summary line format (@pxref{Summary -Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-23,23n%]%) -%s\n}. - -@item grouplens-bbb-host -Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the -default. - -@item grouplens-bbb-port -Port of the host running the bbbd server. The default is 9000. - -@item grouplens-score-offset -Offset the prediction by this value. In other words, subtract the -prediction value by this number to arrive at the effective score. The -default is 0. - -@item grouplens-score-scale-factor -This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset. The default is 1. - -@end table - - @node Advanced Scoring @section Advanced Scoring @@ -21366,9 +21803,12 @@ When score files are loaded and @code{gnus-decay-scores} is non-@code{nil}, Gnus will run the score files through the decaying mechanism thereby lowering the scores of all non-permanent score rules. -The decay itself if performed by the @code{gnus-decay-score-function} -function, which is @code{gnus-decay-score} by default. Here's the -definition of that function: +If @code{gnus-decay-scores} is a regexp, only score files matching this +regexp are treated. E.g. you may set it to @samp{\\.ADAPT\\'} if only +@emph{adaptive} score files should be decayed. The decay itself if +performed by the @code{gnus-decay-score-function} function, which is +@code{gnus-decay-score} by default. Here's the definition of that +function: @lisp (defun gnus-decay-score (score) @@ -21423,6 +21863,8 @@ @include sieve.texi @chapter PGG @include pgg.texi +@chapter SASL +@include sasl.texi @end iflatex @end iftex @@ -22805,6 +23247,32 @@ Face to show X-Face. The colors from this face are used as the foreground and background colors of the displayed X-Faces. The default colors are black and white. + +@item gnus-face-properties-alist +@vindex gnus-face-properties-alist +Alist of image types and properties applied to Face (@pxref{Face}) and +X-Face images. The default value is @code{((pbm . (:face gnus-x-face)) +(png . nil))} for Emacs or @code{((xface . (:face gnus-x-face)))} for +XEmacs. Here are examples: + +@lisp +;; Specify the altitude of Face and X-Face images in the From header. +(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :ascent 80)) + (png . (:ascent 80)))) + +;; Show Face and X-Face images as pressed buttons. +(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :relief -2)) + (png . (:relief -2)))) +@end lisp + +@pxref{Image Descriptors, ,Image Descriptors, elisp, The Emacs Lisp +Reference Manual} for the valid properties for various image types. +Currently, @code{pbm} is used for X-Face images and @code{png} is used +for Face images in Emacs. Only the @code{:face} property is effective +on the @code{xface} image type in XEmacs if it is built with the +@samp{libcompface} library. @end table If you use posting styles, you can use an @code{x-face-file} entry in @@ -22871,6 +23339,9 @@ See @uref{http://quimby.gnus.org/circus/face/} for the precise specifications. +The @code{gnus-face-properties-alist} variable affects the appearance of +displayed Face images. @xref{X-Face}. + Viewing an @code{Face} header requires an Emacs that is able to display PNG images. @c Maybe add this: @@ -22994,6 +23465,11 @@ @code{gnus-picon-databases} points to the directory containing the Picons databases. +@vindex gnus-picon-style +The variable @code{gnus-picon-style} controls how picons are displayed. +If @code{inline}, the textual representation is replaced. If +@code{right}, picons are added right to the textual representation. + The following variables offer control over where things are located. @table @code @@ -23360,7 +23836,7 @@ "spam")))) @end lisp -Note that with the nnimap backend, message bodies will not be +Note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that (@pxref{Splitting in IMAP}). @@ -23383,10 +23859,10 @@ @cindex hashcash A novel technique to fight spam is to require senders to do something -costly for each message they send. This has the obvious drawback that -you cannot rely on everyone in the world using this technique, -since it is not part of the Internet standards, but it may be useful -in smaller communities. +costly and demonstrably unique for each message they send. This has +the obvious drawback that you cannot rely on everyone in the world +using this technique, since it is not part of the Internet standards, +but it may be useful in smaller communities. While the tools in the previous section work well in practice, they work only because the tools are constantly maintained and updated as @@ -23402,23 +23878,19 @@ @cindex X-Hashcash The ``something costly'' is to burn CPU time, more specifically to compute a hash collision up to a certain number of bits. The -resulting hashcash cookie is inserted in a @samp{X-Hashcash:} -header. For more details, and for the external application -@code{hashcash} you need to install to use this feature, see -@uref{http://www.cypherspace.org/~adam/hashcash/}. Even more -information can be found at @uref{http://www.camram.org/}. - -If you wish to call hashcash for each message you send, say something -like: - -@lisp -(require 'hashcash) -(add-hook 'message-send-hook 'mail-add-payment) -@end lisp - -The @file{hashcash.el} library can be found in the Gnus development -contrib directory or at -@uref{http://users.actrix.gen.nz/mycroft/hashcash.el}. +resulting hashcash cookie is inserted in a @samp{X-Hashcash:} header. +For more details, and for the external application @code{hashcash} you +need to install to use this feature, see +@uref{http://www.hashcash.org/}. Even more information can be found +at @uref{http://www.camram.org/}. + +If you wish to generate hashcash for each message you send, you can +customize @code{message-generate-hashcash} (@pxref{Mail Headers, ,Mail +Headers,message, The Message Manual}), as in: + +@lisp +(setq message-generate-hashcash t) +@end lisp You will need to set up some additional variables as well: @@ -23427,8 +23899,8 @@ @item hashcash-default-payment @vindex hashcash-default-payment This variable indicates the default number of bits the hash collision -should consist of. By default this is 0, meaning nothing will be -done. Suggested useful values include 17 to 29. +should consist of. By default this is 20. Suggested useful values +include 17 to 29. @item hashcash-payment-alist @vindex hashcash-payment-alist @@ -23440,16 +23912,23 @@ @var{amount})} cells, where the @var{string} is the string to use (normally the email address or newsgroup name is used). -@item hashcash -@vindex hashcash -Where the @code{hashcash} binary is installed. - -@end table - -Currently there is no built in functionality in Gnus to verify -hashcash cookies, it is expected that this is performed by your hand -customized mail filtering scripts. Improvements in this area would be -a useful contribution, however. +@item hashcash-path +@vindex hashcash-path +Where the @code{hashcash} binary is installed. This variable should +be automatically set by @code{executable-find}, but if it's @code{nil} +(usually because the @code{hashcash} binary is not in your path) +you'll get a warning when you check hashcash payments and an error +when you generate hashcash payments. + +@end table + +Gnus can verify hashcash cookies, although this can also be done by +hand customized mail filtering scripts. To verify a hashcash cookie +in a message, use the @code{mail-check-payment} function in the +@code{hashcash.el} library. You can also use the @code{spam.el} +package with the @code{spam-use-hashcash} back end to validate hashcash +cookies in incoming mail and filter mail accordingly (@pxref{Anti-spam +Hashcash Payments}). @node Spam Package @section Spam Package @@ -23481,6 +23960,9 @@ You must read this section to understand how the Spam package works. Do not skip, speed-read, or glance through this section. +Make sure you read the section on the @code{spam.el} sequence of +events. See @xref{Extending the Spam package}. + @cindex spam-initialize @vindex spam-use-stat To use the Spam package, you @strong{must} first run the function @@ -23836,7 +24318,7 @@ @code{spam-mark-ham-unread-before-move-from-spam-group} parameter is set, the ham articles are marked as unread before being moved. -If ham can not be moved---because of a read-only backend such as +If ham can not be moved---because of a read-only back end such as @acronym{NNTP}, for example, it will be copied. Note that you can use multiples destinations per group or regular @@ -23873,7 +24355,7 @@ that if you see @samp{nntp:servername} before the group name in the group buffer then you need it here as well. -If spam can not be moved---because of a read-only backend such as +If spam can not be moved---because of a read-only back end such as @acronym{NNTP}, for example, it will be copied. Note that you can use multiples destinations per group or regular @@ -23992,7 +24474,7 @@ @end example -@subsubheading Using @file{spam.el} on an IMAP server with a statistical filter on the server +@subsubheading Using @code{spam.el} on an IMAP server with a statistical filter on the server From Reiner Steib . My provider has set up bogofilter (in combination with @acronym{DCC}) on @@ -24046,7 +24528,7 @@ In my ham folders, I just hit @kbd{S x} (@code{gnus-summary-mark-as-spam}) whenever I see an unrecognized spam mail (false negative). On group exit, those messages are moved to -@samp{training.ham}. +@samp{training.spam}. @end itemize @subsubheading Reporting spam articles in Gmane groups with @code{spam-report.el} @@ -24086,6 +24568,7 @@ * Blackholes:: * Regular Expressions Header Matching:: * Bogofilter:: +* SpamAssassin back end:: * ifile spam filtering:: * Spam Statistics Filtering:: * SpamOracle:: @@ -24138,7 +24621,7 @@ Instead of the obsolete @code{gnus-group-spam-exit-processor-blacklist}, it is recommended -that you use @code{'(spam spam-use-blacklist)}. Everything will work +that you use @code{(spam spam-use-blacklist)}. Everything will work the same way, we promise. @end defvar @@ -24150,14 +24633,13 @@ @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the -whitelist. Note that this ham processor has no effect in @emph{spam} -or @emph{unclassified} groups. +whitelist. @emph{WARNING} Instead of the obsolete @code{gnus-group-ham-exit-processor-whitelist}, it is recommended -that you use @code{'(ham spam-use-whitelist)}. Everything will work +that you use @code{(ham spam-use-whitelist)}. Everything will work the same way, we promise. @end defvar @@ -24207,6 +24689,12 @@ addresses in the BBDB will be allowed through; all others will be classified as spammers. +While @code{spam-use-BBDB-exclusive} @emph{can} be used as an alias +for @code{spam-use-BBDB} as far as @code{spam.el} is concerned, it is +@emph{not} a separate back end. If you set +@code{spam-use-BBDB-exclusive} to t, @emph{all} your BBDB splitting +will be exclusive. + @end defvar @defvar gnus-group-ham-exit-processor-BBDB @@ -24216,14 +24704,13 @@ @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the senders of ham-marked articles in @emph{ham} groups will be added to the -BBDB. Note that this ham processor has no effect in @emph{spam} -or @emph{unclassified} groups. +BBDB. @emph{WARNING} Instead of the obsolete @code{gnus-group-ham-exit-processor-BBDB}, it is recommended -that you use @code{'(ham spam-use-BBDB)}. Everything will work +that you use @code{(ham spam-use-BBDB)}. Everything will work the same way, we promise. @end defvar @@ -24250,7 +24737,7 @@ Instead of the obsolete @code{gnus-group-spam-exit-processor-report-gmane}, it is recommended -that you use @code{'(spam spam-use-gmane)}. Everything will work the +that you use @code{(spam spam-use-gmane)}. Everything will work the same way, we promise. @end defvar @@ -24261,8 +24748,15 @@ running your own news server, for instance, and the local article numbers don't correspond to the Gmane article numbers. When @code{spam-report-gmane-use-article-number} is @code{nil}, -@code{spam-report.el} will use the @code{X-Report-Spam} header that -Gmane provides. +@code{spam-report.el} will fetch the number from the article headers. + +@end defvar + +@defvar spam-report-user-mail-address + +Mail address exposed in the User-Agent spam reports to Gmane. It allows +the Gmane administrators to contact you in case of misreports. The +default is @code{user-mail-address}. @end defvar @@ -24276,12 +24770,10 @@ Similar to @code{spam-use-whitelist} (@pxref{Blacklists and Whitelists}), but uses hashcash tokens for whitelisting messages -instead of the sender address. You must have the @code{hashcash.el} -package loaded for @code{spam-use-hashcash} to work properly. -Messages without a hashcash payment token will be sent to the next -spam-split rule. This is an explicit filter, meaning that unless a -hashcash token is found, the messages are not assumed to be spam or -ham. +instead of the sender address. Messages without a hashcash payment +token will be sent to the next spam-split rule. This is an explicit +filter, meaning that unless a hashcash token is found, the messages +are not assumed to be spam or ham. @end defvar @@ -24301,7 +24793,7 @@ contains outdated servers. The blackhole check uses the @code{dig.el} package, but you can tell -@file{spam.el} to use @code{dns.el} instead for better performance if +@code{spam.el} to use @code{dns.el} instead for better performance if you set @code{spam-use-dig} to @code{nil}. It is not recommended at this time to set @code{spam-use-dig} to @code{nil} despite the possible performance improvements, because some users may be unable to @@ -24428,7 +24920,7 @@ Instead of the obsolete @code{gnus-group-spam-exit-processor-bogofilter}, it is recommended -that you use @code{'(spam spam-use-bogofilter)}. Everything will work +that you use @code{(spam spam-use-bogofilter)}. Everything will work the same way, we promise. @end defvar @@ -24438,14 +24930,13 @@ @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the ham-marked articles in @emph{ham} groups will be added to the Bogofilter database -of non-spam messages. Note that this ham processor has no effect in -@emph{spam} or @emph{unclassified} groups. +of non-spam messages. @emph{WARNING} Instead of the obsolete @code{gnus-group-ham-exit-processor-bogofilter}, it is recommended -that you use @code{'(ham spam-use-bogofilter)}. Everything will work +that you use @code{(ham spam-use-bogofilter)}. Everything will work the same way, we promise. @end defvar @@ -24464,6 +24955,59 @@ used, or has already been used on the article. The 0.9.2.1 version of Bogofilter was used to test this functionality. +@node SpamAssassin back end +@subsubsection SpamAssassin back end +@cindex spam filtering +@cindex spamassassin, spam filtering +@cindex spam + +@defvar spam-use-spamassassin + +Set this variable if you want @code{spam-split} to use SpamAssassin. + +SpamAssassin assigns a score to each article based on a set of rules +and tests, including a Bayesian filter. The Bayesian filter can be +trained by associating the @samp{$} mark for spam articles. The +spam score can be viewed by using the command @kbd{S t} in summary +mode. + +If you set this variable, each article will be processed by +SpamAssassin when @code{spam-split} is called. If your mail is +preprocessed by SpamAssassin, and you want to just use the +SpamAssassin headers, set @code{spam-use-spamassassin-headers} +instead. + +You should not enable this if you use +@code{spam-use-spamassassin-headers}. + +@end defvar + +@defvar spam-use-spamassassin-headers + +Set this variable if your mail is preprocessed by SpamAssassin and +want @code{spam-split} to split based on the SpamAssassin headers. + +You should not enable this if you use @code{spam-use-spamassassin}. + +@end defvar + +@defvar spam-spamassassin-program + +This variable points to the SpamAssassin executable. If you have +@code{spamd} running, you can set this variable to the @code{spamc} +executable for faster processing. See the SpamAssassin documentation +for more information on @code{spamd}/@code{spamc}. + +@end defvar + +SpamAssassin is a powerful and flexible spam filter that uses a wide +variety of tests to identify spam. A ham and a spam processors are +provided, plus the @code{spam-use-spamassassin} and +@code{spam-use-spamassassin-headers} variables to indicate to +spam-split that SpamAssassin should be either used, or has already +been used on the article. The 2.63 version of SpamAssassin was used +to test this functionality. + @node ifile spam filtering @subsubsection ifile spam filtering @cindex spam filtering @@ -24533,7 +25077,7 @@ Instead of the obsolete @code{gnus-group-spam-exit-processor-stat}, it is recommended -that you use @code{'(spam spam-use-stat)}. Everything will work +that you use @code{(spam spam-use-stat)}. Everything will work the same way, we promise. @end defvar @@ -24543,18 +25087,17 @@ @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the ham-marked articles in @emph{ham} groups will be added to the spam-stat database -of non-spam messages. Note that this ham processor has no effect in -@emph{spam} or @emph{unclassified} groups. +of non-spam messages. @emph{WARNING} Instead of the obsolete @code{gnus-group-ham-exit-processor-stat}, it is recommended -that you use @code{'(ham spam-use-stat)}. Everything will work +that you use @code{(ham spam-use-stat)}. Everything will work the same way, we promise. @end defvar -This enables @file{spam.el} to cooperate with @file{spam-stat.el}. +This enables @code{spam.el} to cooperate with @file{spam-stat.el}. @file{spam-stat.el} provides an internal (Lisp-only) spam database, which unlike ifile or Bogofilter does not require external programs. A spam and a ham processor, and the @code{spam-use-stat} variable for @@ -24583,7 +25126,7 @@ call SpamOracle. @vindex spam-use-spamoracle -To enable SpamOracle usage by @file{spam.el}, set the variable +To enable SpamOracle usage by @code{spam.el}, set the variable @code{spam-use-spamoracle} to @code{t} and configure the @code{nnmail-split-fancy} or @code{nnimap-split-fancy}. @xref{Spam Package}. In this example the @samp{INBOX} of an nnimap server is @@ -24641,7 +25184,7 @@ Instead of the obsolete @code{gnus-group-spam-exit-processor-spamoracle}, it is recommended -that you use @code{'(spam spam-use-spamoracle)}. Everything will work +that you use @code{(spam spam-use-spamoracle)}. Everything will work the same way, we promise. @end defvar @@ -24651,14 +25194,13 @@ @code{gnus-spam-process-newsgroups} variable. When this symbol is added to a group's @code{spam-process} parameter, the ham-marked articles in @emph{ham} groups will be sent to the SpamOracle as samples of ham -messages. Note that this ham processor has no effect in @emph{spam} or -@emph{unclassified} groups. +messages. @emph{WARNING} Instead of the obsolete @code{gnus-group-ham-exit-processor-spamoracle}, it is recommended -that you use @code{'(ham spam-use-spamoracle)}. Everything will work +that you use @code{(ham spam-use-spamoracle)}. Everything will work the same way, we promise. @end defvar @@ -24696,45 +25238,22 @@ "True if blackbox should be used.") @end lisp -Add -@lisp -(spam-use-blackbox . spam-check-blackbox) -@end lisp -to @code{spam-list-of-checks}. - -Add -@lisp -(gnus-group-ham-exit-processor-blackbox ham spam-use-blackbox) -(gnus-group-spam-exit-processor-blackbox spam spam-use-blackbox) -@end lisp - -to @code{spam-list-of-processors}. - -Add -@lisp -(spam-use-blackbox spam-blackbox-register-routine - nil - spam-blackbox-unregister-routine - nil) -@end lisp - -to @code{spam-registration-functions}. Write the register/unregister -routines using the bogofilter register/unregister routines as a -start, or other register/unregister routines more appropriate to -Blackbox. +Write @code{spam-check-blackbox} if Blackbox can check incoming mail. + +Write @code{spam-blackbox-register-routine} and +@code{spam-blackbox-unregister-routine} using the bogofilter +register/unregister routines as a start, or other restister/unregister +routines more appropriate to Blackbox, if Blackbox can +register/unregister spam and ham. @item Functionality -Write the @code{spam-check-blackbox} function. It should return -@samp{nil} or @code{spam-split-group}, observing the other -conventions. See the existing @code{spam-check-*} functions for -examples of what you can do, and stick to the template unless you -fully understand the reasons why you aren't. - -Make sure to add @code{spam-use-blackbox} to -@code{spam-list-of-statistical-checks} if Blackbox is a statistical -mail analyzer that needs the full message body to operate. +The @code{spam-check-blackbox} function should return @samp{nil} or +@code{spam-split-group}, observing the other conventions. See the +existing @code{spam-check-*} functions for examples of what you can +do, and stick to the template unless you fully understand the reasons +why you aren't. @end enumerate @@ -24749,8 +25268,8 @@ provide them if Blackbox supports spam or ham processing. Also, ham and spam processors are being phased out as single -variables. Instead the form @code{'(spam spam-use-blackbox)} or -@code{'(ham spam-use-blackbox)} is favored. For now, spam/ham +variables. Instead the form @code{(spam spam-use-blackbox)} or +@code{(ham spam-use-blackbox)} is favored. For now, spam/ham processor variables are still around but they won't be for long. @lisp @@ -24781,7 +25300,64 @@ (variable-item spam-use-blackbox) @end lisp to the @code{spam-autodetect-methods} group parameter in -@code{gnus.el}. +@code{gnus.el} if Blackbox can check incoming mail for spam contents. + +Finally, use the appropriate @code{spam-install-*-backend} function in +@code{spam.el}. Here are the available functions. + + +@enumerate + +@item +@code{spam-install-backend-alias} + +This function will simply install an alias for a back end that does +everything like the original back end. It is currently only used to +make @code{spam-use-BBDB-exclusive} act like @code{spam-use-BBDB}. + +@item +@code{spam-install-nocheck-backend} + +This function installs a back end that has no check function, but can +register/unregister ham or spam. The @code{spam-use-gmane} back end is +such a back end. + +@item +@code{spam-install-checkonly-backend} + +This function will install a back end that can only check incoming mail +for spam contents. It can't register or unregister messages. +@code{spam-use-blackholes} and @code{spam-use-hashcash} are such +back ends. + +@item +@code{spam-install-statistical-checkonly-backend} + +This function installs a statistical back end (one which requires the +full body of a message to check it) that can only check incoming mail +for contents. @code{spam-use-regex-body} is such a filter. + +@item +@code{spam-install-statistical-backend} + +This function install a statistical back end with incoming checks and +registration/unregistration routines. @code{spam-use-bogofilter} is +set up this way. + +@item +@code{spam-install-backend} + +This is the most normal back end installation, where a back end that can +check and register/unregister messages is set up without statistical +abilities. The @code{spam-use-BBDB} is such a back end. + +@item +@code{spam-install-mover-backend} + +Mover back ends are internal to @code{spam.el} and specifically move +articles around when the summary is exited. You will very probably +never install such a back end. +@end enumerate @end enumerate @@ -25140,6 +25716,17 @@ This variable works the same way as @code{gnus-verbose}, but it applies to the Gnus back ends instead of Gnus proper. +@item gnus-add-timestamp-to-message +@vindex gnus-add-timestamp-to-message +This variable controls whether to add timestamps to messages that are +controlled by @code{gnus-verbose} and @code{gnus-verbose-backends} and +are issued. The default value is @code{nil} which means never to add +timestamp. If it is @code{log}, add timestamps to only the messages +that go into the @samp{*Messages*} buffer (in XEmacs, it is the +@w{@samp{ *Message-Log*}} buffer). If it is neither @code{nil} nor +@code{log}, add timestamps not only to log messages but also to the ones +displayed in the echo area. + @item nnheader-max-head-length @vindex nnheader-max-head-length When the back ends read straight heads of articles, they all try to read @@ -25661,8 +26248,7 @@ Kim-Minh Kaplan---further work on the picon code. @item -Brad Miller---@file{gnus-gl.el} and the GroupLens manual section -(@pxref{GroupLens}). +Brad Miller---@file{gnus-gl.el} and the GroupLens manual section. @item Sudish Joseph---innumerable bug fixes. @@ -25703,7 +26289,7 @@ Kevin Davidson---came up with the name @dfn{ding}, so blame him. @item -François Pinard---many, many interesting and thorough bug reports, as +Fran@,{c}ois Pinard---many, many interesting and thorough bug reports, as well as autoconf support. @end itemize @@ -25720,7 +26306,7 @@ Jesper Harder, Paul Jarc, Simon Josefsson, -David Kågedal, +David K@aa{}gedal, Richard Pieri, Fabrice Popineau, Daniel Quinlan, @@ -25805,12 +26391,13 @@ P. E. Jareth Hein, Hisashige Kenji, @c Hisashige Scott Hofmann, +Tassilo Horn, Marc Horowitz, Gunnar Horrigmo, Richard Hoskins, Brad Howes, Miguel de Icaza, -François Felix Ingrand, +Fran@,{c}ois Felix Ingrand, Tatsuya Ichikawa, @c Ichikawa Ishikawa Ichiro, @c Ishikawa Lee Iverson, @@ -25950,6 +26537,7 @@ * 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. @end menu These lists are, of course, just @emph{short} overviews of the @@ -26109,7 +26697,7 @@ referred. @item -Gnus can make use of GroupLens predictions (@pxref{GroupLens}). +Gnus can make use of GroupLens predictions. @item Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}). @@ -26758,7 +27346,7 @@ using a wide variety of programs and filter rules. Among the supported methods are RBL blocklists, bogofilter and white/blacklists. Hooks for easy use of external packages such as SpamAssassin and Hashcash -are also new. @xref{Thwarting Email Spam}. +are also new. @ref{Thwarting Email Spam} and @ref{Spam Package}. @c FIXME: @xref{Spam Package}?. Should this be under Misc? @item @@ -27325,6 +27913,15 @@ @end itemize +@node No Gnus +@subsubsection No Gnus +@cindex No Gnus + +New features in No Gnus: +@c FIXME: Gnus 5.12? + +@include gnus-news.texi + @iftex @page @@ -28416,7 +29013,9 @@ alterations. This comes in handy if the back end really carries all the information (as is the case with virtual and imap groups). This function should destructively alter the info to suit its needs, and -should return a non-@code{nil} value. +should return a non-@code{nil} value (exceptionally, +@code{nntp-request-update-info} always returns @code{nil} not to waste +the network resources). There should be no result data from this function. diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/message.texi --- a/doc/misc/message.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/message.texi Sun Oct 28 09:18:39 2007 +0000 @@ -71,14 +71,14 @@ @c Adjust ../Makefile.in if you change the following lines: Message is distributed with Gnus. The Gnus distribution @c -corresponding to this manual is Gnus v5.11. +corresponding to this manual is No Gnus v0.7. @node Interface @chapter Interface -When a program (or a person) wants to respond to a message -- reply, -follow up, forward, cancel -- the program (or person) should just put +When a program (or a person) wants to respond to a message---reply, +follow up, forward, cancel---the program (or person) should just put point in the buffer where the message is and call the required command. @code{Message} will then pop up a new @code{message} mode buffer with appropriate headers filled out, and the user can edit the message before @@ -179,7 +179,8 @@ @vindex message-dont-reply-to-names Addresses that match the @code{message-dont-reply-to-names} regular -expression will be removed from the @code{Cc} header. +expression (or list of regular expressions) will be removed from the +@code{Cc} header. A value of @code{nil} means exclude your name only. @vindex message-wide-reply-confirm-recipients If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you @@ -257,7 +258,7 @@ ^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|@* Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@* ^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|@* -^X-Payment:}. +^X-Payment:\\|^Approved:}. @@ -797,14 +798,18 @@ @item C-c M-m @kindex C-c M-m @findex message-mark-inserted-region -Mark some region in the current article with enclosing tags. -See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. +Mark some region in the current article with enclosing tags. See +@code{message-mark-insert-begin} and @code{message-mark-insert-end}. +When called with a prefix argument, use slrn style verbatim marks +(@samp{#v+} and @samp{#v-}). @item C-c M-f @kindex C-c M-f @findex message-mark-insert-file Insert a file in the current article with enclosing tags. See @code{message-mark-insert-begin} and @code{message-mark-insert-end}. +When called with a prefix argument, use slrn style verbatim marks +(@samp{#v+} and @samp{#v-}). @end table @@ -1159,6 +1164,11 @@ @code{message-elide-ellipsis}. The default value is to use an ellipsis (@samp{[...]}). +@item C-c M-k +@kindex C-c M-k +@findex message-kill-address +Kill the address under point. + @item C-c C-z @kindex C-c C-z @findex message-kill-to-signature @@ -1244,11 +1254,13 @@ @section Mail Aliases @cindex mail aliases @cindex aliases +@cindex completion +@cindex ecomplete @vindex message-mail-alias-type The @code{message-mail-alias-type} variable controls what type of mail -alias expansion to use. Currently only one form is supported---Message -uses @code{mailabbrev} to handle mail aliases. If this variable is +alias expansion to use. Currently two forms are supported: +@code{mailabbrev} and @code{ecomplete}. If this variable is @code{nil}, no mail alias expansion will be performed. @code{mailabbrev} works by parsing the @file{/etc/mailrc} and @@ -1266,6 +1278,14 @@ No expansion will be performed upon sending of the message---all expansions have to be done explicitly. +If you're using @code{ecomplete}, all addresses from @code{To} and +@code{Cc} headers will automatically be put into the +@file{~/.ecompleterc} file. When you enter text in the @code{To} and +@code{Cc} headers, @code{ecomplete} will check out the values stored +there and ``electrically'' say what completions are possible. To +choose one of these completions, use the @kbd{M-n} command to move +down to the list. Use @kbd{M-n} and @kbd{M-p} to move down and up the +list, and @kbd{RET} to choose a completion. @node Spelling @section Spelling @@ -1334,7 +1354,7 @@ @section Message Headers Message is quite aggressive on the message generation front. It has to -be -- it's a combined news and mail agent. To be able to send combined +be---it's a combined news and mail agent. To be able to send combined messages, it has to generate all headers itself (instead of letting the mail/news system do it) to ensure that mail and news copies of messages look sufficiently similar. @@ -1373,7 +1393,7 @@ @table @code @item nil -Just the address -- @samp{king@@grassland.com}. +Just the address---@samp{king@@grassland.com}. @item parens @samp{king@@grassland.com (Elvis Parsley)}. @@ -1494,6 +1514,9 @@ '(not "From" "Subject" "To" "Cc" "Newsgroups")) @end lisp +Headers are hidden using narrowing, you can use @kbd{M-x widen} to +expose them in the buffer. + @item message-header-synonyms @vindex message-header-synonyms A list of lists of header synonyms. E.g., if this list contains a @@ -1525,6 +1548,13 @@ This string is inserted at the end of the headers in all message buffers that are initialized as mail. +@item message-generate-hashcash +@vindex message-generate-hashcash +Variable that indicates whether @samp{X-Hashcash} headers +should be computed for the message. @xref{Hashcash, ,Hashcash,gnus, +The Gnus Manual}. If @code{opportunistic}, only generate the headers +when it doesn't lead to the user having to wait. + @end table @@ -1541,10 +1571,10 @@ @findex smtpmail-send-it @findex feedmail-send-it Function used to send the current buffer as mail. The default is -@code{message-send-mail-with-sendmail}. Other valid values include +@code{message-send-mail-with-sendmail}, or @code{smtpmail-send-it} +according to the system. Other valid values include @code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail}, -@code{message-smtpmail-send-it}, @code{smtpmail-send-it} and -@code{feedmail-send-it}. +@code{message-smtpmail-send-it} and @code{feedmail-send-it}. @item message-mh-deletable-headers @vindex message-mh-deletable-headers @@ -1859,6 +1889,9 @@ Hallvard B Furuseth writes: @end example +@c FIXME: Add `message-insert-formated-citation-line' and +@c `message-citation-line-format' + Point will be at the beginning of the body of the message when this function is called. @@ -1873,21 +1906,29 @@ @cindex yanking @cindex quoting When you are replying to or following up an article, you normally want -to quote the person you are answering. Inserting quoted text is done -by @dfn{yanking}, and each line you yank will have -@code{message-yank-prefix} prepended to it (except for quoted and -empty lines which uses @code{message-yank-cited-prefix}). The default -is @samp{> }. +to quote the person you are answering. Inserting quoted text is done by +@dfn{yanking}, and each line you yank will have +@code{message-yank-prefix} prepended to it (except for quoted lines +which use @code{message-yank-cited-prefix} and empty lines which use +@code{message-yank-empty-prefix}). The default is @samp{> }. @item message-yank-cited-prefix @vindex message-yank-cited-prefix @cindex yanking @cindex cited @cindex quoting -When yanking text from an article which contains no text or already -cited text, each line will be prefixed with the contents of this -variable. The default is @samp{>}. See also -@code{message-yank-prefix}. +When yanking text from an article which contains already cited text, +each line will be prefixed with the contents of this variable. The +default is @samp{>}. See also @code{message-yank-prefix}. + +@item message-yank-empty-prefix +@vindex message-yank-empty-prefix +@cindex yanking +@cindex quoting +When yanking text from an article, each empty line will be prefixed with +the contents of this variable. The default is @samp{>}. You can set +this variable to an empty string to split the cited text into paragraphs +automatically. See also @code{message-yank-prefix}. @item message-indentation-spaces @vindex message-indentation-spaces @@ -1932,8 +1973,18 @@ @item message-signature-file @vindex message-signature-file File containing the signature to be inserted at the end of the buffer. +If a path is specified, the value of +@code{message-signature-directory} is ignored, even if set. The default is @file{~/.signature}. +@item message-signature-directory +@vindex message-signature-directory +Name of directory containing signature files. Comes in handy if you +have many such files, handled via Gnus posting styles for instance. +If @code{nil} (the default), @code{message-signature-file} is expected +to specify the directory if needed. + + @item message-signature-insert-empty-line @vindex message-signature-insert-empty-line If @code{t} (the default value) an empty line is inserted before the @@ -1968,6 +2019,13 @@ Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME} translation process. +@item message-fill-column +@vindex message-fill-column +@cindex auto-fill +Local value for the column beyond which automatic line-wrapping should +happen for message buffers. If non-nil (the default), also turn on +auto-fill in message buffers. + @item message-signature-separator @vindex message-signature-separator Regexp matching the signature separator. It is @samp{^-- *$} by @@ -2057,6 +2115,12 @@ @vindex message-mode-syntax-table Syntax table used in message mode buffers. +@item message-cite-articles-with-x-no-archive +@vindex message-cite-articles-with-x-no-archive +If non-@code{nil}, don't strip quoted text from articles that have +@samp{X-No-Archive} set. Even if this variable isn't set, you can +undo the stripping by hitting the @code{undo} keystroke. + @item message-strip-special-text-properties @vindex message-strip-special-text-properties Emacs has a number of special text properties which can break message @@ -2089,7 +2153,7 @@ @item function A function to be called if @var{predicate} returns non-@code{nil}. -@var{function} is called with one parameter -- the prefix. +@var{function} is called with one parameter---the prefix. @end table The default is: diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/pgg.texi --- a/doc/misc/pgg.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/pgg.texi Sun Oct 28 09:18:39 2007 +0000 @@ -345,11 +345,11 @@ Since PGG was designed for accessing and developing PGP functionality, the architecture had to be designed not just for interoperability but also for extensiblity. In this chapter we explore the architecture -while finding out how to write the PGG backend. +while finding out how to write the PGG back end. @menu * Initializing:: -* Backend methods:: +* Back end methods:: * Getting output:: @end menu @@ -373,12 +373,12 @@ @end lisp The name of the function must follow the -regulation---@code{pgg-make-scheme-} follows the backend name. +regulation---@code{pgg-make-scheme-} follows the back end name. -@node Backend methods -@section Backend methods +@node Back end methods +@section Back end methods -In each backend, these methods must be present. The output of these +In each back end, these methods must be present. The output of these methods is stored in special buffers (@ref{Getting output}), so that these methods must tell the status of the execution. @@ -435,7 +435,7 @@ @node Getting output @section Getting output -The output of the backend methods (@ref{Backend methods}) is stored in +The output of the back end methods (@ref{Back end methods}) is stored in special buffers, so that these methods must tell the status of the execution. diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/sasl.texi --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/doc/misc/sasl.texi Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,270 @@ +\input texinfo @c -*-texinfo-*- + +@setfilename sasl.info + +@set VERSION 0.2 + +@dircategory Emacs +@direntry +* SASL: (sasl). The Emacs SASL library. +@end direntry + +@settitle Emacs SASL Library @value{VERSION} + +@ifinfo +This file describes the Emacs SASL library. + +Copyright @copyright{} 2004, 2005, 2006 Free Software Foundation, Inc. +Copyright @copyright{} 2000 Daiki Ueno. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with no Front-Cover Texts, and with no Back-Cover +Texts. A copy of the license is included in the section entitled "GNU +Free Documentation License". +@end ifinfo + +@tex + +@titlepage +@title Emacs SASL Library + +@author by Daiki Ueno +@page + +@vskip 0pt plus 1filll +Copyright @copyright{} 2000 Daiki Ueno. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.2 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with no Front-Cover Texts, and with no Back-Cover +Texts. A copy of the license is included in the section entitled "GNU +Free Documentation License". +@end titlepage +@page + +@end tex + +@node Top +@top Emacs SASL +This manual describes the Emacs SASL library. + +A common interface to share several authentication mechanisms between +applications using different protocols. + +@menu +* Overview:: What Emacs SASL library is. +* How to use:: Adding authentication support to your applications. +* Data types:: +* Back end drivers:: Writing your own drivers. +* Index:: +* Function Index:: +* Variable Index:: +@end menu + +@node Overview +@chapter Overview + +@sc{sasl} is short for @dfn{Simple Authentication and Security Layer}. +This standard is documented in RFC2222. It provides a simple method for +adding authentication support to various application protocols. + +The toplevel interface of this library is inspired by Java @sc{sasl} +Application Program Interface. It defines an abstraction over a series +of authentication mechanism drivers (@ref{Back end drivers}). + +Back end drivers are designed to be close as possible to the +authentication mechanism. You can access the additional configuration +information anywhere from the implementation. + +@node How to use +@chapter How to use + +(Not yet written). + +To use Emacs SASL library, please evaluate following expression at the +beginning of your application program. + +@lisp +(require 'sasl) +@end lisp + +If you want to check existence of sasl.el at runtime, instead you +can list autoload settings for functions you want. + +@node Data types +@chapter Data types + +There are three data types to be used for carrying a negotiated +security layer---a mechanism, a client parameter and an authentication +step. + +@menu +* Mechanisms:: +* Clients:: +* Steps:: +@end menu + +@node Mechanisms +@section Mechanisms + +A mechanism (@code{sasl-mechanism} object) is a schema of the @sc{sasl} +authentication mechanism driver. + +@defvar sasl-mechanisms +A list of mechanism names. +@end defvar + +@defun sasl-find-mechanism mechanisms + +Retrieve an apropriate mechanism. +This function compares @var{mechanisms} and @code{sasl-mechanisms} then +returns apropriate @code{sasl-mechanism} object. + +@example +(let ((sasl-mechanisms '("CRAM-MD5" "DIGEST-MD5"))) + (setq mechanism (sasl-find-mechanism server-supported-mechanisms))) +@end example + +@end defun + +@defun sasl-mechanism-name mechanism +Return name of mechanism, a string. +@end defun + +If you want to write an authentication mechanism driver (@ref{Back end +drivers}), use @code{sasl-make-mechanism} and modify +@code{sasl-mechanisms} and @code{sasl-mechanism-alist} correctly. + +@defun sasl-make-mechanism name steps +Allocate a @code{sasl-mechanism} object. +This function takes two parameters---name of the mechanism, and a list +of authentication functions. + +@example +(defconst sasl-anonymous-steps + '(identity ;no initial response + sasl-anonymous-response)) + +(put 'sasl-anonymous 'sasl-mechanism + (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) +@end example + +@end defun + +@node Clients +@section Clients + +A client (@code{sasl-client} object) initialized with four +parameters---a mechanism, a user name, name of the service and name of +the server. + +@defun sasl-make-client mechanism name service server +Prepare a @code{sasl-client} object. +@end defun + +@defun sasl-client-mechanism client +Return the mechanism (@code{sasl-mechanism} object) of client. +@end defun + +@defun sasl-client-name client +Return the authorization name of client, a string. +@end defun + +@defun sasl-client-service client +Return the service name of client, a string. +@end defun + +@defun sasl-client-server client +Return the server name of client, a string. +@end defun + +If you want to specify additional configuration properties, please use +@code{sasl-client-set-property}. + +@defun sasl-client-set-property client property value +Add the given property/value to client. +@end defun + +@defun sasl-client-property client property +Return the value of the property of client. +@end defun + +@defun sasl-client-set-properties client plist +Destructively set the properties of client. +The second argument is the new property list. +@end defun + +@defun sasl-client-properties client +Return the whole property list of client configuration. +@end defun + +@node Steps +@section Steps + +A step (@code{sasl-step} object) is an abstraction of authentication +``step'' which holds the response value and the next entry point for the +authentication process (the latter is not accessible). + +@defun sasl-step-data step +Return the data which @var{step} holds, a string. +@end defun + +@defun sasl-step-set-data step data +Store @var{data} string to @var{step}. +@end defun + +To get the initial response, you should call the function +@code{sasl-next-step} with the second argument @code{nil}. + +@example +(setq name (sasl-mechanism-name mechanism)) +@end example + +At this point we could send the command which starts a SASL +authentication protocol exchange. For example, + +@example +(process-send-string + process + (if (sasl-step-data step) ;initial response + (format "AUTH %s %s\r\n" name (base64-encode-string (sasl-step-data step) t)) + (format "AUTH %s\r\n" name))) +@end example + +To go on with the authentication process, all you have to do is call +@code{sasl-next-step} consecutively. + +@defun sasl-next-step client step +Perform the authentication step. +At the first time @var{step} should be set to @code{nil}. +@end defun + +@node Back end drivers +@chapter Back end drivers + +(Not yet written). + +@node Index +@chapter Index +@printindex cp + +@node Function Index +@chapter Function Index +@printindex fn + +@node Variable Index +@chapter Variable Index +@printindex vr + +@summarycontents +@contents +@bye + +@c End: + +@ignore + arch-tag: dc9650be-a953-40bf-bc55-24fe5f19d875 +@end ignore diff -r b6f5dc84b2e1 -r a3c27999decb doc/misc/sieve.texi --- a/doc/misc/sieve.texi Sun Oct 28 04:58:17 2007 +0000 +++ b/doc/misc/sieve.texi Sun Oct 28 09:18:39 2007 +0000 @@ -236,9 +236,9 @@ @} @end example -A few mailing lists do not use the @samp{Sender:} header, but does -contain some unique identifier in some other header. The following is -not a complete script, it assumes that @code{fileinto} has already been +A few mailing lists do not use the @samp{Sender:} header, but has a +unique identifier in some other header. The following is not a +complete script, it assumes that @code{fileinto} has already been required. @example diff -r b6f5dc84b2e1 -r a3c27999decb etc/GNUS-NEWS --- a/etc/GNUS-NEWS Sun Oct 28 04:58:17 2007 +0000 +++ b/etc/GNUS-NEWS Sun Oct 28 09:18:39 2007 +0000 @@ -10,15 +10,16 @@ * Installation changes -** Upgrading from previous (stable) version if you have used Oort. +** Upgrading from previous (stable) version if you have used No Gnus. -If you have tried Oort (the unstable Gnus branch leading to this +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 all -`.marks' (nnml) and `.mrk' (nnfolder) files, so that flags are read from -your `.newsrc.eld' instead of from the `.marks'/`.mrk' file where this -release store flags. See a later entry for more information about -marks. Note that downgrading isn't save in general. +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. ** Lisp files are now installed in `.../site-lisp/gnus/' by default. It defaulted to `.../site-lisp/' formerly. In addition to this, the new @@ -26,493 +27,191 @@ the latest one are detected. You can then remove those shadows manually or remove them using `make remove-installed-shadows'. -** New `make.bat' for compiling and installing Gnus under MS Windows - -Use `make.bat' if you want to install Gnus under MS Windows, the first -argument to the batch-program should be the directory where `xemacs.exe' -respectively `emacs.exe' is located, if you want to install Gnus after -compiling it, give `make.bat' `/copy' as the second parameter. - -`make.bat' has been rewritten from scratch, it now features automatic -recognition of XEmacs and GNU Emacs, generates `gnus-load.el', checks if -errors occur while compilation and generation of info files and reports -them at the end of the build process. It now uses `makeinfo' if it is -available and falls back to `infohack.el' otherwise. `make.bat' should -now install all files which are necessary to run Gnus and be generally a -complete replacement for the `configure; make; make install' cycle used -under Unix systems. - -The new `make.bat' makes `make-x.bat' and `xemacs.mak' superfluous, so -they have been removed. - -** `~/News/overview/' not used. - -As a result of the following change, the `~/News/overview/' directory is -not used any more. You can safely delete the entire hierarchy. - -** `(require 'gnus-load)' - -If you use a stand-alone Gnus distribution, you'd better add `(require -'gnus-load)' into your `~/.emacs' after adding the Gnus lisp directory -into load-path. - -File `gnus-load.el' contains autoload commands, functions and variables, -some of which may not be included in distributions of Emacsen. - - * New packages and libraries within Gnus -** The revised Gnus FAQ is included in the manual, *Note Frequently Asked -Questions::. - -** TLS wrapper shipped with Gnus - -TLS/SSL is now supported in IMAP and NNTP via `tls.el' and GNUTLS. The -old TLS/SSL support via (external third party) `ssl.el' and OpenSSL -still works. - -** Improved anti-spam features. - -Gnus is now able to take out spam from your mail and news streams using -a wide variety of programs and filter rules. Among the supported -methods are RBL blocklists, bogofilter and white/blacklists. Hooks for -easy use of external packages such as SpamAssassin and Hashcash are also -new. *Note Thwarting Email Spam::. +** Gnus includes the Emacs Lisp SASL library. -** Gnus supports server-side mail filtering using Sieve. - -Sieve rules can be added as Group Parameters for groups, and the -complete Sieve script is generated using `D g' from the Group buffer, -and then uploaded to the server using `C-c C-l' in the generated Sieve -buffer. *Note Sieve Commands::, and the new Sieve manual *Note Top: -(sieve)Top. - +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. - -* Changes in group mode - -** `gnus-group-read-ephemeral-group' can be called interactively, using `G -M'. - -** Retrieval of charters and control messages - -There are new commands for fetching newsgroup charters (`H c') and -control messages (`H C'). +** ManageSieve connections uses the SASL library by default. -** The new variable `gnus-parameters' can be used to set group parameters. +The primary change this brings is support for DIGEST-MD5 and NTLM, when +the server supports it. -Earlier this was done only via `G p' (or `G c'), which stored the -parameters in `~/.newsrc.eld', but via this variable you can enjoy the -powers of customize, and simplified backups since you set the variable -in `~/.gnus.el' instead of `~/.newsrc.eld'. The variable maps regular -expressions matching group names to group parameters, a'la: -(setq gnus-parameters - '(("mail\\..*" - (gnus-show-threads nil) - (gnus-use-scoring nil)) - ("^nnimap:\\(foo.bar\\)$" - (to-group . "\\1")))) - -** Unread count correct in nnimap groups. +** Gnus includes a password cache mechanism in password.el. -The estimated number of unread articles in the group buffer should now -be correct for nnimap groups. This is achieved by calling -`nnimap-fixup-unread-after-getting-new-news' from the -`gnus-setup-news-hook' (called on startup) and -`gnus-after-getting-new-news-hook'. (called after getting new mail). If -you have modified those variables from the default, you may want to add -`nnimap-fixup-unread-after-getting-new-news' again. If you were happy -with the estimate and want to save some (minimal) time when getting new -mail, remove the function. - -** Group names are treated as UTF-8 by default. - -This is supposedly what USEFOR wanted to migrate to. See -`gnus-group-name-charset-group-alist' and -`gnus-group-name-charset-method-alist' for customization. - -** `gnus-group-charset-alist' and `gnus-group-ignored-charsets-alist'. - -The regexps in these variables are compared with full group names -instead of real group names in 5.8. Users who customize these variables -should change those regexps accordingly. For example: -("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr) - +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. * Changes in summary and article mode -** `F' (`gnus-article-followup-with-original') and `R' -(`gnus-article-reply-with-original') only yank the text in the region if -the region is active. - -** In draft groups, `e' is now bound to `gnus-draft-edit-message'. Use `B -w' for `gnus-summary-edit-article' instead. - -** Article Buttons - -More buttons for URLs, mail addresses, Message-IDs, Info links, man -pages and Emacs or Gnus related references. *Note Article Buttons::. -The variables `gnus-button-*-level' can be used to control the -appearance of all article buttons. *Note Article Button Levels::. - -** Single-part yenc encoded attachments can be decoded. +** Gnus now supports sticky article buffers. Those are article buffers +that are not reused when you select another article. *Note Sticky +Articles::. -** Picons - -The picons code has been reimplemented to work in GNU Emacs--some of the -previous options have been removed or renamed. +** 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. -Picons are small "personal icons" representing users, domain and -newsgroups, which can be displayed in the Article buffer. *Note -Picons::. - -** If the new option `gnus-treat-body-boundary' is non-`nil', a boundary -line is drawn at the end of the headers. - -** Signed article headers (X-PGP-Sig) can be verified with `W p'. - -** The Summary Buffer uses an arrow in the fringe to indicate the current -article. Use `(setq gnus-summary-display-arrow nil)' to disable it. +** 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::. -** Warn about email replies to news - -Do you often find yourself replying to news by email by mistake? Then -the new option `gnus-confirm-mail-reply-to-news' is just the thing for -you. +** Gnus now displays DNS master files sent as text/dns using dns-mode. -** If the new option `gnus-summary-display-while-building' is non-`nil', -the summary buffer is shown and updated as it's being built. - -** The new `recent' mark `.' indicates newly arrived messages (as opposed -to old but unread messages). - -** Gnus supports RFC 2369 mailing list headers, and adds a number of -related commands in mailing list groups. *Note Mailing List::. +** Gnus supports new limiting commands in the Summary buffer: `/ r' +(`gnus-summary-limit-to-replied') and `/ R' +(`gnus-summary-limit-to-recipient'). *Note Limiting::. -** The Date header can be displayed in a format that can be read aloud in -English. *Note Article Date::. - -** diffs are automatically highlighted in groups matching -`mm-uu-diff-groups-regexp' - -** Better handling of Microsoft citation styles +** You can now fetch all ticked articles from the server using `Y t' +(`gnus-summary-insert-ticked-articles'). *Note Summary Generation +Commands::. -Gnus now tries to recognize the mangled header block that some Microsoft -mailers use to indicate that the rest of the message is a citation, even -though it is not quoted in any way. The variable -`gnus-cite-unsightly-citation-regexp' matches the start of these -citations. +** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t' +(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::. -The new command `W Y f' (`gnus-article-outlook-deuglify-article') allows -deuglifying broken Outlook (Express) articles. - -** `gnus-article-skip-boring' +** S/MIME now features LDAP user certificate searches. You need to +configure the server in `smime-ldap-host-list'. -If you set `gnus-article-skip-boring' to `t', then Gnus will not scroll -down to show you a page that contains only boring text, which by default -means cited text and signature. You can customize what is skippable -using `gnus-article-boring-faces'. +** URLs inside OpenPGP headers are retrieved and imported to your PGP key +ring when you click on them. -This feature is especially useful if you read many articles that consist -of a little new content at the top with a long, untrimmed message cited -below. - -** Smileys (`:-)', `;-)' etc) are now displayed graphically in Emacs too. - -Put `(setq gnus-treat-display-smileys nil)' in `~/.gnus.el' to disable -it. +** Picons can be displayed right from the textual address, see +`gnus-picon-style'. *Note Picons::. -** Face headers handling. *Note Face::. - -** In the summary buffer, the new command `/ N' inserts new messages and `/ -o' inserts old messages. - -** Gnus decodes morse encoded messages if you press `W m'. +** ANSI SGR control sequences can be transformed using `W A'. -** `gnus-summary-line-format' +ANSI sequences are used in some Chinese hierarchies for highlighting +articles (`gnus-article-treat-ansi-sequences'). -The default value changed to `%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n'. -Moreover `gnus-extra-headers', `nnmail-extra-headers' and -`gnus-ignored-from-addresses' changed their default so that the users -name will be replaced by the recipient's name or the group name posting -to for NNTP groups. - -** Deleting of attachments. +** Gnus now MIME decodes articles even when they lack "MIME-Version" header. +This changes the default of `gnus-article-loose-mime'. -The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME -buttons) saves a part and replaces the part with an external one. -`gnus-mime-delete-part' (bound to `d' on MIME buttons) removes a part. -It works only on back ends that support editing. - -** `gnus-default-charset' +** `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::. -The default value is determined from the `current-language-environment' -variable, instead of `iso-8859-1'. Also the `.*' item in -`gnus-group-charset-alist' is removed. - -** Printing capabilities are enhanced. - -Gnus supports Muttprint natively with `O P' from the Summary and Article -buffers. Also, each individual MIME part can be printed using `p' on -the MIME button. - -** Extended format specs. +** 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::. -Format spec `%&user-date;' is added into -`gnus-summary-line-format-alist'. Also, user defined extended format -specs are supported. The extended format specs look like `%u&foo;', -which invokes function `gnus-user-format-function-FOO'. Because `&' is -used as the escape character, old user defined format `%u&' is no longer -supported. - -** `/ *' (`gnus-summary-limit-include-cached') is rewritten. +** You can replace MIME parts with external bodies. See +`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME +Commands::, *note Using MIME::. -It was aliased to `Y c' (`gnus-summary-insert-cached-articles'). The -new function filters out other articles. - -** Some limiting commands accept a `C-u' prefix to negate the match. - -If `C-u' is used on subject, author or extra headers, i.e., `/ s', `/ -a', and `/ x' (`gnus-summary-limit-to-{subject,author,extra}') -respectively, the result will be to display all articles that do not -match the expression. - -** Gnus inlines external parts (message/external). +** 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) -* Changes in Message mode and related Gnus features - -** Delayed articles - -You can delay the sending of a message with `C-c C-j' in the Message -buffer. The messages are delivered at specified time. This is useful -for sending yourself reminders. *Note Delayed Articles::. - -** If the new option `nnml-use-compressed-files' is non-`nil', the nnml -back end allows compressed message files. - -** The new option `gnus-gcc-mark-as-read' automatically marks Gcc articles -as read. - -** Externalizing of attachments - -If `gnus-gcc-externalize-attachments' or -`message-fcc-externalize-attachments' is non-`nil', attach local files -as external parts. - -** The envelope sender address can be customized when using Sendmail. - *Note Mail Variables: (message)Mail Variables. - -** Gnus no longer generate the Sender: header automatically. - -Earlier it was generated when the user configurable email address was -different from the Gnus guessed default user address. As the guessing -algorithm is rarely correct these days, and (more controversially) the -only use of the Sender: header was to check if you are entitled to -cancel/supersede news (which is now solved by Cancel Locks instead, see -another entry), generation of the header has been disabled by default. -See the variables `message-required-headers', -`message-required-news-headers', and `message-required-mail-headers'. - -** Features from third party `message-utils.el' added to `message.el'. - -Message now asks if you wish to remove `(was: )' from -subject lines (see `message-subject-trailing-was-query'). `C-c M-m' and -`C-c M-f' inserts markers indicating included text. `C-c C-f a' adds a -X-No-Archive: header. `C-c C-f x' inserts appropriate headers and a -note in the body for cross-postings and followups (see the variables -`message-cross-post-*'). - -** References and X-Draft-From headers are no longer generated when you -start composing messages and `message-generate-headers-first' is `nil'. - -** Easy inclusion of X-Faces headers. *Note X-Face::. - -** Group Carbon Copy (GCC) quoting - -To support groups that contains SPC and other weird characters, groups -are quoted before they are placed in the Gcc: header. This means -variables such as `gnus-message-archive-group' should no longer contain -quote characters to make groups containing SPC work. Also, if you are -using the string `nnml:foo, nnml:bar' (indicating Gcc into two groups) -you must change it to return the list `("nnml:foo" "nnml:bar")', -otherwise the Gcc: line will be quoted incorrectly. Note that returning -the string `nnml:foo, nnml:bar' was incorrect earlier, it just didn't -generate any problems since it was inserted directly. - -** `message-insinuate-rmail' - -Adding `(message-insinuate-rmail)' and `(setq mail-user-agent -'gnus-user-agent)' in `.emacs' convinces Rmail to compose, reply and -forward messages in message-mode, where you can enjoy the power of MML. - -** `message-minibuffer-local-map' - -The line below enables BBDB in resending a message: -(define-key message-minibuffer-local-map [(tab)] - 'bbdb-complete-name) +* Changes in Message mode -** `gnus-posting-styles' - -Add a new format of match like -((header "to" "larsi.*org") - (Organization "Somewhere, Inc.")) -The old format like the lines below is obsolete, but still accepted. -(header "to" "larsi.*org" - (Organization "Somewhere, Inc.")) - -** `message-ignored-news-headers' and `message-ignored-mail-headers' - -`X-Draft-From' and `X-Gnus-Agent-Meta-Information' have been added into -these two variables. If you customized those, perhaps you need add -those two headers too. - -** Gnus supports the "format=flowed" (RFC 2646) parameter. On composing -messages, it is enabled by `use-hard-newlines'. Decoding format=flowed -was present but not documented in earlier versions. - -** 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. (New in Gnus 5.10.7) - -** Gnus supports the generation of RFC 2298 Disposition Notification -requests. - -This is invoked with the `C-c M-n' key binding from message mode. - -** Message supports the Importance: (RFC 2156) header. - -In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the -valid values. - -** Gnus supports Cancel Locks in News. - -This means a header `Cancel-Lock' is inserted in news posting. It is -used to determine if you wrote an article or not (for canceling and -superseding). Gnus generates a random password string the first time -you post a message, and saves it in your `~/.emacs' using the Custom -system. While the variable is called `canlock-password', it is not -security sensitive data. Publishing your canlock string on the web will -not allow anyone to be able to anything she could not already do. The -behavior can be changed by customizing `message-insert-canlock'. - -** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and S/MIME -(RFC 2630-2633). - -It needs an external S/MIME and OpenPGP implementation, but no -additional Lisp libraries. This add several menu items to the -Attachments menu, and `C-c RET' key bindings, when composing messages. -This also obsoletes `gnus-article-hide-pgp-hook'. - -** MML (Mime compose) prefix changed from `M-m' to `C-c C-m'. - -This change was made to avoid conflict with the standard binding of -`back-to-indentation', which is also useful in message mode. - -** The default for `message-forward-show-mml' changed to the symbol `best'. - -The behavior for the `best' value is to show MML (i.e., convert to MIME) -when appropriate. MML will not be used when forwarding signed or -encrypted messages, as the conversion invalidate the digital signature. - -** If `auto-compression-mode' is enabled, attachments are automatically -decompressed when activated. - -** Support for non-ASCII domain names - -Message supports non-ASCII domain names in From:, To: and Cc: and will -query you whether to perform encoding when you try to send a message. -The variable `message-use-idna' controls this. Gnus will also decode -non-ASCII domain names in From:, To: and Cc: when you view a message. -The variable `gnus-use-idna' controls this. +** 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-formated-citation-line' as well. * Changes in back ends -** Gnus can display RSS newsfeeds as a newsgroup. *Note RSS::. - -** The nndoc back end now supports mailman digests and exim bounces. +** The nntp back end stores article marks in `~/News/marks'. -** Gnus supports Maildir groups. +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'. -Gnus includes a new back end `nnmaildir.el'. *Note Maildir::. +** You can import and export your RSS subscriptions from OPML files. *Note +RSS::. -** The nnml and nnfolder back ends store marks for each groups. +** IMAP identity (RFC 2971) is supported. -This makes it possible to take backup of nnml/nnfolder servers/groups -separately of `~/.newsrc.eld', while preserving marks. It also makes it -possible to share articles and marks between users (without sharing the -`~/.newsrc.eld' file) within e.g. a department. It works by storing the -marks stored in `~/.newsrc.eld' in a per-group file `.marks' (for nnml) -and `GROUPNAME.mrk' (for nnfolder, named GROUPNAME). If the -nnml/nnfolder is moved to another machine, Gnus will automatically use -the `.marks' or `.mrk' file instead of the information in -`~/.newsrc.eld'. The new server variables `nnml-marks-is-evil' and -`nnfolder-marks-is-evil' can be used to disable this feature. +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). * Appearance -** The menu bar item (in Group and Summary buffer) named "Misc" has been -renamed to "Gnus". - -** The menu bar item (in Message mode) named "MML" has been renamed to -"Attachments". Note that this menu also contains security related -stuff, like signing and encryption (*note Security: (message)Security.). - -** The tool bars have been updated to use GNOME icons in Group, Summary and -Message mode. You can also customize the tool bars. This is a new -feature in Gnus 5.10.9. (Only for Emacs, not in XEmacs.) +** The tool bar has been updated to use GNOME icons. You can also +customize the tool bar. There's no documentation in the manual yet, but +`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. This is a new feature in Gnus 5.10.9. +depends on your Emacs version. + +** You can change the location of XEmacs' toolbars in Gnus buffers. See +`gnus-use-toolbar' and `message-use-toolbar'. + * Miscellaneous changes -** `gnus-agent' - -The Gnus Agent has seen a major updated and is now enabled by default, -and all nntp and nnimap servers from `gnus-select-method' and -`gnus-secondary-select-method' are agentized by default. Earlier only -the server in `gnus-select-method' was agentized by the default, and the -agent was disabled by default. When the agent is enabled, headers are -now also retrieved from the Agent cache instead of the back ends when -possible. Earlier this only happened in the unplugged state. You can -enroll or remove servers with `J a' and `J r' in the server buffer. -Gnus will not download articles into the Agent cache, unless you -instruct it to do so, though, by using `J u' or `J s' from the Group -buffer. You revert to the old behavior of having the Agent disabled -with `(setq gnus-agent nil)'. Note that putting `(gnus-agentize)' in -`~/.gnus.el' is not needed any more. +** 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. -** Gnus reads the NOV and articles in the Agent if plugged. - -If one reads an article while plugged, and the article already exists in -the Agent, it won't get downloaded once more. `(setq gnus-agent-cache -nil)' reverts to the old behavior. - -** Dired integration - -`gnus-dired-minor-mode' (see *Note Other modes::) installs key bindings -in dired buffers to send a file as an attachment, open a file using the -appropriate mailcap entry, and print a file using the mailcap entry. - -** The format spec `%C' for positioning point has changed to `%*'. - -** `gnus-slave-unplugged' - -A new command which starts Gnus offline in slave mode. +** The `all.SCORE' file can be edited from the group buffer using `W e'. diff -r b6f5dc84b2e1 -r a3c27999decb etc/gnus/gnus-setup.ast --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/gnus-setup.ast Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,51 @@ +@title Configuring Gnus for the first time + +@node What do you want to do with Gnus? + +@variable outbound (:radio ((item :tag "Send mail via sendmail" "sendmail") (item :tag "Send mail via SMTP" "smtp"))) "sendmail" + +@variable backends (:set ((item :tag "Read news via NNTP" "nntp") (item :tag "Read mail, store it locally" "nnml") (item :tag "Read mail and store it on an IMAP server" "nnimap"))) (list "nnml") +@result primary-mail-selections (list backends outbound) + +@text +Welcome to Gnus. You need to tell us what you want to do with Gnus +before we go on to specific configurations. + +Choose the tasks you want to set up: +@variable{backends} + +Choose the method Gnus will use to send mail: +@variable{outbound} + +@end text + +@next (member "nnml" backends) "Setting up local mail storage (nnml)" +@next (member "nntp" backends) "Setting up a NNTP server" + +@node Setting up local mail storage (nnml) +@variable mechanism (:radio ((item :tag "Get mail from your Unix mbox" "mbox") (item :tag "Use POP3 to retrieve mail" "pop3"))) "mbox" +@result nnml-mechanism (list mechanism) +@text +You are setting up local mail storage, using the nnml backend in Gnus terms. + +Your mail can be downloaded into Gnus in several ways, choose one: +@variable{mechanism} + +@end text + +@node Setting up a NNTP server + +@text +TODO: this will be a real link. +Run M-x assistant and use the news-server.ast file as input. +@end text + + +@c Local variables: +@c mode: texinfo +@c End: + +@ignore + arch-tag: 6b7b200b-9169-4b44-8b32-b73773fa71af +@end ignore + diff -r b6f5dc84b2e1 -r a3c27999decb etc/gnus/news-server.ast --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/gnus/news-server.ast Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,64 @@ +@title Configuring Gnus for reading news + + +@node Setting up the news server name and port number +@variable server :string (gnus-getenv-nntpserver) +@variable port :number 119 +@validate (assistant-validate-connect-to-server server port) +@result gnus-select-method (list 'nntp server (list 'nntp-server port)) +@text +Usenet news is usually read from your Internet service prodider's news +server. If you don't know the name of this server, contact your ISP. + +As a guess, the name of the server might be news.yourisp.com. + +Server name: @variable{server} +Port number: @variable{port} +@end text +@next t "User name and password" + + +@node User name and password +@type interstitial +@next +(if (assistant-password-required-p) + "Enter user name and password" + "Want user name and password?") +@end next + + +@node Want user name and password? +@variable passwordp (:radio ((item "Yes") (item "No"))) "No" +@text +Some news servers require that you enter a user name and a password. +It doesn't look like your news server is one of them. + +Do you want to enter user name and password anyway? + +@variable{passwordp} + +@end text + +@next (equal passwordp "No") finish +@next (not (equal passwordp "No")) "Enter user name and password" + + +@node Enter user name and password +@variable user-name :string (user-login-name) +@variable password :password (or (assistant-authinfo-data server port 'password) "") +@text + +It looks like your news server requires you to enter a user name +and a password: + +User name: @variable{user-name} +Password: @variable{user-name} + +@end text + +@c Local variables: +@c mode: texinfo +@c End: + +@c arch tag is missing + diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/gnus/mail_send.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/gnus/mail_send.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,39 @@ +/* XPM */ +static char *magick[] = { +/* columns rows colors chars-per-pixel */ +"24 24 9 1", +" c Gray0", +". c #675e6580613e", +"X c #8c8c7c7c6969", +"o c #9b458d377822", +"O c #a941a6459f3e", +"+ c #c8c8b2b29898", +"@ c #dadac2c2a5a5", +"# c #eb4dea2fe4ad", +"$ c None", +/* pixels */ +"$$$$$$$$$$$$$$$$$$$$$$$$", +"$$$$$$$$$$$$$$$$$$$$$$$$", +"$$$$$$$$$$$$$ $$$$$$$", +"$$$$$$$$ .@#+ $$$$$$", +"$$$ .+#####@O $$$$$$", +"$$ .+##########.+O $$$$$", +"$$ @..########O.+# $$$$$", +"$$ O@O..@#####.+## $$$$$", +"$$$ ###+O.O##...##O $$$$", +"$$$ @####@+..O#O.+# $$$$", +"$$$ O####.#######.O $$$$", +"$$$$ ###+O########.O $$$", +"$$$$ ###.########@O $$$", +"$$$$ +#+O#####@O $$$$$", +"$$$$$ #.###@O $$$$$$", +"$$$$$ .O@O $$ .. $$$$$", +"$$$$$ .. $$$$ .oo. $$$$", +"$$$$$$ $$$$$ oo $$$", +"$$$$$$$$$$$$$$$ Oo $$$$$", +"$$$$$$$$$$$$$$ oOOX $$$$", +"$$$$$$$$$$$$$$ ++++ $$$$", +"$$$$$$$$$$$$$ O@@@@O $$$", +"$$$$$$$$$$$$$ $$$", +"$$$$$$$$$$$$$$$$$$$$$$$$" +}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/blink.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/blink.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,24 @@ +/* XPM */ +static char * blink_xpm[] = { +"14 14 7 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #6E6E6E", +"# c #515151", +"$ c #ABABAB", +"% c #737373", +" ", +" ", +" . ", +" + ", +" @#$$# + ", +" ++ + ", +" ", +" + + ", +" $+ +$ ", +" %+ +% ", +" %++++% ", +" $$$$ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/braindamaged.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/braindamaged.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * braindamaged_xpm[] = { +"14 14 6 1", +" c None", +". c #ABABAB", +"+ c #000000", +"@ c #515151", +"# c #171717", +"$ c #737373", +" ", +" ", +" .++..++. ", +" +@.++.@+ ", +" +.@#@@.+ ", +" +@.#@.@+ ", +" .++. ++. ", +" + + ", +" .+ +. ", +" $+ +$ ", +" $++++$ ", +" .... ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/cry.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/cry.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * cry_xpm[] = { +"14 14 6 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #ABABAB", +"# c #515151", +"$ c #6E6E6E", +" ", +" ", +" . ", +" .. .+. ", +" +++. +.+ ", +" +@+ ", +" @+# ", +" @@ ", +" $++++$ ", +" .+@ @+. ", +" @+@ @+@ ", +" @ @ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/dead.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/dead.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,21 @@ +/* XPM */ +static char * dead_xpm[] = { +"14 14 4 1", +" c None", +". c #737373", +"+ c #ABABAB", +"@ c #000000", +" ", +" ", +" .+ +. + +. ", +" +@+@++@+@+ ", +" +@ @+ ", +" +@+@ @+@+ ", +" + +. + + ", +" ", +" +@ @+ ", +" .@ @. ", +" .@@@@. ", +" ++++ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/evil.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/evil.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * evil_xpm[] = { +"14 14 6 1", +" c None", +". c #6E6E6E", +"+ c #484848", +"@ c #ABABAB", +"# c #000000", +"$ c #737373", +" ", +" ", +" .+ +. ", +" @# #@ ", +" #+ @+# ", +" #+ @+# ", +" ", +" # # ", +" @# #@ ", +" $# #$ ", +" $####$ ", +" @@@@ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/forced.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/forced.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * forced_xpm[] = { +"14 14 6 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #6E6E6E", +"# c #ABABAB", +"$ c #171717", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" @ @ ", +" +# #+ ", +" @@# #@@ ", +" #$++++++$# ", +" ######## ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/frown.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/frown.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char * frown_xpm[] = { +"14 14 5 1", +" c None", +". c #6E6E6E", +"+ c #484848", +"@ c #ABABAB", +"# c #000000", +" ", +" ", +" .+ +. ", +" @# #@ ", +" #+ @+# ", +" #+@@+# ", +" ", +" @@ ", +" .####. ", +" +#@ @#+ ", +" @#@ @#@ ", +" + + ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/grin.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/grin.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,25 @@ +/* XPM */ +static char * grin_xpm[] = { +"14 14 8 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #515151", +"# c #6E6E6E", +"$ c #ABABAB", +"% c #FFFFFF", +"& c #737373", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" ++@@##@@++ ", +" $+%%%%%%+$ ", +" &+%%%%+& ", +" &++++& ", +" $$$$ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/indifferent.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/indifferent.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * indifferent_xpm[] = { +"14 14 6 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #515151", +"# c #ABABAB", +"$ c #6E6E6E", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" @ #@ ", +"#+$+$ $ + ", +"$ +#+$#++$+$ ", +" $ ++# ++ ", +" + ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/reverse-smile.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/reverse-smile.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char * reverse_smile_xpm[] = { +"14 14 5 1", +" c None", +". c #ABABAB", +"+ c #737373", +"@ c #000000", +"# c #484848", +" ", +" ", +" .... ", +" +@@@@+ ", +" +@ @+ ", +" .@ @. ", +" @ @ ", +" ", +" @ @ ", +" @ @ ", +" @ @ ", +" # # ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/sad.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/sad.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char * sad_xpm[] = { +"14 14 5 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #ABABAB", +"# c #6E6E6E", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" @@@@ ", +" #++++# ", +" .+@ @+. ", +" @+@ @+@ ", +" . . ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/smile.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/smile.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,22 @@ +/* XPM */ +static char * smile_xpm[] = { +"14 14 5 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #ABABAB", +"# c #737373", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" + + ", +" @+ +@ ", +" #+ +# ", +" #++++# ", +" @@@@ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/grayscale/wry.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/grayscale/wry.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,23 @@ +/* XPM */ +static char * wry_xpm[] = { +"14 14 6 1", +" c None", +". c #484848", +"+ c #000000", +"@ c #515151", +"# c #ABABAB", +"$ c #6E6E6E", +" ", +" ", +" . . ", +" + + ", +" + + ", +" + + ", +" ", +" @ ", +" ## $@ ", +" #++++++# ", +" @$ ## ", +" @ ", +" ", +" "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/blink.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/blink.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char * blink_xpm[] = { +"16 16 10 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +"= c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&&&&&&*&&%. ", +" +$&&&&&&&.&&$+ ", +".@&@%##%&&.&&&@.", +".#&&&..&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&.&&&&&&&&.&$.", +".#&#.&&&&&&.#&#.", +".@&&=.&&&&.=&&@.", +" +$&&=....=&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/braindamaged.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/braindamaged.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * braindamaged_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&#..##..#&%. ", +" +$&.%#..#%.&$+ ", +".@&&.#%+%%#.&&@.", +".#&&.%#+%#%.&&#.", +".$&&#..#&..#&&$.", +".$&.&&&&&&&&.&$.", +".#&#.&&&&&&.#&#.", +".@&&*.&&&&.*&&@.", +" +$&&*....*&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/cry.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/cry.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * cry_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&&&&&&*&&%. ", +" +$&&**&&*.*&$+ ", +".@&&...*&.*.&&@.", +".#&&&&&&&.#.&&#.", +".$&&&&&&&#.%&&$.", +".$&&&&&&&&&&&&$.", +".#&&&@....@&&&#.", +".@&&*.#&&#.*&&@.", +" +$#.#&&&&#.#$+ ", +" .%&*&&&&&&*&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/dead.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/dead.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * dead_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%*#&#*$#&#*%. ", +" +$#.#.##.#.#$+ ", +".@&&#.$&&$.#&&@.", +".#&#.#.$$.#.#&#.", +".$&*#&#*$#&#*&$.", +".$&.&&&&&&&&.&$.", +".#&#.&&&&&&.#&#.", +".@&&*.&&&&.*&&@.", +" +$&&*....*&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/evil.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/evil.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char * evil_xpm[] = { +"16 16 10 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +"= c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&@*&&&&*@&%. ", +" +$&#.&&&&.#&$+ ", +".@&&&.*&#*.&&&@.", +".#&&&.*##*.&&&#.", +".$&&&&&&&&&&&&$.", +".$&.&&&&&&&&.&$.", +".#&#.&&&&&&.#&#.", +".@&&=.&&&&.=&&@.", +" +$&&=....=&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/forced.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/forced.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * forced_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&@&&&&&&&&@&$.", +".#&.#&&&&&&#.&#.", +".@&@@#&&&&#@@&@.", +" +$#+......+#$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/frown.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/frown.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * frown_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&@*&&&&*@&%. ", +" +$&#.&&&&.#&$+ ", +".@&&&.*&#*.&&&@.", +".#&&&.*##*.&&&#.", +".$&&&&&&&&&&&&$.", +".$&&&&&&&&&&&&$.", +".#&&&@....@&&&#.", +".@&&*.#&&#.*&&@.", +" +$#.#&&&&#.#$+ ", +" .%&*&&&&&&*&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/grin.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/grin.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,30 @@ +/* XPM */ +static char * grin_xpm[] = { +"16 16 11 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +"= c #FFFFFF", +"- c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&..%%@@%%..&$.", +".#&#.======.#&#.", +".@&&-.====.-&&@.", +" +$&&-....-&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/indifferent.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/indifferent.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * indifferent_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$%&&&&&&&&&#%$.", +".#.@.@&&&@&&.&#.", +".@&.#.@#..@.@&@.", +" +$@&&..#&..&$+ ", +" .%&&&&.&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/reverse-smile.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/reverse-smile.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char * reverse_smile_xpm[] = { +"16 16 10 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #8F7B00", +"= c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&&&&&&&&&%. ", +" +$&&*....*&&$+ ", +".@&&*.&&&&.*&&@.", +".#&#.&&&&&&.#&#.", +".$&.&&&&&&&&.&$.", +".$&&&&&&&&&&&&$.", +".#&&&.&&&&.&&&#.", +".@&&&.&&&&.&&&@.", +" +$&&.&&&&.&&$+ ", +" .%&&=&&&&=&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/sad.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/sad.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * sad_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&&&&&&&&&&&&$.", +".#&&&@....@&&&#.", +".@&&*.#&&#.*&&@.", +" +$#.#&&&&#.#$+ ", +" .%&*&&&&&&*&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/smile.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/smile.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,29 @@ +/* XPM */ +static char * smile_xpm[] = { +"16 16 10 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +"= c #8F7B00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&.&&&&&&&&.&$.", +".#&#.&&&&&&.#&#.", +".@&&=.&&&&.=&&@.", +" +$&&=....=&&$+ ", +" .%&&&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/images/smilies/medium/wry.xpm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/images/smilies/medium/wry.xpm Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,28 @@ +/* XPM */ +static char * wry_xpm[] = { +"16 16 9 1", +" c None", +". c #000000", +"+ c #1D1900", +"@ c #887500", +"# c #D3B600", +"$ c #FAD800", +"% c #645600", +"& c #FFDD00", +"* c #594D00", +" ...... ", +" .+@#$$#@+. ", +" .%$&&&&&&$%. ", +" .%&&*&&&&*&&%. ", +" +$&&.&&&&.&&$+ ", +".@&&&.&&&&.&&&@.", +".#&&&.&&&&.&&&#.", +".$&&&&&&&&&&&&$.", +".$&&&&&&&&&%&&$.", +".#&&&&&&&&@%&&#.", +".@&&#......#&&@.", +" +$&%@&&&&&&&$+ ", +" .%&%&&&&&&&&%. ", +" .%$&&&&&&$%. ", +" .+@#$$#@+. ", +" ...... "}; diff -r b6f5dc84b2e1 -r a3c27999decb etc/refcards/gnus-refcard.tex --- a/etc/refcards/gnus-refcard.tex Sun Oct 28 04:58:17 2007 +0000 +++ b/etc/refcards/gnus-refcard.tex Sun Oct 28 09:18:39 2007 +0000 @@ -121,7 +121,12 @@ \newcommand{\Copyright}{% \begin{center} Copyright \copyright\ 1995, 2000, 2002, 2003, 2004, - 2005, 2006, 2007 Free Software Foundation, Inc. + 2005, 2006, 2007 Free Software Foundation, Inc.\\* + Copyright \copyright\ 2001, 2002, 2003, 2004, 2005 \author.\\* + Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne + Ingebrigtsen.\\* + and the Emacs Help Bindings feature (C-h b).\\* + Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\* \end{center} Permission is granted to make and distribute copies of this reference @@ -566,7 +571,7 @@ {\esamepage \begin{keys}{C-c C-s C-a} C-c C-s C-a & Sort the summary-buffer by {\bf author}.\\ - % C-c C-s C-t & Sort the summary-buffer by {\bf recipient}.\\ % No Gnus + C-c C-s C-t & Sort the summary-buffer by {\bf recipient}.\\ C-c C-s C-d & Sort the summary-buffer by {\bf date}.\\ C-c C-s C-i & Sort the summary-buffer by article score.\\ C-c C-s C-l & Sort the summary-buffer by amount of {\bf lines}.\\ @@ -876,6 +881,7 @@ \begin{keys}{/M} // & (/s) Limit the summary-buffer to articles matching {\bf subject}.\\ /a & Limit the summary-buffer to articles matching {\bf author}.\\ + /R & Limit the summary-buffer to articles matching {\bf recipient}.\\ /x & Limit depending on ``extra'' headers.\\ /u & (x) Limit to {\bf unread} articles. [Prefix: also exclude ticked and dormant articles]\\ @@ -900,7 +906,7 @@ /o & Insert all {\bf old} articles. [Prefix: how many]\\ /N & Insert all {\bf new} articles.\\ /p & Limit to articles {\bf predicated} in the `display' group parameter.\\ - % /r & Limit to {\bf replied} articles. [Prefix: unreplied]\\ % No Gnus + /r & Limit to {\bf replied} articles. [Prefix: unreplied]\\ \end{keys} } } diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/ChangeLog Sun Oct 28 09:18:39 2007 +0000 @@ -1,3 +1,98 @@ +2007-10-28 Miles Bader + + * nnheader.el (nnheader-uniquify-message-id): Make sure this is defined + at compile-time too. + +2007-10-26 Reiner Steib + + * message.el (message-remove-blank-cited-lines): New function. + Suggested by Karl Pl,Ad(Bsterer. + +2007-10-25 Katsumi Yamaoka + + * hashcash.el (mail-add-payment): Replace mapcar called for effect with + mapc. + + * imap.el (imap-open): Replace mapcar called for effect with mapc. + (top-level): Use mapc to set functions to be traced for debugging. + + * legacy-gnus-agent.el (gnus-agent-convert-agentview): Replace mapcar + called for effect with while loop. + + * message.el (message-talkative-question): Replace mapcar called for + effect with mapc. + + * mm-util.el: Use mapc instead of mapcar to make compatible functions. + (mm-find-mime-charset-region, mm-find-charset-region): Replace mapcar + called for effect with dolist. + + * mml.el (mml-insert-mime): Replace mapcar called for effect with mapc. + + * nndiary.el: Use dolist instead of mapcar to add diary headers to + gnus-extra-headers and nnmail-extra-headers. + + * nnimap.el (nnimap-request-update-info-internal): Replace mapcar + called for effect with dolist. + (top-level): Use mapc to set functions to be traced for debugging. + + * nnmail.el (nnmail-read-incoming-hook): Doc fix. + (nnmail-split-fancy-with-parent): Replace mapcar called for effect with + dolist. + + * nnmaildir.el (nnmaildir--delete-dir-files, nnmaildir-request-close): + Replace mapcar called for effect with mapc. + (nnmaildir--scan, nnmaildir-request-scan, nnmaildir-retrieve-groups) + (nnmaildir-request-update-info, nnmaildir-request-delete-group) + (nnmaildir-retrieve-headers, nnmaildir-request-set-mark) + (nnmaildir-close-group): Replace mapcar called for effect with dolist. + + * nnrss.el (nnrss-make-hash-index): Use gnus-remove-if instead of + remove-if that's a cl function. + + * webmail.el (webmail-debug): Replace mapcar called for effect with + dolist. + + * gnus-xmas.el (gnus-group-add-icon): Replace mapcar called for effect + with mapc. + +2007-10-24 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-read-agentview, gnus-agent-save-alist) + (gnus-agent-expire-unagentized-dirs): Replace mapcar called for effect + with while loop. + + * gnus-art.el: Use mapc instead of mapcar to make gnus-article-* + functions from article-* functions. + (gnus-multi-decode-header): Replace mapcar called for effect with + dolist. + + * gnus-bookmark.el (gnus-bookmark-bmenu-list) + (gnus-bookmark-show-details): Replace mapcar called for effect with + while loop. + + * gnus-diary.el (gnus-diary-update-group-parameters): Replace mapcar + called for effect with while loop. + + * gnus-group.el (gnus-group-suspend): Replace mapcar called for effect + with dolist. + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): Replace + mapcar called for effect with dolist. + + * gnus-spec.el (gnus-correct-length): Make it simple and fast. + + * gnus-sum.el (gnus-multi-decode-encoded-word-string) + (gnus-build-sparse-threads, gnus-summary-limit-include-expunged): + Replace mapcar called for effect with dolist. + (gnus-simplify-buffer-fuzzy): Replace mapcar called for effect with + mapc. + + * gnus-topic.el (gnus-topic-find-groups, gnus-topic-move-group): + Replace mapcar called for effect with dolist. + (gnus-topic-list): Replace mapcar called for effect with mapc. + + * gnus.el: Use mapc instead of mapcar to add autoloads. + 2007-10-23 Richard Stallman * gnus-group.el (gnus-group-highlight): Mark as risky. @@ -7,6 +102,17 @@ * gnus.el (gnus-server-to-method): Return method found first in gnus-newsrc-alist. + * gnus-art.el (gnus-article-highlight-signature) + (gnus-insert-prev-page-button, gnus-insert-next-page-button): Make a + button overlay without the front stickiness. + +2007-10-22 Kevin Greiner + + * gnus-agent.el (gnus-agent-expire-group-1): The check for an unsorted + overview buffer needed a catch to receive its throw. + (gnus-agent-flush-cache): Declared as interactive to make this function + easier to use. + 2007-10-20 Reiner Steib * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of @@ -22,13 +128,26 @@ * gnus-util.el (gnus-string<): New function. * gnus-sum.el (gnus-article-sort-by-author) - (gnus-article-sort-by-subject): Use it. + (gnus-article-sort-by-recipient, gnus-article-sort-by-subject): Use it. 2007-10-15 Katsumi Yamaoka * gnus-win.el (gnus-configure-windows): Focus on the frame for which the frame-focus tag is set in gnus-buffer-configuration. +2007-10-12 Katsumi Yamaoka + + * gnus-art.el (gnus-article-add-button): Make a button overlay without + the front stickiness. + +2007-10-11 Katsumi Yamaoka + + * gnus-art.el (gnus-button-alist): Exclude newline in RFC2396-compliant + url pattern; remove duplicate one. + (gnus-article-extend-url-button): New function. + (gnus-article-add-buttons): Use it. + (gnus-button-push): Use concatenated url that it makes. + 2007-10-04 Juanma Barranquero * sieve-manage.el (sieve-manage-interactive-login): Doc fix. @@ -48,11 +167,50 @@ 2007-10-08 Reiner Steib * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936. + Fix comment about "iso8859-1". + +2007-10-08 Daiki Ueno + + * mm-decode.el (mm-possibly-verify-or-decrypt): Replace PARTS with the + ones returned from the verify-function. + + * mm-uu.el (mm-uu-pgp-signed-extract-1): Call + mml2015-extract-cleartext-signature if extraction failed. + +2007-10-07 Daiki Ueno + + * mm-uu.el (mm-uu-pgp-signed-extract-1): Delete the first line + beginning with "-----BEGIN PGP SIGNED MESSAGE-----" if extraction + failed. 2007-10-04 Reiner Steib * Relicense "GPLv2 or later" files to "GPLv3 or later". +2007-09-27 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-kill-thread): Allow universal prefix zero + to mark a thread as expirable. Add variable `hide' to handle hiding of + thread for both the null and zero (kill/expire thread) universal prefix + cases. + (gnus-summary-expire-thread): Add new function to expire a thread, + using gnus-summary-kill-thread. + (gnus-summary-mode-map, gnus-summary-thread-map): Add 'M-C-e' and 'T e' + shortcuts for gnus-summary-expire-thread. + (gnus-summary-mode-map, gnus-summary-thread-map): Remove `M-C-e' and `T + e' bindings for gnus-summary-expire-thread. Add `T E' binding. + +2007-09-25 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-store-extra-entry): Allow for nil + extras value, so an extras entry can be deleted. + (gnus-registry-delete-extra-entry): Use it. + (gnus-registry-fetch-extra-flags, gnus-registry-has-extra-flag) + (gnus-registry-store-extra-flags, gnus-registry-delete-extra-flags) + (gnus-registry-delete-all-extra-flags): Allow for arbitrary flag symbol + storage through the gnus-registry, and provide an appropriate API for + it. + 2007-09-13 Katsumi Yamaoka * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el. @@ -84,14 +242,73 @@ (nnmbox-save-mail): Quote lines looking like delimiters at the right positions; make sure article ends with newline. + * message.el (message-display-abbrev): Don't infloop when a user + inserts SPC in the beginning of header. + +2007-09-12 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unfollowed-groups): Add INBOX to the + list of groups not followed by default. Fix type to be regexp. + (gnus-registry-grep-in-list): Fix inverted parameters to string-match. + +2007-09-06 Tassilo Horn + + * hmac-def.el (define-hmac-function): Switch from old-style to + new-style backquotes. + + * md4.el (md4-make-step): likewise. + +2007-09-06 Katsumi Yamaoka + + * gnus-start.el (gnus-gnus-to-newsrc-format): Use a unibyte buffer and + raw-text coding system when saving .newsrc file, which may contain + non-ASCII group names. + 2007-09-05 Katsumi Yamaoka * gnus-cus.el (gnus-score-extra): New widget. (gnus-score-extra-convert): New function. (gnus-score-customize): Use it for Extra. +2007-08-31 Daiki Ueno + + * mml2015.el (mml2015-extract-cleartext-signature): New function. + (mml2015-mailcrypt-clear-verify): Use it. + (mml2015-gpg-clear-verify): Use it. + (mml2015-pgg-clear-verify): Use it. + (mml2015-epg-clear-verify): Replace the current part with the output + from GnuPG; don't extract the plaintext by itself. + + * mm-uu.el (mm-uu-pgp-beginning-signature): Abolish. + (mm-uu-pgp-signed-extract-1): Bind coding-system-for-read when calling + mml2015-clear-verify-function; don't touch the armor headers or + dash-escaped text here. + +2007-08-24 Katsumi Yamaoka + + * gnus-art.el (gnus-article-edit-part): Don't jump to nonexistent part. + (gnus-mime-view-part-as-type-internal): Default to text/plain for text + parts, or application/octet-stream as a last resort. + (gnus-mime-view-part-as-type): Don't toggle display. + (gnus-mime-view-part-as-charset): Don't turn off display before + querying charset. + + * mm-view.el (mm-inline-text-html-render-with-w3): Don't add XEmacs + stuff to undisplayer function in Emacs. + (mm-inline-text-html-render-with-w3m): Remove Emacs/W3 stuff. + + * mml.el (mml-generate-mime-1): Prefer utf-8 when encoding + text/calendar parts. + 2007-08-23 Katsumi Yamaoka + * gnus-art.el (gnus-mime-display-single): Use utf-8 by default for + decoding text/calendar parts. + + * message.el (message-forward-make-body-mime): Always mark body as + having no illegible text; remove signed-or-encrypted argument. + (message-forward-make-body): Don't pass signed-or-encrypted arg to it. + * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer. (mml-generate-mime-1): Don't encode body if it is specified to be in raw form; don't make buffer be unibyte when inserting multibyte string. @@ -110,6 +327,14 @@ 2007-08-17 Katsumi Yamaoka + * imap.el (imap-logout-timeout): New variable. + (imap-logout, imap-logout-wait): New functions. + (imap-kerberos4-open, imap-gssapi-open, imap-close): Use them. + + * nnimap.el (nnimap-logout-timeout): New server variable. + (nnimap-open-server, nnimap-close-server): Bind imap-logout-timeout to + nnimap-logout-timeout. + * gnus-art.el (gnus-article-summary-command-nosave) (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer. @@ -124,20 +349,118 @@ (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Limit the range of articles according to gnus-maximum-newsgroup. +2007-08-14 Tassilo Horn + + * gnus-art.el (gnus-sticky-article): Fixed problems described in + on ding. Thanks to Katsumi. + Don't perform gnus-configure-windows here; reuse existing sticky + article buffer. + + * gnus-sum.el (gnus-summary-display-article): Setup article buffer if + it doesn't exist in gnus-article-mode. + +2007-08-13 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-decoded-group-names): New variable. + (gnus-agent-decoded-group-name): New function. + (gnus-agent-group-path, gnus-agent-group-pathname): Use it. + (gnus-agent-expire-group-1): Use it; decode group name in messages. + +2007-08-12 Tassilo Horn + + * gnus-sum.el (gnus-summary-article-map, gnus-summary-make-menu-bar): + Add binding for gnus-sticky-article. + (gnus-summary-exit): Don't kill sticky article buffers. + + * gnus-art.el (gnus-sticky-article-mode): New mode to generate a sticky + article buffer. + (gnus-sticky-article, gnus-kill-sticky-article-buffer) + (gnus-kill-sticky-article-buffers): New commands. + 2007-08-10 Katsumi Yamaoka * nntp.el (nntp-xref-number-is-evil): New server variable. (nntp-find-group-and-number): If it is non-nil, don't trust article numbers in the Xref header. +2007-08-09 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-read-group): New function. + (gnus-agent-flush-group, gnus-agent-expire-group) + (gnus-agent-regenerate-group): Use it. + (gnus-agent-expire-unagentized-dirs): Bind file-name-coding-system to + nnmail-pathname-coding-system. + 2007-08-06 Katsumi Yamaoka * gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t. + * gnus-sum.el (gnus-summary-insert-articles): Mark inserted articles + that are unread as unread, and also as selected so that information of + marks having been changed by a user may be updated when exiting group. + 2007-08-04 Reiner Steib * gnus-art.el (article-hide-headers): Bind inhibit-read-only to t. +2007-08-03 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-display-single): Pass part number that is + calculated ignoring signature parts to gnus-treat-article. + +2007-08-02 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-security-verify-or-decrypt): Don't narrow to + a point here in order to keep the window start. + (gnus-insert-mime-security-button): Make a button overlay without the + front stickiness. + (gnus-mime-display-security): Goto the end of a button. + + * gnus-group.el (gnus-group-name-at-point): Fix regexps. + +2007-08-01 Katsumi Yamaoka + + * gnus-group.el (gnus-group-name-at-point): Rewrite; rename from + group-name-at-point. + (gnus-group-completing-read): New function that offers decoded + non-ASCII group names for completion. + (gnus-fetch-group, gnus-group-read-ephemeral-group) + (gnus-group-jump-to-group, gnus-group-make-group-simple) + (gnus-group-unsubscribe-group, gnus-group-fetch-charter) + (gnus-group-fetch-control): Use it. + (gnus-fetch-group): Use group-name-at-point for the initial value + rather than the default value; use gnus-alive-p. + + * gnus-msg.el (gnus-group-mail, gnus-group-news, gnus-group-post-news) + (gnus-summary-mail-other-window, gnus-summary-news-other-window) + (gnus-summary-post-news): Use gnus-group-completing-read. + + * gnus-sum.el (gnus-select-newsgroup): Decode group name in error msg. + (gnus-read-move-group-name): Decode group name for completion. + +2007-07-31 Ted Zlatanov + + * gnus-srvr.el (gnus-server-close-all-servers): Close servers not only + in gnus-inserted-opened-servers but also in gnus-server-alist (Katsumi + Yamaoka slightly modified the code). + +2007-07-24 Katsumi Yamaoka + + * nnmail.el (nnmail-group-names-not-encoded-p): New variable. + (nnmail-split-incoming): Bind it. + + * nnml.el (nnml-group-name-charset): New function. + (nnml-decoded-group-name): Use it; don't decode group name if + nnmail-group-names-not-encoded-p is non-nil. + (nnml-encoded-group-name): New function. + (nnml-group-pathname): Inline nnml-decoded-group-name. + (nnml-request-expire-articles): Decode group name in message. + (nnml-request-delete-group): Ditto; bind file-name-coding-system to + nnmail-pathname-coding-system. + (nnml-save-mail, nnml-active-number): Work with decoded group names and + not decoded ones according to nnmail-group-names-not-encoded-p. + (nnml-generate-active-info): Use nnml-encoded-group-name. + 2007-08-08 Glenn Morris * gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el @@ -148,20 +471,125 @@ * Relicense all FSF files to GPLv3 or later. -2007-07-24 Katsumi Yamaoka - - * gnus-msg.el (gnus-summary-supersede-article) - (gnus-summary-resend-message-edit): Add Gcc header. - (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent - article's Message-ID; refer parent article in summary buffer. - - * message.el (message-bounce): Call mime-to-mml. +2007-07-23 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-move-article): Make + gnus-summary-respool-article work. 2007-07-21 Reiner Steib * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc string. +2007-07-20 Micha,Ak(Bl Cadilhac + + * nnrss.el (nnrss-ignore-article-fields): New variable. List of fields + that should be ignored when comparing distant RSS articles with local + ones. + (nnrss-make-hash-index): New function. Create a hash index according + to the ignored fields. + (nnrss-check-group): Use it. + +2007-07-20 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-group-pathname): Take notice of the method. + + * gnus-art.el (article-decode-group-name): Decode Xref header too. + + * gnus-group.el (gnus-group-make-group): Encode group name here unless + the new optional argument ENCODED is non-nil. + (gnus-group-make-doc-group): Use gnus-group-name-charset to determine + coding system for encoding group name. + (gnus-group-make-rss-group): Pass un-encoded group name to + gnus-group-make-group. + (gnus-group-set-info): Tell gnus-group-make-group that group name is + encoded. + + * gnus-sum.el (gnus-summary-move-article, gnus-read-move-group-name): + Encode group name to which articles are moved or copied. + (gnus-summary-edit-article): Use gnus-group-name-charset to determine + coding system for encoding Newsgroup, Followup-To and Xref headers. + + * nnagent.el (nnagent-request-set-mark): Use unibyte buffer to compose + marks; use nnheader-file-coding-system to write a file. + (nnagent-retrieve-headers): Bind file-name-coding-system to + nnmail-pathname-coding-system. + + * nnmail.el (nnmail-insert-xref): Don't break non-ASCII group name. + + * nnml.el (nnml-decoded-group-name, nnml-group-pathname): New functions. + (nnml-request-article, nnml-request-create-group) + (nnml-request-rename-group, nnml-find-id) + (nnml-possibly-change-directory, nnml-possibly-create-directory) + (nnml-save-mail, nnml-active-number, nnml-marks-changed-p) + (nnml-save-marks): Use nnml-group-pathname instead of + nnmail-group-pathname. + + (nnml-request-create-group, nnml-request-expire-articles) + (nnml-request-move-article, nnml-request-delete-group) + (nnml-deletable-article-p, nnml-possibly-create-directory) + (nnml-get-nov-buffer, nnml-generate-nov-databases-directory) + (nnml-open-marks): Bind file-name-coding-system to + nnmail-pathname-coding-system. + + (nnml-request-article): Pass server argument to nnml-find-group-number. + (nnml-request-create-group, nnml-active-number, nnml-save-marks): Pass + server argument to nnml-possibly-create-directory. + (nnml-request-accept-article): Pass server argument to + nnml-active-number and nnml-save-mail. + (nnml-find-group-number): Pass server argument to nnml-find-id. + (nnml-request-update-info): Pass server argument to + nnml-marks-changed-p. + + (nnml-find-id, nnml-find-group-number, nnml-possibly-create-directory) + (nnml-save-mail, nnml-active-number): Add server argument. + + (nnml-request-delete-group): Warn if group is missing. + (nnml-get-nov-buffer): Decode group name. + (nnml-generate-active-info): Encode group name. + (nnml-open-marks): Decode group name in messages. + +2007-07-19 Katsumi Yamaoka + + * gnus-art.el (gnus-article-part-wrapper): Work with the nearest part + if it is not specified. + (gnus-article-pipe-part, gnus-article-save-part) + (gnus-article-interactively-view-part, gnus-article-copy-part) + (gnus-article-view-part-as-charset, gnus-article-view-part-externally) + (gnus-article-inline-part, gnus-article-save-part-and-strip) + (gnus-article-replace-part, gnus-article-delete-part) + (gnus-article-view-part-as-type): Pass raw prefix argument to + gnus-article-part-wrapper. + +2007-07-18 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-save-active): Bind + nnheader-file-coding-system to gnus-agent-file-coding-system. + + * gnus-cache.el (gnus-cache-save-buffers) + (gnus-cache-possibly-enter-article, gnus-cache-request-article) + (gnus-cache-retrieve-headers, gnus-cache-change-buffer) + (gnus-cache-possibly-remove-article, gnus-cache-articles-in-group) + (gnus-cache-braid-nov, gnus-cache-braid-heads) + (gnus-cache-generate-active, gnus-cache-rename-group) + (gnus-cache-delete-group, gnus-cache-update-file-total-fetched-for) + (gnus-cache-update-overview-total-fetched-for): Bind + file-name-coding-system to nnmail-pathname-coding-system. + (gnus-cache-decoded-group-names, gnus-cache-unified-group-names): New + variables. + (gnus-cache-decoded-group-name): New function. + (gnus-cache-file-name): Use it. + (gnus-cache-generate-active): Use non-decoded group name for active. + + * gnus-util.el (gnus-write-buffer): Bind file-name-coding-system at the + right place. + (gnus-write-active-file): Don't break non-ASCII group names. + + * nntp.el (nntp-marks-changed-p): Bind file-name-coding-system to + nnmail-pathname-coding-system. + + * gnus-uu.el (gnus-uu-decode-save): Typo. + 2007-07-16 Katsumi Yamaoka * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces. @@ -173,11 +601,63 @@ 2007-07-13 Katsumi Yamaoka + * gnus-agent.el (gnus-agent-rename-group, gnus-agent-delete-group) + (gnus-agent-fetch-articles, gnus-agent-unfetch-articles) + (gnus-agent-crosspost, gnus-agent-backup-overview-buffer) + (gnus-agent-flush-group, gnus-agent-flush-cache) + (gnus-agent-fetch-headers, gnus-agent-load-alist) + (gnus-agent-read-agentview, gnus-agent-expire-group-1) + (gnus-agent-retrieve-headers, gnus-agent-request-article) + (gnus-agent-regenerate-group) + (gnus-agent-update-files-total-fetched-for) + (gnus-agent-update-view-total-fetched-for): Bind + file-name-coding-system to nnmail-pathname-coding-system. + (gnus-agent-group-pathname): Don't encode file names by + nnmail-pathname-coding-system. + (gnus-agent-save-local): Bind file-name-coding-system correctly; bind + coding-system-for-write instead of buffer-file-coding-system to + gnus-agent-file-coding-system. + + * gnus-msg.el (gnus-inews-make-draft, gnus-inews-insert-archive-gcc): + Decode group name. + + * gnus-srvr.el (gnus-browse-foreign-server): Make group names unibyte. + + * gnus-start.el (gnus-update-active-hashtb-from-killed) + (gnus-read-newsrc-el-file): Make group names unibyte. + + * nnmail.el (nnmail-group-pathname): Don't encode file names by + nnmail-pathname-coding-system. + + * nnrss.el (nnrss-file-coding-system): Doc fix; make it begin with *. + (nnrss-request-delete-group): Bind file-name-coding-system to + nnmail-pathname-coding-system. + (nnrss-read-server-data, nnrss-read-group-data): Bind + file-name-coding-system correctly. + (nnrss-check-group): Pass nnrss-file-coding-system to md5. + + * nntp.el: Require gnus-group for the function gnus-group-name-charset. + (nntp-server-to-method-cache): New variable. + (nntp-group-pathname): New function that decodes non-ASCII group names. + (nntp-possibly-create-directory, nntp-marks-changed-p) + (nntp-save-marks, nntp-open-marks): Use it. + (nntp-possibly-create-directory, nntp-open-marks): + Bind file-name-coding-system to nnmail-pathname-coding-system. + (nntp-open-marks): Decode group names when bootstrapping marks. + + * rfc2047.el (rfc2047-encode-message-header): Make XEmacs decode + Newsgroups and Folowup-To headers. + +2007-07-13 Katsumi Yamaoka + * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face) (gnus-server-closed-face, gnus-server-denied-face) (gnus-server-offline-face): Remove variable. (gnus-server-font-lock-keywords): Use faces that are not aliases. + * gnus-util.el (gnus-message-with-timestamp-1): Use log-message instead + of modifying message-stack directly for XEmacs. + * mm-util.el (mm-decode-coding-string, mm-encode-coding-string) (mm-decode-coding-region, mm-encode-coding-region): Don't modify string if the coding-system argument is nil for XEmacs. @@ -190,6 +670,18 @@ (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not to quote the parameter value. +2007-07-06 Katsumi Yamaoka + + * gnus-group.el (gnus-group-name-charset): Allow a method of the short + form in gnus-group-name-charset-method-alist. + + * gnus-eform.el (gnus-edit-form): Add optional argument layout which + overrides the default layout edit-form. + + * gnus-win.el (gnus-buffer-configuration): Add edit-server. + + * gnus-srvr.el (gnus-server-edit-server): Use edit-server layout. + 2007-07-04 Katsumi Yamaoka * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles @@ -199,11 +691,39 @@ * gnus-start.el (gnus-level-unsubscribed): Improve doc string. +2007-07-02 Katsumi Yamaoka + + * nnagent.el (nnagent-request-set-mark): Also set the marks for the + original back end that keeps marks in the local system. + 2007-06-26 Katsumi Yamaoka - * gnus-art.el (gnus-article-summary-command-nosave) - (gnus-article-read-summary-keys): Don't set the 3rd arg of - pop-to-buffer for XEmacs. + * gnus-art.el (gnus-article-summary-command-nosave): Don't set the 3rd + arg of pop-to-buffer for XEmacs. + (gnus-article-read-summary-keys): Ditto; don't restore window + configuration if summary command ends up with neither article buffer + nor summary buffer; describe bindings if summary keys end with C-h. + +2007-06-22 Katsumi Yamaoka + + * message.el (message-fix-before-sending): Skip raw message part to be + forwarded while checking illegible text. + (message-forward-make-body-mime, message-forward-make-body): Mark + signed or encrypted raw message as having no illegible text. + +2007-06-19 Katsumi Yamaoka + + * gnus-util.el (gnus-add-timestamp-to-message): New user option. + (gnus-message-with-timestamp-1): New macro. + (gnus-message-with-timestamp): New function. + (gnus-message): Use them. + + * nnheader.el (nnheader-message): Use them. + +2007-06-16 Reiner Steib + + * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Add newlines to + .newsrc.eld file. 2007-06-14 Katsumi Yamaoka @@ -218,14 +738,26 @@ 2007-06-08 Katsumi Yamaoka + * gnus-ems.el (gnus-x-splash): Fix calculation; error in tty. + +2007-06-07 Katsumi Yamaoka + * gnus-ems.el (gnus-x-splash): Make it work. * gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash from being used. - * gnus-art.el (gnus-article-summary-command-nosave): Correct the order - of the arguments passed to pop-to-buffer. - (gnus-article-read-summary-keys): Ditto. +2007-06-05 Katsumi Yamaoka + + * gnus-art.el (gnus-insert-mime-button): Make a button overlay without + the front stickiness. + (gnus-article-summary-command-nosave): Correct the order of the + arguments passed to pop-to-buffer. + (gnus-article-read-summary-keys): Ditto; make it work properly when the + summary command ends up with the article buffer. + + * mm-decode.el (mm-insert-part): Separate the extracted parts that have + the same faces. 2007-06-07 Juanma Barranquero @@ -244,29 +776,182 @@ (gnus-mime-view-part-internally): Fix predicate function passed to completing-read. - * mm-decode.el (mm-image-fit-p): Return t if argument is not an image; - return t if image size is just the same as window size. + * mm-decode.el (mm-image-fit-p): Return t if argument is not an image. + + * gnus.el (gnus-update-message-archive-method): Add :version. + +2007-06-01 Katsumi Yamaoka + + * gnus.el (gnus-update-message-archive-method): New variable. + + * gnus-start.el (gnus-setup-news): Update saved "archive" method + according to gnus-message-archive-method if + gnus-update-message-archive-method is non-nil. + +2007-05-29 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-limit-to-address): New function. Suggested + by Loic Dachary . + (gnus-summary-limit-map, gnus-summary-make-menu-bar): Add it. 2007-05-28 Katsumi Yamaoka * message.el (message-pop-to-buffer): Add switch-function argument. (message-mail): Pass switch-function argument to it. +2007-05-25 Reiner Steib + + * mm-decode.el (mm-file-name-rewrite-functions): Make it customizable. + Improve doc string. + +2007-05-25 Katsumi Yamaoka + + * gnus-art.el (gnus-header-from, gnus-header-subject, gnus-header-name) + (gnus-header-content) + * gnus-cite.el (gnus-cite-10) + * gnus-srvr.el (gnus-server-closed) + * gnus.el (gnus-group-mail-1, gnus-group-mail-1-empty) + (gnus-group-mail-2, gnus-group-mail-2-empty, gnus-group-mail-3) + (gnus-group-mail-3-empty, gnus-group-mail-low) + (gnus-group-mail-low-empty, gnus-splash) + * message.el (message-header-to, message-header-cc) + (message-header-subject, message-header-other, message-header-name) + (message-header-xheader, message-separator, message-cited-text) + (message-mml): Lighten colors of faces used for dark background. + +2007-05-24 Simon Josefsson + + * nnimap.el (nnimap-need-unselect-to-notice-new-mail): Change default + to t as an experiment. Suggested by Greg Troxel . + 2007-05-24 Katsumi Yamaoka * message.el (message-narrow-to-headers-or-head): Ignore mail-header-separator in the body. +2007-05-23 Katsumi Yamaoka + + * mm-decode.el (mm-image-fit-p): Return t if image size is just the + same as window size. + +2007-05-22 Kevin Ryde + + * message.el (message-font-lock-keywords): Use message-header-xheader + face for "X-Foo", its apparent intended purpose. Move "X-" pattern + ahead of the anything pattern, to get it recognised. + +2007-05-12 Micha,Ak(Bl Cadilhac + + * gnus-sum.el (gnus-articles-to-read) + (gnus-summary-insert-old-articles): Don't truncate group name for + `read-string'. + + * gnus-util.el (gnus-limit-string): Delete this function. + + * gnus-sum.el (gnus-simplify-subject-fully): Use + `truncate-string-to-width' instead. + +2007-05-11 Micha,Ak(Bl Cadilhac + + * gnus-sum.el (gnus-summary-next-group-on-exit): New variable. Tell + if, on summary exit, the next group has to be selected. + (gnus-summary-exit): Use it. + 2007-05-10 Reiner Steib * gnus-art.el (gnus-article-mode): Fix comment about displaying non-break space. -2007-05-09 Didier Verna - - * gnus-diary.el, nndiary.el: Remove the description comment (nndiary is - now properly documented in the Gnus manual). Fix the spelling of "Back - End". +2007-05-10 Katsumi Yamaoka + + * nnfolder.el (nnfolder-request-group, nnfolder-request-create-group): + Check if group is not a directory. + (nnfolder-request-expire-articles): Don't delete articles if the target + group is not available. + + * nnml.el (nnml-request-create-group): Properly check if group is not a + file. + (nnml-request-expire-articles): Don't delete articles if the target + group is not available. + + * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): + Don't quote characters that are within parentheses. + +2007-05-09 Katsumi Yamaoka + + * gnus-sum.el (gnus-auto-select-on-ephemeral-exit): New variable. + (gnus-handle-ephemeral-exit): Select article according to it. + +2007-05-08 Reiner Steib + + * message.el (message-insert-formated-citation-line): Remove newline. + (message-citation-line-format): Add final \n here so that the user can + avoid a blank line. + +2007-05-03 Dan Christensen + + * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p) + (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head): + Update lanl/arXiv support. + +2007-05-02 Reiner Steib + + * gnus.el: Bump version number. + +2007-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump version. + +2007-05-01 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.6 is released. + +2007-04-27 Didier Verna + + * gnus-util.el (gnus-orify-regexp): Moved and renamed to ... + * gmm-utils.el (gmm-regexp-concat): here. + * message.el: Don't require 'gnus-util. + (message-dont-reply-to-names): Handle name change above. + * gnus-sum.el (gnus-ignored-from-addresses): Ditto. + +2007-04-26 Katsumi Yamaoka + + * mm-util.el (mm-charset-synonym-alist): Don't make it a user option + since the initial value varies according to the system. + +2007-04-25 Katsumi Yamaoka + + * mm-util.el (mm-charset-synonym-alist): Defcustom. + +2007-04-25 NAKAJI Hiroyuki (tiny change) + + * mm-util.el (mm-charset-synonym-alist): Map iso8859-1 to iso-8859-1. + +2007-04-24 Didier Verna + + Improve the type of gnus-ignored-from-addresses. + * gnus-util.el (gnus-orify-regexp): New function. + * message.el (gnus-util): Require it. + * message.el (message-dont-reply-to-names): Use gnus-orify-regexp. + * gnus-sum.el (gnus-ignored-from-addresses): New function. + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use it. + +2007-04-24 Didier Verna + + * gnus-sum.el: + * gnus-utils.el: Fix some trailing whitespaces. + +2007-04-23 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-resend-message-edit): Add Gcc header. + (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent + article's Message-ID; refer parent article in summary buffer. + + * message.el (message-bounce): Call mime-to-mml. + +2007-04-20 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-supersede-article): Add Gcc header. 2007-04-19 Katsumi Yamaoka @@ -274,12 +959,35 @@ (gnus-mime-view-part-as-charset): Use it; redisplay subpart currently displayed of multipart/alternative part if it is invoked from summary buffer. - (gnus-article-part-wrapper): Select article window. * mm-view.el (mm-inline-text-html-render-with-w3m) (mm-inline-text-html-render-with-w3m-standalone) (mm-inline-render-with-function): Use mail-parse-charset by default. +2007-04-18 Levin Du (tiny change) + + * parse-time.el (parse-time-string-chars): Check if CHAR + is less than the length of parse-time-syntax. + +2007-04-17 Katsumi Yamaoka + + * gnus-uu.el (gnus-uu-digest-mail-forward): Pull articles processed + from gnus-newsgroup-processable. + +2007-04-16 Didier Verna + + * gnus-msg.el (gnus-configure-posting-styles): Handle + message-signature-directory properly with :file syntax. Reported by + "Leo". + +2007-04-11 Didier Verna + + New user option: message-signature-directory. + * gnus-msg.el (gnus-configure-posting-styles): Support it. + * message.el (message-insert-signature): Ditto. + * message.el (message-signature-file): Doc update. + * message.el (message-signature-directory): New. + 2007-04-10 Katsumi Yamaoka * gnus-msg.el (gnus-inews-yank-articles): Use @@ -302,6 +1010,9 @@ 2007-03-31 Reiner Steib + * message.el (message-fill-column): New variable. + (message-mode): Use it. Add comment on a possible new hook. + * nnmail.el (nnmail-spool-file): Mark as obsolete. (nnmail-get-new-mail): Reformat. @@ -312,8 +1023,37 @@ 2007-03-27 Thien-Thi Nguyen - * message.el (message-yank-original): Fix bug: - Don't switch point and mark unnecessarily. + * message.el (message-yank-original): Don't switch point and mark + unnecessarily to put point and mark as documented. + +2007-03-27 Lars Magne Ingebrigtsen + + * message.el (message-put-addresses-in-ecomplete): Only fetch headers + from the message heads. + +2007-03-25 Kevin Greiner + + * gnus-art.el (gnus-article-set-window-start): Do nothing when the + article buffer does not have a window. This may not be the best + solution but is certainly better than setting the start of the null, + that is the current, window. + +2007-03-24 Reiner Steib + + * gnus-draft.el (gnus-draft-setup-hook): New hook. + (gnus-draft-setup): Run it. + + * gnus-score.el (gnus-inhibit-slow-scoring): New variable, renamed from + gnus-score-fast-scoring. Allow regexp. + (gnus-score-headers): Use it. + + * gnus-util.el (gnus-emacs-version): Include "no MULE" in no-MULE + XEmacs. + + * gnus-art.el (gnus-article-browse-html-article): Fix typo in doc + string. + (gnus-button-alist): Also catch ` k ...'. + (gnus-treat-display-x-face): Fix doc string. 2007-03-25 Andreas Seltenreich @@ -321,10 +1061,11 @@ evaluation of gnus-extended-version to ensure correct generation of the User-Agent header when message-generate-headers-first is used. -2007-03-24 Reiner Steib - - * gnus-art.el (gnus-button-alist): Also catch ` k ...'. - (gnus-treat-display-x-face): Fix doc string. +2007-03-24 Simon Josefsson + + * hashcash.el (hashcash-generate-payment-async): Don't crash if + hashcash-path is nil. Don't call callback with incorrect number of + parameters if val is 0. 2007-03-20 Andreas Seltenreich @@ -350,6 +1091,43 @@ (message-mail-other-window): Adjust argument of message-setup. (message-mail-other-frame): Ditto. +2007-03-13 Katsumi Yamaoka + + * gnus-cite.el (font-lock-set-defaults): Autoload it for Emacs. + (gnus-message-citation-mode): Require font-lock for XEmacs; make sure + to turn font-lock on when turning gnus-message-citation-mode on. + +2007-03-06 Daiki Ueno + + * mml-smime.el (mml-smime-use): New variable; default to use openssl. + (mml-smime-function-alist): New variable; add epg as the backend. + * mml-sec.el (mml-smime-sign): Don't require mml-smime, autoload + mml-smime- functions instead. + * mm-view.el: Require smime. + +2007-03-05 Didier Verna + + * gnus-topic.el (gnus-topic-hierarchical-parameters): Perform merging + instead of just inheritance for posting styles. + * gnus.el (gnus-group-fast-parameter): Fix typo in comment. + +2007-02-24 John Paul Wallington + + * tls.el (tls-certtool-program): Fix custom type. + +2007-02-28 Katsumi Yamaoka + + * gnus-cite.el (gnus-message-search-citation-line): Use point-at-bol + and point-at-eol instead of line-(beginning|end)-position. + + * assistant.el (assistant-parse-buffer): Ditto. + +2007-02-28 Daiki Ueno + + * mml2015.el (mml2015-epg-find-usable-key): New function. + (mml2015-epg-sign): Use it. + (mml2015-epg-encrypt): Use it. + 2007-02-28 Katsumi Yamaoka * message.el (message-make-in-reply-to): Quote name containing @@ -357,12 +1135,36 @@ if there are special characters. Reported by NAKAJI Hiroyuki . +2007-02-27 Didier Verna + + Include the group parameters as well as the topic ones in the + inheritance filter process. + * gnus-topic.el (gnus-topic-hierarchical-parameters): New optional + argument GROUP-PARAMS-LIST. + * gnus-topic.el (gnus-group-topic-parameters): Use it. + 2007-02-27 Katsumi Yamaoka * nntp.el (nntp-never-echoes-commands) (nntp-open-connection-functions-never-echo-commands): New variables. (nntp-send-command): Use them. +2007-02-20 Daiki Ueno + + * mml2015.el (mml2015-epg-verify): Simplified. + +2007-02-19 Katsumi Yamaoka + + * mml.el (mml-content-disposition-alist): New user option. + (mml-content-disposition): New function. + (mml-insert-mime-headers, mml-minibuffer-read-disposition): Use it. + (mml-attach-file, mml-dnd-attach-file): Pass file name to it. + +2007-02-19 Daiki Ueno + + * mml2015.el (mml2015-epg-verify): Convert LF to CRLF before signature + verification. + 2007-02-15 Andreas Seltenreich * nnweb.el (nnweb-google-parse-1): Fix date parsing to also match on @@ -372,6 +1174,57 @@ * smiley.el (smiley-regexp-alist): Add "dead" smiley. +2007-02-14 Micha,Ak(Bl Cadilhac + + * nntp.el (nntp-send-command): Don't wait for echoes when + nntp-open-ssl-stream is used. + +2007-02-13 Katsumi Yamaoka + + * gnus-cite.el (gnus-test-font-lock-add-keywords) + (gnus-message-add-citation-keywords) + (gnus-message-remove-citation-keywords): Remove. + (gnus-message-citation-mode): Instead of modifying font-lock-keywords + directly, make the variables in font-lock-defaults buffer-local, add + gnus-message-citation-keywords to them and then update the value of + font-lock-keywords. + +2007-02-09 Katsumi Yamaoka + + * message.el (message-cite-original-1): Don't call + gnus-article-highlight-citation. + + * gnus-cite.el (gnus-cite-parse): Work with two or more MS-type + citations; fix line count. + +2007-02-08 Katsumi Yamaoka + + * gnus-cite.el (gnus-test-font-lock-add-keywords): New function. + (gnus-message-add-citation-keywords) + (gnus-message-remove-citation-keywords): Use it; fix the emulating + versions of font-lock-add-keywords and font-lock-remove-keywords to + work with XEmacs correctly. + +2007-02-07 Katsumi Yamaoka + + * gnus-cite.el (gnus-cite-face-list): Set the values of + gnus-message-max-citation-depth and gnus-message-citation-keywords. + (gnus-message-max-citation-depth): Use defvar rather than defconst. + (gnus-message-cite-prefix-regexp): New variable. + (gnus-message-search-citation-line): Use it; protect against long + citation prefix; fill match data with nil rather than 0 for XEmacs; set + the 0th match data for Emacs. + (gnus-message-citation-keywords): Set LAXMATCH flag in every HIGHLIGHT. + (gnus-message-add-citation-keywords): Append keywords rather than + prepending; emulate font-lock-add-keywords if it is not available. + (gnus-message-remove-citation-keywords): Emulate + font-lock-remove-keywords if it is not available. + + * gnus-msg.el (gnus-message-highlight-citation): Default to t. + + * message.el (message-cite-prefix-regexp): Set the value of + gnus-message-cite-prefix-regexp. + 2007-02-01 Andreas Seltenreich * nnweb.el (nnweb-google-parse-1): Update parser. @@ -398,11 +1251,32 @@ * gnus-art.el (gnus-signature-limit): Fix custom choice. +2007-01-22 Daiki Ueno + + * mm-util.el (mm-inhibit-file-name-handlers): Add epa-file-handler. + + * mm-decode.el (mm-save-part-to-file): Use `mm-write-region' instead of + `write-region' to respect `mm-inhibit-file-name-handlers'. + 2007-01-19 Reiner Steib * nnsoup.el (nnsoup-directory, nnsoup-packer, nnsoup-packet-directory): Use gnus-home-directory instead of "~/" or "$HOME". +2007-01-17 Teodor Zlatanov + + * encrypt.el (encrypt-insert-file-contents): Add better prompt + to mention filename. + Add comments at beginning regarding usage. + (encrypt-write-file-contents): Change interactive so a string is + acceptable. If the file has no associated model, show an error instead + of a nonsense prompt. + +2007-01-16 TSUCHIYA Masatoshi + + * spam.el (spam-bsfilter-ham-switch): Fix typo. + Thanks to Yoshihiko Yamada for kind notification of this typo. + 2007-01-12 Kenichi Handa * uudecode.el (uudecode-decode-region-internal): Make it work in a @@ -410,35 +1284,76 @@ 2007-01-14 Reiner Steib + * gnus-score.el (gnus-score-fast-scoring): New variable. + (gnus-score-headers): Use it. + * gnus-sum.el (gnus-auto-select-first): Improve doc string. + * message.el (message-cite-original-1): Call + gnus-article-highlight-citation if requested. + + * gnus-cite.el (gnus-article-highlight-citation): Add SAME-BUFFER arg. + + * gnus-art.el (gnus-article-browse-html-article): Add warning about web + bugs to doc string. + (gnus-button-alist): Add mid\\|message-id. + (gnus-button-fetch-group): Extend for use in + `browse-url-browser-function'. + (gnus-button-url-regexp): Try to catch paired parentheses like in + Wikipedia URLs. + + * gnus-sum.el (gnus-summary-reparent-children): Another doc string fix. + Suggested by Simon Krahnke . + +2007-01-13 Romain Francoise + + * nnml.el (nnml-use-compressed-files): Fix typo in docstring. + Update copyright. + +2007-01-13 Patric Mueller (tiny change) + + * gnus-sum.el (gnus-summary-reparent-children): Fix typo in doc string. + +2007-01-09 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unfollowed-groups) + (gnus-registry-split-fancy-with-parent): Fix documentation. + +2007-01-08 Lars Magne Ingebrigtsen + + * spam-report.el (spam-report-gmane-internal): Speed up spam reporting + from nnweb groups. + +2006-12-31 Lars Magne Ingebrigtsen + + * spam-report.el (spam-report-gmane-internal): Add necessary "/" to + Xref urls. Erase buffer before requesting head. + + * mm-decode.el (mm-display-external): Use itimer function for XEmacs. + 2007-01-07 Reiner Steib - * gnus-soup.el: Add missing :group in previous change. - -2007-01-05 Reiner Steib - * gnus-soup.el (gnus-soup): New custom group. Make user variables customizable. -2007-01-03 Andreas Seltenreich +2007-01-05 Daiki Ueno + + * mml2015.el (mml2015-epg-sign): Ask user whether to skip or abort if + no signing key is found. + (mml2015-epg-encrypt): Ask user whether to skip or abort if + no encrypting and/or signing key is found. + +2007-01-03 Reiner Steib + + * spam-report.el (spam-report-gmane-spam): Remove redundant message. + +2007-01-01 Andreas Seltenreich * nnweb.el (nnweb-gmane-create-mapping): Put back code to merge the headers read from disk with the ones newly found in the current search. This should no longer cause problems, because the article numbers in Gmane's `nov.php' output are ignored since the previous change. -2006-01-03 Andreas Seltenreich - - * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for - solid groups. - -2006-01-03 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-gmane-create-mapping): Use the article number from - the headers when creating the mapping to avoid mismappings. - (nnweb-gmane-create-mapping): Always nix out old mapping. - 2007-01-02 Andreas Seltenreich * gmm-utils.el (gmm-tool-bar-style): Fix custom type. @@ -447,10 +1362,48 @@ * mm-decode.el (mm-display-external): Use itimer function for XEmacs. +2007-01-01 Romain Francoise + + * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo. + +2006-12-31 Steve Youngs + + * gnus-cite.el: Load easy-mmode at compile time for (S)XEmacs to get + `define-minor-mode' macro definition expanded properly. + (gnus-message-citation-mode): This is now OK for (S)XEmacs so don't + exclude it there. + + * gnus-msg.el (gnus-message-highlight-citation): Revert Reiner's patch + of 2006-12-30. The default is nil on (S)XEmacs already because of the + `fboundp' test. + (gnus-message-citation-mode): Revert Reiner's patch of 2006-12-30. + This is OK to autoload in (S)XEmacs now. + +2006-12-30 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-to-singletons): New command and + keystroke. + (gnus-summary-limit-to-singletons): Fix typo. + + * spam-report.el (spam-report-gmane-internal): Fall back on Xref if all + else fails. + 2006-12-30 Andreas Seltenreich - * gnus-sum.el (gnus-summary-insert-dormant-articles): Fix typo in - message. + * gnus-cite.el (turn-off-gnus-message-citation-mode): Fix typo in + docstring. + + * gnus-sum.el (gnus-summary-insert-ticked-articles): New command. + (gnus-summary-make-menu-bar, gnus-summary-buffer-map): Bind it. + (gnus-summary-insert-dormant-articles): Fix typo in message. + +2006-12-30 Reiner Steib + + * gnus-msg.el (gnus-message-highlight-citation): Ensure default to be + nil for XEmacs. + (gnus-message-citation-mode): Don't autoload in XEmacs. + + * gnus-cite.el (gnus-message-citation-mode): Don't define in XEmacs. 2006-12-29 Jouni K. Sepp,Ad(Bnen @@ -462,16 +1415,51 @@ * spam.el: Revert to make-obsolete-variable because define-obsolete-variable-alias is not supported in Emacs 21. + * spam.el (spam-ifile-path, spam-ifile-database-path) + (spam-bogofilter-path): Use define-obsolete-variable-alias instead of + make-obsolete-variable. + (spam-bsfilter-path, spam-bsfilter-program) + (spam-spamassassin-path, spam-spamassassin-program) + (spam-sa-learn-path, spam-sa-learn-program): Rename variables. Don't + use "path" inappropriately. + (spam-check-spamassassin, spam-spamassassin-register-with-sa-learn) + (spam-check-bsfilter, spam-bsfilter-register-with-bsfilter): Use new + variable names. + 2006-12-28 Daiki Ueno * gnus-sum.el (gnus-summary-next-article): Make sure we are in the summary buffer. -2006-12-27 Reiner Steib - - * spam.el (spam-ifile-path, spam-ifile-database-path) - (spam-bogofilter-path): Use define-obsolete-variable-alias instead of - make-obsolete-variable. + * password.el (password-cache-remove): Use clear-string to burn + password, if available. + +2006-12-26 Reiner Steib + + * gnus-msg.el (gnus-message-citation-mode): Fix autoload. + + * gnus-cite.el (gnus-message-highlight-citation): Move to gnus-msg.el. + + * gnus-msg.el (gnus-setup-message): Add gnus-message-citation-mode. + (gnus-message-highlight-citation): Move defcustom here from + gnus-cite.el. + (gnus-message-citation-mode): Autoload. + + * gnus-cite.el: Adjust Oliver's code to Gnus namespace. Add some + checks to make it compile with XEmacs. + (gnus-message-citation-mode): New minor mode. + (gnus-message-max-citation-depth, gnus-message-citation-keywords) + (gnus-message-highlight-citation): New variables. + (gnus-message-search-citation-line) + (gnus-message-add-citation-keywords) + (gnus-message-remove-citation-keywords) + (turn-on-gnus-message-citation-mode) + (turn-off-gnus-message-citation-mode): New functions. + +2006-12-26 Oliver Scholz + + * gnus-cite.el: Enable highlighting of different citation levels in + message-mode. 2006-12-26 Reiner Steib @@ -502,11 +1490,42 @@ them directly in the unibyte buffer that causes unexpected conversion in Emacs 23 (unicode). +2006-12-21 Andreas Seltenreich + + * message.el (message-generate-hashcash): Fix custom type. + +2006-12-20 Reiner Steib + + * gnus-sum.el (gnus-summary-recenter): Remove debug messages. + 2006-12-20 Reiner Steib * gnus-group.el (gnus-group-tool-bar-gnome): Exchange connect and disconnect icons. Add help text. +2006-12-20 Teodor Zlatanov + + * spam.el (spam-extra-header-to-number): CRM114 spam score is + negated to be consistent with the others we handle. + +2006-12-19 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-setup-buffer): Actually set the local + version of gnus-summary-buffer to something, so that we can use two + article buffers at the same time. + +2006-12-18 Teodor Zlatanov + + * spam.el (spam-necessary-extra-headers): Make spam-use-regex-headers + trigger all the extra headers. + (spam-extra-header-to-number): Don't require spam-use-crm114 for header + sorting. + +2006-12-14 Andreas Seltenreich + + * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for + solid groups. + 2006-12-13 Reiner Steib * legacy-gnus-agent.el: Add Copyright notice. @@ -515,6 +1534,15 @@ * gnus-sum.el (gnus-make-thread-indent-array): Fix last change. +2006-12-10 Lars Magne Ingebrigtsen + + * nnweb.el (nnweb-gmane-search): Placeholder TOPDOC setting. + + * gnus-sum.el (gnus-summary-recenter): Force setting the window start + to make it work reliably in CVS Emacs. + (gnus-summary-limit-strange-charsets-predicate) + (gnus-summary-limit-to-predicate): New functions. + 2006-12-08 Chong Yidong * gnus-sum.el (gnus-make-thread-indent-array): New optional arg @@ -534,16 +1562,35 @@ * mm-url.el (mm-url-predefined-programs): Call curl with correct options. +2006-12-01 Lars Magne Ingebrigtsen + + * spam-report.el (spam-report-url-ping-plain): Wait for output to avoid + DOS-ing the recipient. + + * nnweb.el (nnweb-gmane-create-mapping): Use the article number from + the headers when creating the mapping to avoid mismappings. + (nnweb-gmane-create-mapping): Always nix out old mapping. + 2006-11-30 Katsumi Yamaoka - * mml2015.el (mml2015-pgg-clear-verify): Replace encode-coding-string - with mm-encode-coding-string. + * message.el (message-signed-or-encrypted-p): Bind mm-decrypt-option + and mm-verify-option to never. + +2006-11-30 Katsumi Yamaoka + + * message.el (message-signed-or-encrypted-p): New function. + (message-forward-make-body): Use it. + + * mml2015.el (mml2015-pgg-clear-verify, mml2015-epg-clear-verify): + Replace encode-coding-string with mm-encode-coding-string. 2006-11-29 Katsumi Yamaoka * nneething.el (nneething-decode-file-name): Replace decode-coding-string with mm-decode-coding-string. + * gnus-int.el (gnus-open-server): Say failed server's name. + 2006-11-24 Juanma Barranquero * gnus-agent.el (gnus-agent-expire-unagentized-dirs) @@ -560,10 +1607,26 @@ (gnus-valid-select-methods, total-expire, gnus-summary-line-format) (gnus-group-read-only-p): Fix space/tab mixup in docstrings. +2006-11-24 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-summary-limit-to-headers): New command and + keystroke. + (gnus-summary-limit-to-bodies): Implement headersp. + +2006-11-23 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Protect against "Process dns deleted" strings. + 2006-11-21 Katsumi Yamaoka * mm-util.el (mm-string-to-multibyte): Alias to identity in XEmacs. +2006-11-21 Lars Magne Ingebrigtsen + + * message.el (message-generate-hashcash): Expand range of values to + include `opportunistic'. + (message-send-mail): Use it. + 2006-11-18 Andreas Seltenreich * mm-uu.el (mm-uu-pgp-signed-extract-1): Make last fix more thorough @@ -587,6 +1650,15 @@ `customize-variable'. (gnus-getenv-nntpserver): Don't autoload. +2006-11-14 Teodor Zlatanov + + * spam.el: Revert to 7.82 (removed changes since 2006-10-16). + +2006-11-14 Reiner Steib + + * message.el (message-sendmail-extra-arguments): New variable. + (message-send-mail-with-sendmail): Use it. + 2006-11-14 Katsumi Yamaoka * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of @@ -595,16 +1667,39 @@ * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of mm-string-as-multibyte. +2006-11-14 Daiki Ueno + + * mml2015.el (mml2015-epg-sign): Prefix "pgp-" to a micalg value. + Reported by Werner Koch . + +2006-11-14 Daiki Ueno + + * mml2015.el: Autoload epa-select-keys when compiling. + +2006-11-13 Daiki Ueno + + * mml2015.el (mml2015-epg-sign): Save the signing keys in + message-options. + (mml2015-epg-encrypt): Save the recipient keys in message-options. + +2006-11-13 Daiki Ueno + + * mml2015.el (mml2015-epg-encrypt): Removed backward compatibility for + EasyPG (< 0.0.6). + (mml2015-always-trust): New user option. + (mml2015-epg-passphrase-callback): Display key ID on the passphrase + prompt. + +2006-11-10 Katsumi Yamaoka + + * nntp.el (nntp-authinfo-force): New variable. + (nntp-send-authinfo): Use it. + 2006-11-09 Reiner Steib - * message.el: Merge from the trunk to fix the bug WRT double encoded - subjects. - (message-replacement-char): New variable. - (message-fix-before-sending): Use it. - (message-simplify-subject): New function to remove duplicate code. - (message-reply, message-followup): Use it. - (message-simplify-subject-functions): New variable. - (message-strip-subject-encoded-words): New function. + * message.el (message-strip-subject-encoded-words): Allow _not_ to + decode encoded words. Improve prompt. Add comment about forwarding. + (message-replacement-char): Move up. 2006-11-08 Wolfgang Jenkner (tiny change) @@ -612,6 +1707,19 @@ instead of gnus-intersection because arguments of gnus-sorted-nunion must be sorted. This avoids corruption of gnus-newsgroup-unreads. +2006-11-07 Reiner Steib + + * message.el (message-strip-subject-encoded-words): Reformat prompt. + (message-simplify-subject-functions): Enable + message-strip-subject-encoded-words by default. + +2006-11-06 Reiner Steib + + * message.el (message-strip-subject-encoded-words): New function + (message-simplify-subject-functions): New variable. + (message-simplify-subject): Use it. Fix typo in doc string. + Support message-strip-subject-encoded-words. + 2006-11-03 Juanma Barranquero * gnus-diary.el (gnus-diary-delay-format-function): @@ -647,6 +1755,12 @@ * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible with Emacs 21 and XEmacs. +2006-10-27 Teodor Zlatanov + + * spam.el (spam-parse-address): New function for better parsing, + catching errors, etc. + (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use it. + 2006-10-26 Reiner Steib * mm-view.el: Add interactive arg to html2text autoload. @@ -655,6 +1769,27 @@ * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'. +2006-10-24 Reiner Steib + + * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list): New + variables. + (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions. + (mm-charset-synonym-alist): Move some entries to + mm-codepage-iso-8859-list. + + * gnus.el (gnus-getenv-nntpserver, gnus-select-method): Autoload. + +2006-10-23 Reiner Steib + + * message.el (message-citation-line-format) + (message-insert-formated-citation-line): Fix implementation of %E, %N + and %n according to the doc string. + +2006-10-20 Teodor Zlatanov + + * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use + car-safe to avoid bad parses. + 2006-10-20 Katsumi Yamaoka * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group @@ -664,12 +1799,32 @@ 2006-10-19 Katsumi Yamaoka - * message.el (message-headers-to-generate): Fix typo in docstring. + * gnus-draft.el (gnus-draft-edit-message): Make sure to remove Date + header. + + * message.el (message-draft-headers): Add Date. + (message-headers-to-generate): Fix typo in docstring. + + * nndraft.el (nndraft-required-headers): New variable. + (nndraft-generate-headers): Use it. + + * gnus-registry.el (gnus-registry-wash-for-keywords): Bind `word'. + +2006-10-16 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-wash-for-keywords) + (gnus-registry-find-keywords): New functions to allow easy searching of + articles that are in the registry. + +2006-10-16 Teodor Zlatanov + + * spam.el (spam-check-BBDB, spam-enter-ham-BBDB, spam-parse-list): Use + ietf-drums-parse-address instead of gnus-extract-address-components. + Reported by Damien Elmes . 2006-10-19 Reiner Steib * gnus.el (gnus-mime): Remove unused custom group. - (gnus-getenv-nntpserver, gnus-select-method): Autoload. 2006-10-13 Andreas Seltenreich @@ -693,37 +1848,51 @@ 2006-10-04 Reiner Steib + * mm-util.el (mm-charset-synonym-alist, mm-charset-override-alist): Add + iso-8859-8/windows-1255 and iso-8859-9/windows-1254. + + * nnheader.el (nnheader-find-file-noselect): Inhibit version-control. + + * message.el (message-replacement-char): New variable. + (message-fix-before-sending): Use it. + (message-simplify-subject): New function to remove duplicate code. + (message-reply, message-followup): Use it. + * gnus-sum.el (gnus-summary-make-menu-bar): Clarify gnus-summary-limit-to-articles. -2006-10-04 Romain Francoise - - * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist): - Moved here (and renamed) from gnus-registry.el. - - * gnus-registry.el: Require gnus-util. - Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'. - -2006-10-04 Reiner Steib - - * pop3.el (pop3-authentication-scheme): Clarify doc. - (pop3-movemail): Warn about pop3-leave-mail-on-server. - -2006-10-04 Dave Love - - * pop3.el (pop3-authentication-scheme): Add custom version. - -2006-10-04 Jesper Harder - - * pop3.el (pop3-leave-mail-on-server): Don't quote nil in - doc string. Improve doc string. - 2006-10-03 Katsumi Yamaoka * gnus-util.el (gnus-with-local-quit): New macro. * gnus-demon.el (gnus-demon): Replace with-local-quit with it. +2006-10-02 Teodor Zlatanov + + * gnus-util.el (gnus-string-remove-all-properties): Another fix to + ignore non-string data. + +2006-09-29 Teodor Zlatanov + + * gnus-util.el (gnus-string-remove-all-properties): Fix to ignore + non-string data (needs to be done in the registry too). + +2006-09-28 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-save, gnus-registry-cache-save) + (gnus-registry-remove-alist-text-properties, gnus-registry-action) + (gnus-registry-split-fancy-with-parent) + (gnus-registry-fetch-simplified-message-subject-fast) + (gnus-registry-fetch-sender-fast, gnus-registry-store-extra-entry): + Remove text properties on ingress into the registry and when it's saved. + (gnus-registry-clean-empty-function): Fix bug with cleaning the + registry from entries with no groups. + +2006-09-28 Teodor Zlatanov + + * gnus-util.el (gnus-string-remove-all-properties): Add utility + function to remove string properties. + 2006-09-28 Reiner Steib * gmm-utils.el (gmm): Adjust custom version. @@ -733,10 +1902,35 @@ * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'. +2006-09-27 Reiner Steib + + * gnus-art.el (gnus-insert-prev-page-button) + (gnus-insert-next-page-button): Simplify. Reformat. + +2006-09-27 Maxime Edouard Robert Froumentin + + * gnus-art.el (gnus-insert-prev-page-button) + (gnus-insert-next-page-button): Apply gnus-article-button-face. + 2006-09-25 Chong Yidong * gnus-demon.el (gnus-demon): Use with-local-quit to avoid hangs. +2006-09-20 Maxime Edouard Robert Froumentin + + (gnus-insert-mime-button, gnus-insert-mime-security-button): Apply + gnus-article-button-face to MIME and security buttons. + +2006-09-20 Reiner Steib + + * gnus-art.el (gnus-button-url-regexp): Try to make the value more + readable. + +2006-09-20 Steve Youngs + + * gnus-art.el (gnus-article-browse-html-parts): They're files, so use + `browse-url-of-file' instead of `browse-url'. + 2006-09-19 Andreas Seltenreich * nnslashdot.el (nnslashdot-request-article): Update end-of-article @@ -744,31 +1938,67 @@ 2006-09-16 Katsumi Yamaoka - * message.el (message-cite-original-without-signature): Use nobody by - default for the value of From header. - (message-cite-original): Ditto. + * message.el (message-cite-original-1): Use nobody by default for the + value of From header. (message-reply): Ditto. +2006-09-11 Daiki Ueno + + * mml2015.el (mml2015-epg-clear-decrypt): Don't append verify results + to the gnus-info. This fixes a bug of inline-PGP message verification. + Reported by Michael Piotrowski . + 2006-09-09 Reiner Steib * pop3.el (pop3-leave-mail-on-server): Mention problem of duplicate mails in the doc string. Add some URLs in comment. + (pop3-movemail): Warn about pop3-leave-mail-on-server. 2006-09-07 Katsumi Yamaoka * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Fix backslashes handling and the way to find boundaries of quoted strings. +2006-09-07 Daiki Ueno + + * mml1991.el (mml1991-epg-encrypt): Simply throw an error if + mml1991-encrypt-to-self is set and mml1991-signers is not set. + * mml2015.el (mml2015-epg-encrypt): Simply throw an error if + mml2015-encrypt-to-self is set and mml2015-signers is not set. + 2006-09-06 Reiner Steib - * gnus-art.el (gnus-button-regexp, gnus-button-marker-list) - (gnus-button-last): Move up. Convert comments into doc strings. + * gnus-art.el (gnus-button-marker-list): Move up. Convert comment into + doc string. + (gnus-button-regexp, gnus-button-last): Remove unused variables. + +2006-09-06 Simon Josefsson + + * mml2015.el (mml2015-use): Doc fix, mention epg. + +2006-09-06 Daiki Ueno + + * mml2015.el (mml2015-use): Default to epg, if available. + +2006-09-06 Daiki Ueno + + * mml1991.el (mml1991-epg-sign): Don't lookup a private key by + message-sender. + (mml1991-epg-encrypt): Ditto. + * mml2015.el (mml2015-epg-sign): Don't lookup a private key by + message-sender. + (mml2015-epg-encrypt): Ditto. 2006-09-04 Chong Yidong * message.el (message-send-mail-with-sendmail): Look for sendmail in several common directories. +2006-09-05 Daiki Ueno + + * mml2015.el (mml2015-epg-encrypt): Expand group configuration. + * mml1991.el (mml1991-epg-encrypt): Expand group configuration. + 2006-09-04 Katsumi Yamaoka * gnus-art.el (article-decode-encoded-words): Make it fast. @@ -810,16 +2040,36 @@ (rfc2047-decode-address-region): New function. (rfc2047-decode-address-string): New function. -2006-08-23 Andreas Seltenreich - - [ Backported bug fix from No Gnus. ] - - * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try - looking up the method using GROUP's prefix before inventing a new one. - It is used on killed/unknown groups in various places where returning - an all-new method isn't expected by the caller. - - * gnus-util.el (gnus-group-server): Copy required macro from No Gnus. +2006-08-31 Reiner Steib + + * message.el (message-caesar-buffer-body): Allow rotating headers. + + * gnus-sum.el (gnus-summary-caesar-message): Allow rotating headers. + + * message.el (message-insert-formated-citation-line): Fix %f. + Reported by Torsten Bronger . + +2006-08-18 Katsumi Yamaoka + + * gnus-bookmark.el (gnus-bookmark-file-coding-system): New variable. + (gnus-bookmark-mouse-available-p): New macro. + (gnus-bookmark-bmenu-list): Use it; use gnus-mouse-2. + (gnus-bookmark-bmenu-show-infos): Use it. + (gnus-bookmark-insert-details): Use it; use gnus-mouse-2. + (gnus-bookmark-bmenu-hide-infos): Ditto. + (gnus-bookmark-remove-properties): New function. + (gnus-bookmark-set, gnus-bookmark-make-cell): Use it. + (gnus-bookmark-set-bookmark-name): Don't use 2nd arg of split-string. + (gnus-bookmark-write-file): Bind coding-system-for-write. + (gnus-bookmark-insert-file-format-version-stamp): Add coding cookie. + (gnus-bookmark-jump): Make completing-read work with XEmacs; activate + group before selecting it. + (gnus-bookmark-get-bookmark): Use assoc instead of assoc-string. + (gnus-bookmark-bmenu-mode-map): Bind `q' to bury-buffer instead of + quit-window if it is not available; use gnus-mouse-2 and bind it to + gnus-bookmark-bmenu-select-by-mouse. + (gnus-bookmark-show-details): Remove unused variable `details-list'. + (gnus-bookmark-bmenu-select-by-mouse): New function. 2006-08-13 Romain Francoise @@ -849,11 +2099,66 @@ * nnheader.el (nnheader-insert-head): Make it work with Mac as well. +2006-07-28 Daiki Ueno + + * mml2015.el (mml2015-epg-sign): If mml2015-signers is not set, use the + first matching secret key. + (mml2015-epg-encrypt): Ditto. + + * mml1991.el (mml1991-epg-sign): If mml1991-signers is not set, use the + first matching secret key. + (mml1991-epg-encrypt): Ditto. + + * mml2015.el (mml2015-encrypt-to-self): New user option. + (mml2015-epg-encrypt): Append mml2015-signers to recipients list if + mml2015-epg-encrypt-to-self is set. + + * mml1991.el (mml1991-encrypt-to-self): New variable. + (mml1991-epg-encrypt): Append mml1991-signers to recipients list if + mml1991-epg-encrypt-to-self is set. + + * mml2015.el (mml2015-signers): New user option. + (mml2015-epg-sign): Reflect the value of mml2015-signers. + (mml2015-epg-encrypt): Allow to select signing keys. + + * mml1991.el (mml1991-signers): New variable. + (mml1991-epg-sign): Reflect the value of mml1991-signers. + (mml1991-epg-encrypt): Allow to select signing keys. + 2006-07-27 Katsumi Yamaoka * nnheader.el (nnheader-insert-head): Make it work even if the file uses CRLF for the line-break code. +2006-07-25 Daiki Ueno + + * mml2015.el: Require mml-sec instead of password. + (mml2015-verbose): Inherit the default value from mml-secure-verbose. + (mml2015-cache-passphrase): Inherit the default value from + mml-secure-cache-passphrase. + (mml2015-passphrase-cache-expiry): Inherit the default value from + mml-secure-passphrase-cache-expiry. + + * mml1991.el: Require mml-sec instead of password. + (mml1991-verbose): Inherit the default value from mml-secure-verbose. + (mml1991-cache-passphrase): Inherit the default value from + mml-secure-cache-passphrase. + (mml1991-passphrase-cache-expiry): Inherit the default value from + mml-secure-passphrase-cache-expiry. + + * mml-sec.el: Require password. + (mml-secure-verbose): New user option. + (mml-secure-cache-passphrase): New user option. + (mml-secure-passphrase-cache-expiry): New user option. + +2006-07-24 Daiki Ueno + + * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8 + letters from the end. Thanks to "David Smith" and + andreas@altroot.de (Andreas V,Av(Bgele) + + FIXME: Use `tiny change'? + 2006-07-19 Andreas Seltenreich * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close @@ -861,25 +2166,17 @@ * nnweb.el (nnweb-google-create-mapping): Update regexp. +2006-07-19 Katsumi Yamaoka + + * gnus-sum.el (gnus-select-newsgroup): Setup the article buffer + correctly. This fixes a bug caused by the 2006-05-12 change. + 2006-07-18 Karl Fogel * nnmail.el (nnmail-article-group): If splitting raises an error, give some information about the error when saying that the `bogus' mail group will be used. -2006-07-18 Andreas Seltenreich - - [ Backported bug fixes from No Gnus. ] - - * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. - (nnweb-google-search): Respect nnweb-max-hits as upper bound. - (nnweb-request-article): Do proper xwfu encoding when fetching articles - by message-id. - - * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe - unsubscribed groups as if they were killed ones. It causes duplicate - entries in gnus-newsrc-alist. - 2006-07-17 Reiner Steib * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc @@ -893,24 +2190,133 @@ * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix. +2006-07-10 Daiki Ueno + + * mml1991.el (mml1991-function-alist): Add epg. + (mml1991-epg-passphrase-callback, mml1991-epg-sign) + (mml1991-epg-encrypt): New functions. + +2006-07-10 Daiki Ueno + + * mml2015.el (mml2015-verbose): New variable. + (mml2015-cache-passphrase): Ditto. + (mml2015-passphrase-cache-expiry): Ditto. + (mml2015-function-alist): Add epg. + (mml2015-epg-passphrase-callback, mml2015-epg-decrypt) + (mml2015-epg-clear-decrypt, mml2015-epg-verify) + (mml2015-epg-clear-verify, mml2015-epg-sign, mml2015-epg-encrypt): New + functions. + +2006-07-08 Andreas Seltenreich + + * message.el (message-cite-original-1): Preserve region when removing + quoted text due to X-No-Archive in order to avoid bogus attribution + when citing multiple messages. + +2006-06-27 Andreas Seltenreich + + * gnus-group.el (gnus-group-sort-by-unread): Fix typo. Reported by + Kenneth Jacker . + 2006-06-26 Reiner Steib * gnus-diary.el (gnus-user-format-function-d) (gnus-user-format-function-D): Autoload. -2006-06-26 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-select-group): Doc fix. - [ See 2004-05-19 change on the trunk. ] + * imap.el (Commentary): Fix typo. + + * gnus-util.el (kill-empty-logs, gnus-byte-compile): Remove anonymous + 2006-04-22 contribution. + +2006-06-26 Andreas Seltenreich + + * gnus.el (gnus-valid-select-methods): Revert last change for nnweb. + It didn't really fix the bogosity I'm seeing with solid web groups. + +2006-06-26 Andreas Seltenreich + + * gnus.el (gnus-valid-select-methods): Declare nnweb with 'address. + Since revision 6.95 (2003-01-05) of gnus-group.el, solid web groups are + created using server names. If we use the feature without declaring + it, Gnus does not properly manage server and group state. + + * nnweb.el (nnweb-google-search): Respect nnweb-max-hits as upper + bound. + +2006-06-25 Andreas Seltenreich + + * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try + looking up the method using GROUP's prefix before inventing a new one. + It is used on killed/unknown groups in various places where returning + an all-new method isn't expected by the caller. + + * gnus-util.el (gnus-group-server): Fix for empty virtual server names + and match semantics of gnus-group-real-prefix. + +2006-06-22 Reiner Steib + + * nnmail.el (nnmail-broken-references-mailers): New variable. + (nnmail-ignore-broken-references): New function generalizing + nnmail-fix-eudora-headers. + (nnmail-fix-eudora-headers): Now obsolete. + + * gnus-art.el (gnus-button-handle-custom): Support + `customize-apropos*'. + +2006-06-21 Lars Magne Ingebrigtsen + + * gnus-art.el (article-hide-headers): Inhibit read-only stuff. + + * gnus-group.el (gnus-fetch-group): Document ARTICLES and select those + articles. + +2006-06-21 Reiner Steib + + * message.el (message-cite-reply-above): New variable. + (message-yank-original): Use it. 2006-06-20 Katsumi Yamaoka * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values. +2006-06-20 Reiner Steib + + * gnus-bookmark.el (gnus-bookmark-jump): Don't mark unrelated articles + as read. + + * gnus-group.el (gnus-group-quick-select-group): Add GROUP argument. + +2006-06-19 Reiner Steib + + * gnus-bookmark.el: Fix Copyright, keywords, whitespace, etc. + (gnus-bookmark-default-file): Use gnus-directory. + (gnus-bookmark-bmenu-file-column, gnus-bookmark-use-annotations): + Remove "*" in doc string. + (gnus-bookmark-write-file): Simplify. + (gnus-bookmark-maybe-sort-alist): Use `when'. + (gnus-bookmark-get-bookmark): Fix typo in doc string. + (gnus-bookmark-set-bookmark-name, gnus-bookmark-get-bookmark): Add + FIXME about Emacs 21 and XEmacs compatibility. + (gnus-bookmark-set-bookmark-name): Use `gnus-replace-in-string' for + compatibility. + (gnus-bookmark-bmenu-mode): Use `gnus-run-mode-hooks' for + compatibility. + (gnus-bookmark-menu-heading): Fix version. + +2006-06-19 Bastien Guerry + + * gnus-bookmark.el: New file. + 2006-06-19 Katsumi Yamaoka * message.el (message-syntax-checks): Doc fix. +2006-06-17 Andreas Seltenreich + + * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe + unsubscribed groups as if they were killed ones. It causes duplicate + entries in gnus-newsrc-alist. + 2006-06-16 Katsumi Yamaoka * message.el (message-syntax-checks): Doc fix. @@ -922,18 +2328,42 @@ * gnus-art.el (gnus-display-mime): Make sure body ends with newline. +2006-06-11 Reiner Steib + + * gnus-art.el (gnus-article-toggle-truncate-lines): Fix code. + +2006-06-11 Katsumi Yamaoka + + * gnus-art.el (gnus-article-truncate-lines): Default to the value of + default-truncate-lines. + 2006-06-06 Katsumi Yamaoka * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list to fill the utf-8 entry. -2006-06-05 Dan Christensen - - * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, - respect display group parameter and gnus-summary-expunge-below. - (gnus-articles-to-read): Remove unused reference to display group - parameter. - [ Merge 2004-07-06 change from the trunk. ] +2006-06-01 Andreas Seltenreich + + * nnweb.el (nnweb-google-parse-1): Update regexp for author and date. + +2006-05-30 Kevin Greiner + + * gnus-agent.el (directory-files-and-attributes): Move all the way + forward (the third and final move). + (gnus-agent-read-agentview): Trap reconstruction errors due to + nonexistant directory. Handle by returning nil. + +2006-05-30 Didier Verna + + * message.el (message-dont-reply-to-names): Update the custom type. + * message.el (message-dont-reply-to-names): New defsubst: potentially + convert a list of regexps into a single one. + * message.el (message-get-reply-headers): Use it. + * nnmail.el (nnmail-fancy-expiry-target): Ditto. + +2006-05-30 Katsumi Yamaoka + + * gnus-agent.el (directory-files-and-attributes): Move forward. 2006-05-29 Reiner Steib @@ -946,65 +2376,163 @@ * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead of doing it manually. +2006-05-29 Reiner Steib + + * gnus-art.el (gnus-article-toggle-truncate-lines): Fix typo in + comment. + 2006-05-29 Kevin Greiner - * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server - must be explicitly online rather than "not explicitly offline" for - its flags to be synchronized. + * gnus-agent.el (Added gnus-agent-flush*) to purge agent info. + (gnus-agent-read-agentview): Fixed handling of end-of-file error. (gnus-agent-read-local): All symbols allocated in my-obarray (gnus-agent-set-local): Skip invalid entries (min and/or max is nil). (gnus-agent-regenerate-group): Check numeric names to see if they are messages or groups. + (gnus-agent-total-fetched-for): Ignore 'dummy.group' (there should be a + better way of do this...) + + * gnus-cache.el (gnus-agent-total-fetched-for): Ignore + 'dummy.group' (there should be a better way of do this...) 2006-05-29 Katsumi Yamaoka * gnus-art.el (gnus-save-all-headers): Mention it might be overridden. (gnus-saved-headers): Ditto. - (gnus-default-article-saver): Doc fix; add - gnus-summary-write-body-to-file; mention functions may have properties. - (gnus-article-save-coding-system): New variable. + (gnus-default-article-saver): Mention functions may have properties. (gnus-article-save): Override gnus-save-all-headers and gnus-saved-headers by :headers property which saver function may have. - (gnus-read-save-file-name): Add optional `dir-var' argument which - specifies directory in which files are saved; work even if optional - `variable' argument is not specified. - (gnus-summary-save-in-file): Add properties :decode and :headers. - (gnus-summary-write-to-file): Add properties :decode, :function, and - :headers; read file name. - (gnus-summary-save-body-in-file): Add :decode property; add optional - `overwrite' argument. - (gnus-summary-write-body-to-file): New function; add properties - :decode and :function. - (gnus-output-to-file): Add coding cookie and encode text according - to gnus-article-save-coding-system; don't use mm-append-to-file. - - * gnus-sum.el (gnus-newsgroup-last-directory): New variable. - (gnus-summary-local-variables): Add it. - (gnus-summary-save-map): Add gnus-summary-write-article-body-file. - (gnus-summary-save-article): Require gnus-art; save decoded articles - if function that gnus-default-article-saver specifies has `:decode' - property; bind gnus-prompt-before-saving to t when saving many - articles in a file; move point to article which will be saved. - (gnus-summary-write-article-body-file): New function. + (gnus-summary-save-in-file): Add :headers property. + (gnus-summary-write-to-file): Ditto. + + * gnus-sum.el (gnus-summary-save-article): Bind + gnus-prompt-before-saving to t when saving many articles in a file; + always show all headers. 2006-05-26 Reiner Steib - * uudecode.el (uudecode-decode-region-external): Fix previous commit. + * deuglify.el (gnus-outlook-rearrange-article): Add missing citation + marks. + + * message.el (message-indent-citation): Add optional arguments to allow + using it outside of message buffers. + + * gnus-art.el (gnus-article-unfold-long-headers): New variable. + (gnus-article-treat-unfold-headers): Use it. + (gnus-article-truncate-lines): New variable. + (gnus-article-mode): Use it. + (gnus-article-toggle-truncate-lines): New function. + + * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): Add + gnus-article-toggle-truncate-lines. + + * uudecode.el (uudecode-decode-region-external): nil isn't a valid + coding system in XEmacs, use binary. 2006-05-26 Katsumi Yamaoka * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit after-load-alist. + * gnus-art.el (gnus-summary-save-in-file): Use property to specify + this function should save decoded articles. + (gnus-summary-write-to-file): Use property to specify this function + should save decoded articles and specify gnus-summary-save-in-file + should be used to save articles other than the first one when saving + many articles. + (gnus-summary-save-body-in-file): Use property to specify this + function should save decoded articles. + (gnus-summary-write-body-to-file): Use property to specify this + function should save decoded articles and specify + gnus-summary-save-body-in-file should be used to save articles other + than the first one when saving many articles. + + * gnus-sum.el (gnus-summary-save-article): Simplify. + +2006-05-25 Katsumi Yamaoka + + * gnus-art.el (gnus-default-article-saver): Add + gnus-summary-write-body-to-file. + (gnus-article-save-coding-system): Don't use coding system object + in XEmacs. + (gnus-read-save-file-name): Add optional `dir-var' argument which + specifies directory in which files are saved; work even if optional + `variable' argument is not specified. + (gnus-summary-write-to-file): Read file name. + (gnus-summary-save-body-in-file): Add optional `overwrite' argument. + (gnus-summary-write-body-to-file): New function. + + * gnus-sum.el (gnus-newsgroup-last-directory): New variable. + (gnus-summary-local-variables): Add it. + (gnus-summary-save-map): Add gnus-summary-write-article-body-file. + (gnus-summary-save-article): Remove optional `decode' argument; + determine whether to decode articles by the value of + gnus-default-article-saver; when saving many files using + gnus-summary-write-to-file or gnus-summary-write-body-to-file, use + it first and use gnus-summary-save-in-file or + gnus-summary-save-body-in-file thereafter unless + gnus-prompt-before-saving is always; move point to article which + will be saved. + (gnus-summary-save-article-file): Revert. + (gnus-summary-write-article-file): Revert. + (gnus-summary-save-article-body-file): Revert. + (gnus-summary-write-article-body-file): New function. + +2006-05-26 Reiner Steib + + * gnus-art.el (gnus-article-browse-html-article): Remove comment. + +2006-05-24 Katsumi Yamaoka + + * gnus-art.el (gnus-default-article-saver): Doc fix. + (gnus-article-save-coding-system): Move from gnus-sum.el, rename + from gnus-summary-save-article-coding-system, and default to a + certain coding system. + (gnus-output-to-file): Add coding cookie and encode text according + to gnus-article-save-coding-system; don't use mm-append-to-file. + + * gnus-sum.el (gnus-summary-save-article-coding-system): Move to + gnus-art.el and rename to gnus-article-save-coding-system. + (gnus-summary-save-article): Require gnus-art; don't show all + headers if it decodes articles; don't add coding cookie here; + don't bind mm-text-coding-system-for-write. + (gnus-summary-save-article-file): Save decoded articles. + (gnus-summary-write-article-file): When saving many files, use + gnus-summary-write-to-file first and gnus-summary-save-in-file + thereafter unless gnus-prompt-before-saving is always. + (gnus-summary-save-article-body-file): Save decoded articles. + +2006-05-23 Reiner Steib + + * nnrss.el (nnrss-check-group): Bind hash-index. + +2006-05-23 Micha,Ak(Bl Cadilhac + + * nnrss.el (nnrss-check-group): Use the md5sum of the whole RSS item as + its hash index. Store this hash in `nnrss-group-data'. + (nnrss-read-group-data): Update accordingly. + +2006-05-23 Reiner Steib + + * gnus-art.el (gnus-button-alist): Improve gnus-button-handle-symbol + entry. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add + gnus-article-browse-html-article. + +2006-05-23 Hynek Schlawack + + * gnus-sum.el (gnus-summary-mime-map): Add + gnus-article-browse-html-article. +2006-05-23 Reiner Steib + + * gnus-sum.el (gnus-summary-save-article-coding-system): Offer some + suitable coding systems in customize. + 2006-05-22 Reiner Steib - * uudecode.el (uudecode-decode-region-external): nil isn't a valid - coding system in XEmacs, use binary. - * mail-source.el (mail-sources): Fix custom type. - * imap.el (Commentary): Fix typo. - 2006-05-18 Reiner Steib * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string. @@ -1015,6 +2543,41 @@ (gmm-image-search-load-path): Use it. (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'. +2006-05-17 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-save-article-coding-system): New + variable. + (gnus-summary-save-article): Add optional `decode' argument. If + it is set and gnus-summary-save-article-coding-system is non-nil, + save decoded article. + (gnus-summary-write-article-file): Save decoded article if + gnus-summary-save-article-coding-system is non-nil. + + * ecomplete.el (ecomplete-database-file-coding-system): Fix custom + type. + +2006-05-16 Katsumi Yamaoka + + * gnus-art.el (easy-menu-define): Use :active instead of :enable. + +2006-05-12 Katsumi Yamaoka + + * gnus-art.el (gnus-article-setup-buffer): Go to summary buffer + first to test gnus-single-article-buffer which may be buffer-local. + + * gnus-sum.el (gnus-summary-setup-buffer): Make + gnus-single-article-buffer buffer-local and nil in ephemeral + group; make gnus-article-buffer, gnus-article-current, and + gnus-original-article-buffer always buffer-local. + (gnus-summary-exit): Kill article buffer belonging to ephemeral + group. + (gnus-handle-ephemeral-exit): Don't move to next summary line. + +2006-05-08 Reiner Steib + + * nnml.el (nnml-request-compact-group): Compressed files might not + have .gz extension. + 2006-05-04 Stefan Monnier * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment. @@ -1022,17 +2585,63 @@ (mm-display-part): Simplify. (mm-inlinable-p): Add optional arg `type'. +2006-05-03 Stefan Monnier + * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg. (gnus-mime-view-part-externally, gnus-mime-view-part-internally): Try harder to show the attachment internally or externally using gnus-mime-view-part-as-type. -2006-05-04 Reiner Steib - - * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch - `filename' from Content-Disposition if Content-Type doesn't - provide `name'. - (gnus-mime-view-part-as-type): Set default instead of initial-input. +2006-05-02 Reiner Steib + + * message.el (message-from-style, message-signature-separator) + (message-user-organization-file, message-send-mail-function) + (message-citation-line-function, message-yank-prefix) + (message-indent-citation-function, message-signature) + (message-signature-file, message-signature-insert-empty-line): + Remove autoloads. + + * gnus-art.el (gnus-buttonized-mime-types): Remove + "multipart/signed". Revert 2006-04-26 change. + +2006-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump version. + +2006-05-01 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.5 is released. + +2006-04-30 Andreas Seltenreich + + * nnweb.el (nnweb-request-article): Do proper xwfu encoding when + fetching articles by message-id. + +2006-04-30 Lars Magne Ingebrigtsen + + * message.el (hashcash): Require hashcash as normal. + + * ecomplete.el (ecomplete-highlight-match-line): Use + point-at-eol. + (ecomplete-highlight-match-line): Use `highlight', because that + face exists in both Emacs and XEmacs. + + * message.el (message-display-abbrev): Use point-at-bol. + + * mail-source.el: Don't require timer/timer-funcs. + + * gnus-async.el: Ditto. + + * password.el: Ditto. + + * mm-url.el: Ditto. + + * mm-util.el: Require timer/timer-funcs. + +2006-04-23 Andreas Seltenreich + + * mm-url.el (mm-url-insert-file-contents): Don't set Connection: + Close. 2006-04-28 Katsumi Yamaoka @@ -1050,26 +2659,34 @@ 2006-04-26 Reiner Steib - * deuglify.el (gnus-outlook-deuglify-unwrap-min) - (gnus-outlook-deuglify-unwrap-max): Remove autoload. - - * mml-sec.el (mml-secure-method): New internal variable. - (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) - (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): - New functions using mml-secure-method. Sync from the trunk. - - * mml.el (mml-mode-map): Add key bindings for those functions. - (mml-menu): Simplify security menu entries. Suggested by Jesper - Harder . Sync from the trunk. + * message.el (message-user-organization-file): Check several + locations of the organization file. + + * gnus-sum.el (gnus-summary-mime-map, gnus-summary-make-menu-bar): + Add gnus-article-view-part-as-type. + + * gnus-art.el (gnus-article-view-part-as-type): New function. * message.el (message-valid-fqdn-regexp): Add TLDs .cat, jobs, .mobi and .travel. Remove .nato, .bitnet and .uucp. - (message-in-body-p): New function. Sync from the trunk. - - * mml.el (mml-mode, mml-dnd-protocol-alist) - (mml-dnd-attach-options, mml-dnd-attach-file) - (mml-attach-file, mml-attach-buffer, mml-attach-external): - Sync DND support and use of message-in-body-p from the trunk. + + * mml.el: Simplify autoload. + (mml-mode): defvar dnd-protocol-alist instead of using + symbol-value. + (mml-default-directory): New variable. + (mml-minibuffer-read-file): Use it. + (mml-dnd-protocol-alist, mml-dnd-attach-options): Adjust :version. + + * message.el (message-citation-line-format): New variable. + (message-insert-formated-citation-line): New function. + (message-citation-line-function): Add + `message-insert-formated-citation-line' to custom type. + + * mm-decode.el (mm-verify-option): Add gnus-buttonized-mime-types + to doc string. + + * gnus-art.el (gnus-buttonized-mime-types): Add "multipart/signed" + depending on mm-verify-option. 2006-04-26 Katsumi Yamaoka @@ -1083,12 +2700,10 @@ lines at the top of body; use gnus-newsgroup-charset if there's no Charset header. -2006-04-25 Andreas Seltenreich - - * nnweb.el (nnweb-google-wash-article): Sync up to new Google HTML. - 2006-04-25 Katsumi Yamaoka + * message.el (message-self-insert-commands): Doc fix. + * mm-uu.el (mm-uu-pgp-signed-test): Erase prompt. (mm-uu-pgp-encrypted-test): Ditto. (mm-uu-pgp-encrypted-extract-1): Make sure there's a blank line @@ -1098,6 +2713,47 @@ * mm-decode.el (mm-automatic-display): Don't make application/pgp element match to application/pgp-*. +2006-04-23 Andreas Seltenreich + + * nnweb.el (nnweb-google-wash-article): Sync up to new Google + HTML. + +2006-04-23 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-call-script): Message the error + string. + +2006-04-22 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-byte-compile): Use it. + +2006-04-22 xyblor (Tiny change.) + + * gnus-util.el (kill-empty-logs): New function. + +2006-04-22 Lars Magne Ingebrigtsen + + * message.el (message-mail-alias-type): Doc fix. + (message-mail-alias-type-p): New function. + (message-send): Use it. + (message-mode): Ditto. + (message-strip-forbidden-properties): Ditto. + + * ecomplete.el (ecomplete-database-file-coding-system): New + variable. + (ecomplete-save): Use it. + (ecomplete-setup): Use it. + +2006-04-22 Katsumi Yamaoka + + * message.el (message-self-insert-commands): New variable. + (message-strip-forbidden-properties): Use it. + +2006-04-22 Lars Magne Ingebrigtsen + + * message.el (message-put-addresses-in-ecomplete): Use a regexp + that doesn't make XEmacs choke. + 2006-04-20 Reiner Steib * gnus-util.el (gnus-replace-in-string): @@ -1105,128 +2761,147 @@ 2006-04-20 Katsumi Yamaoka - * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map. - - * gnus-sum.el: Ditto. - * gnus-util.el (gnus-select-frame-set-input-focus): Use select-frame-set-input-focus if it is available in XEmacs; use definition defined in Emacs 22 for old Emacsen. +2006-04-19 Katsumi Yamaoka + + * mm-view.el (mm-inline-text): Use equal instead of equalp. + +2006-04-18 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-cache-save): Remove text + properties when saving via the temp buffer. + +2006-04-18 Reiner Steib + + * message.el (message-generate-hashcash): Honor custom type. + +2006-04-18 Lars Magne Ingebrigtsen + + * message.el (message-generate-hashcash): Default to non-nil when + hashcash is found. + + * gnus-sum.el (gnus-summary-expire-articles-now): Clarify prompt. + (gnus-refer-thread-limit): Increase default to 500. + + * mm-view.el (mm-inline-text): Supply delsp to flow-fill. + + * flow-fill.el (fill-flowed): Allow delete-space. + +2006-04-18 Reiner Steib + + * deuglify.el (gnus-outlook-deuglify-unwrap-min) + (gnus-outlook-deuglify-unwrap-max, gnus-outlook-display-hook): + Remove autoloads. + +2006-04-18 Simon Josefsson + + * message.el (message-generate-hashcash): Default to. + +2006-04-18 Katsumi Yamaoka + + * rfc2231.el (rfc2231-parse-string): Decode encoded value after + concatenating segments rather than before concatenating them. + 2006-04-17 Reiner Steib - [ Merge from Gnus trunk. ] - - * mm-util.el (mm-charset-synonym-alist): Improve doc string. - (mm-charset-override-alist): New variable. - (mm-charset-to-coding-system): Use it. - (mm-codepage-setup): New helper function. - (mm-charset-eval-alist): New variable. - (mm-charset-to-coding-system): Use mm-charset-eval-alist. - Warn about unknown charsets. Add allow-override. - Use `mm-charset-override-alist' only when decoding. - (mm-detect-mime-charset-region): Use :mime-charset. - - * mm-bodies.el (mm-decode-body, mm-decode-string): - Call `mm-charset-to-coding-system' with allow-override argument. - - * message.el (message-tool-bar-zap-list, message-tool-bar) - (message-tool-bar-gnome, message-tool-bar-retro): New variables. - (message-tool-bar-local-item-from-menu): Remove. - (message-tool-bar-map): Replace by `message-make-tool-bar'. - (message-make-tool-bar): New function. - (message-mode): Use `message-make-tool-bar'. - - * gnus-sum.el (gnus-summary-tool-bar) - (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) - (gnus-summary-tool-bar-zap-list): New variables. - (gnus-summary-make-tool-bar): Complete rewrite using - `gmm-tool-bar-from-list'. - - * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) - (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): - New variables. - (gnus-group-make-tool-bar): Complete rewrite using - `gmm-tool-bar-from-list'. - (gnus-group-tool-bar-update): New function. - - * gmm-utils.el: New file. - -2006-04-12 Ralf Angeli - - * flow-fill.el (fill-flowed): Remove trailing space from blank - quoted lines. - -2006-04-12 Reiner Steib - - * gnus-art.el (gnus-article-mode): - Set cursor-in-non-selected-windows to nil. - -2006-04-12 Katsumi Yamaoka - - * gnus-art.el (gnus-mime-view-part-as-charset): Ignore charset - that the part specifies. - - * mm-decode.el (mm-display-part): Work with external parts and - usual parts similarly. - - * mm-extern.el (mm-inline-external-body): Use mm-display-part - instead of gnus-display-mime. - - * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part - tag to summarized topics part in order to encode non-ASCII text. - -2006-04-11 Reiner Steib - - * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'. - -2006-04-11 Arne J,Ax(Brgensen - - * gnus-sieve.el (gnus-sieve-generate): Delete from the start of - the sieve region. - -2006-04-11 Reiner Steib - - * gnus.el: Gnus v5.10.8 is released. - -2006-04-11 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout. - - * rfc2047.el (rfc2047-decode-encoded-words): Don't message about - unknown charset. - - * message.el (message-header-synonyms): Add Original-To to the default. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Group is an - optional parameter. - -2006-04-06 Reiner Steib - - * gnus-fun.el (gnus): Require it for gnus-directory. - -2006-04-04 Andreas Seltenreich - - * nnweb.el (nnweb-google-create-mapping): Update regexp. - Some whitespace was matched into the url, which broke browsing hits - > 100 when mm-url-use-external was nil. - -2006-03-31 Reiner Steib - - * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set. - -2006-03-23 Katsumi Yamaoka - - * mml.el (mml-insert-mime): Ignore cached contents of - message/external-body part. - - * mm-decode.el (mm-get-part): Add optional 'no-cache' argument. - (mm-insert-part): Ditto. - -2006-03-22 Katsumi Yamaoka - - * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro. - Reported by Ralf Wachinger . + * gnus-group.el: Move comment to gnus-group-update-tool-bar. + + * imap.el (imap-quote-specials): New function. + (imap-login-auth): Quote specials. + +2006-04-17 Lars Magne Ingebrigtsen + + * rfc2231.el (rfc2231-parse-string): Sort the parameters first. + + * message.el (message-forward-make-body-plain): Allow + message-forward-ignored-headers to be a list. + (message-remove-ignored-headers): Factor out into function. + (message-forward-make-body-mml): Use it. + * rfc2231.el (rfc2231-parse-string): Remove dead code. + (rfc2231-parse-string): Allow concatanation of parameters that + aren't contiguous. The test case is + (mail-header-parse-content-type "message/external-body; + name*0*=us-ascii''~%2ffoo%2fbar%2fbaz%2fxyzzy%2f; + access-type=LOCAL-FILE; + name*1*=plugh%2fhello-sailor%2fbing.pdf") + +2006-04-17 Stefan Monnier + + * nntp.el (nntp-accept-process-output): Return the value of + `nnheader-accept-process-output'. + +2006-04-17 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-treat-types): Add text/x-patch. + (gnus-button-alist): Recognize more diff formats. + (gnus-button-patch): Strip directory. + +2006-04-17 Reiner Steib + + * gnus-util.el (gnus-select-frame-set-input-focus): Check for + Emacs 22 when setting focus. + +2006-04-17 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-treat-types): Do treatment of + text/x-verbatim parts. + (gnus-button-patch): New command. + + * ietf-drums.el (ietf-drums-parse-address): Attempt parsing + addresses that contain invalid characters. + +2006-04-16 Lars Magne Ingebrigtsen + + * message.el (message-put-addresses-in-ecomplete): Use + gnus-replace-in-string. + (message-is-yours-p): Use the more correct + mail-header-parse-address instead of + mail-extract-address-components. + (message-put-addresses-in-ecomplete): Fix typo. + + * gnus-sum.el (gnus-summary-limit-to-bodies): New command and + keystroke. + + * gnus-art.el (gnus-treatment-function-alist): Change order of + newsgroups/generic header folding to avoid double-folding. + + * message.el (message-hidden-headers): Add X-Draft-From. + + * gnus-sum.el (gnus-summary-repeat-search-article-forward): New + command. + (gnus-summary-repeat-search-article-backward): New command. + + * gnus-topic.el (gnus-topic-display-missing-topic): Skip past + groups in the parent topic. + +2006-04-16 Jo,Ac(Bo Cachopo (tiny change) + + * spam.el (spam-necessary-extra-headers): Add X-CRM114-Status. + (spam-extra-header-to-number): Return the CRM114 number as a + number instead of a string. + +2006-04-16 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-face-properties-alist): Moved here from + gnus-fun. + + * gnus-fun.el (gnus-face-properties-alist): Move to gnus-art. + +2006-04-15 Lars Magne Ingebrigtsen + + * message.el (message-strip-forbidden-properties): Only display on + self-insert-command. + + * hashcash.el (hashcash-insert-payment-async): Remove dead code; + reindent. + (hashcash-insert-payment-async-2): Make sure the buffer is alive. + +2006-04-15 NAKAJI Hiroyuki (tiny change) + + * smiley.el (smiley-style): Fix typo. 2006-03-23 Kenichi Handa @@ -1240,10 +2915,345 @@ (rfc2231-encode-string): Be sure to work on multibyte buffer at first, and after mm-encode-body, change the buffer to unibyte. -2006-03-21 Daniel Pittman - - * nnimap.el (nnimap-request-update-info-internal): Optimize. - Don't `gnus-uncompress-range' to avoid excessive memory usage. +2006-04-15 Lars Magne Ingebrigtsen + + * hashcash.el (hashcash-insert-payment-async-2): Use + message-goto-eoh instead of doing it manually. + (mail-add-payment): Use message-narrow-to-header instead of trying + to do the same itself. + + * message.el (message-hidden-headers): Add Face. + + * gnus-sum.el (gnus-summary-reparent-thread): Factor out + reparenting code. + (gnus-summary-reparent-children): Refactored out code. + (gnus-summary-thread-map): New keystroke. + (gnus-summary-reparent-children): Make into command. + + * smiley.el (smiley-style): Default to `medium' if using a large + font. + + * gnus-sum.el (unmorse-region): Remove autoload, because morse.el + does it itself. + + * message.el (message-point-in-header-p): Simplify definition. + +2006-04-14 Lars Magne Ingebrigtsen + + * nnagent.el (nnagent-request-set-mark): Silence log file + writing. + (nnagent-request-set-mark): Use write-region instead of + append-to-file. + + * gnus-sum.el (gnus-read-header): Fudge article number if using a + strange select method. + + * ecomplete.el (ecomplete-display-matches): Get highlightling + right. + (ecomplete-display-matches): Use literals. + (ecomplete-display-matches): Disable message logging. + + * message.el (message-display-abbrev): Small optimization. + + * ecomplete.el (ecomplete-display-matches): Allow automatic + display. + + * message.el (message-strip-forbidden-properties): Display + abbrevs. + (message-display-abbrev): Get automatic display right. + + * ecomplete.el (ecomplete-display-matches): Use M-n/M-p + keystrokes. + +2006-04-13 Romain Francoise + + TODO: Backport to v5-10! + + * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist): + Moved here (and renamed) from gnus-registry.el. + + * gnus-registry.el: Require gnus-util. + Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'. + +2006-04-13 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-catchup-current): Change + if-then-else-if-then-else into cond. + (gnus-group-catchup): Indent. + (group-name-at-point): New function. + (gnus-fetch-group): Provide default from thing at point. + +2006-04-12 Lars Magne Ingebrigtsen + + * message.el (message-display-abbrev): Fix regexp. + + * ecomplete.el (ecomplete-highlight-match-line): Reimplement + choosing. + (ecomplete-highlight-match-line): Fix up code rewrite, remove + dead variables. + + * message.el (message-newline-and-indent): Remove debugging. + (message-display-abbrev): Use new implementation. + +2006-04-12 Reiner Steib + + * gnus-art.el (gnus-article-mode): Set + cursor-in-non-selected-windows to nil. + + * smiley.el: Revert previous change. + (smiley-data-directory): defvar it before using it in the + defcustom of `smiley-style'. + +2006-04-12 Lars Magne Ingebrigtsen + + * message.el (message-newline-and-indent): New function. + + * ecomplete.el: Implement more bits. + + * message.el (message-put-addresses-in-ecomplete): Clean up the + string. + + * ecomplete.el (ecomplete-add-item): Chop off decimals. + + * gnus-sum.el (gnus-summary-save-parts): Bind + gnus-summary-save-parts-counter and use it to make unique file + names. + + * gnus-art.el (gnus-ignored-headers): Add some more headers. + + * ietf-drums.el (ietf-drums-parse-addresses): Take a RAWP + parameter to say whether to actually parse the individual + addresses. + + * message.el (message-put-addresses-in-ecomplete): New function. + (ecomplete): Require. + (message-mail-alias-type): Add ecomplete as an option. + +2006-04-12 Ralf Angeli + + * flow-fill.el (fill-flowed): Remove trailing space from blank + quoted lines. + +2006-04-12 Lars Magne Ingebrigtsen + + * smiley.el (smiley-style): Move definition later to avoid a + compilation warning. + +2006-04-12 Kenichi Handa + + * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte + buffer and then decode the buffer text if necessary. + (rfc2231-encode-string): Be sure to work on multibyte buffer at + first, and after mm-encode-body, change the buffer to unibyte. + Use mm-disable-multibyte instead of set-buffer-multibyte. + +2006-04-12 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-copy-part): Find name parameter in + Content-Type header instead of Content-Disposition header. + (gnus-mime-inline-part): Ditto. + (gnus-mime-view-part-as-charset): Ignore charset that the part + specifies. + + * mm-decode.el (mm-display-part): Work with external parts and + usual parts similarly. + + * mm-extern.el (mm-inline-external-body): Use mm-display-part + instead of gnus-display-mime. + + * mm-util.el (mm-decompress-buffer): Use mm-with-unibyte-buffer + instead of with-temp-buffer. + + * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part + tag to summarized topics part in order to encode non-ASCII text. + +2006-04-11 Reiner Steib + + * smiley.el (smiley-style): New variable. + (smiley-directory): New function. + (smiley-data-directory): Derive from `smiley-style' using + `smiley-directory'. + (smiley-regexp-alist): Add new entries. + + * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'. + (gnus-article-browse-delete-temp): Add :version. + +2006-04-11 Arne J,Ax(Brgensen + + * gnus-sieve.el (gnus-sieve-generate): Delete from the start of + the sieve region. + +2006-04-11 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump version. + +2006-04-11 Reiner Steib + + * gnus.el: No Gnus v0.4 is released. + +2006-04-11 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new + layout. + + * rfc2047.el (rfc2047-decode-encoded-words): Don't message about + unknown charset. + + * message.el (message-header-synonyms): Add Original-To to the + default. + + * gnus-sum.el (gnus-get-newsgroup-headers-xover): group is an + optional parameter. + +2006-04-06 Reiner Steib + + * gnus-fun.el (gnus): Require it for gnus-directory. + +2006-04-06 Katsumi Yamaoka + + * gnus-fun.el (gnus-face-properties-alist): Add :version. + +2006-04-05 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-filter): Fix. + +2006-04-05 Simon Josefsson + + * password.el (password-reset): New function. + +2006-04-05 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): Wait + for BEGIN_SIGNING too, new in GnuPG 1.4.3. + +2006-04-04 Andreas Seltenreich + + * nnweb.el (nnweb-google-create-mapping): Update regexp. + Some whitespace was matched into the url, which broke browsing hits + > 100 when mm-url-use-external was nil. + +2006-04-04 Reiner Steib + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Check + gnus-extra-headers for 'Newsgroups. + + * message.el (message-tool-bar-gnome): Check if `flyspell-mode' is + bound. + +2006-04-04 Daiki Ueno + + * pgg-gpg.el: Clean up process buffers every time gpg processes + complete. + +2006-04-03 Reiner Steib + + * gnus-fun.el (gnus-convert-image-to-face-command): Fix typo in + doc string. + +2006-04-03 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-filter) + (pgg-gpg-wait-for-completion): Check if buffer is alive. + + * pgg-gpg.el (pgg-gpg-process-sentinel): Don't remove GNUPG: + lines, temporary fix. + +2006-03-31 Reiner Steib + + * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set. + +2006-03-29 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-start-process): Don't bind + default-enable-multibyte-characters. This reverts the change from + revision 6.17 which is no longer necessary because the passphrase + is sent separately now. GnuPG messages are unreadable under + multibyte locales with default-enable-multibyte-characters set to + nil. + +2006-03-28 Reiner Steib + + * message.el (message-tool-bar-gnome): Move "spell". + +2006-03-27 Reiner Steib + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Don't use + XEmacs-only `replace-in-string'. Use `gnus-group-real-name' + instead. + +2006-03-27 Karl Kleinpaste + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Improve + newsgroups handling for NNTP overviews which don't include + Newsgroups. + +2006-03-26 Andreas Seltenreich + + * message.el (message-resend): Bind message-generate-hashcash to nil. + +2006-03-26 Andreas Seltenreich + + * hashcash.el (hashcash-already-paid-p): Bind case-fold-search + when searching for already-paid recipients. + +2006-03-27 Daiki Ueno + + * pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for + passphrases when it is not needed. + (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for + passphrase stuff from gpg, should only be necessary when you use + gpg with a smartcard. + +2006-03-23 Katsumi Yamaoka + + * mml.el (mml-insert-mime): Ignore cached contents of + message/external-body part. + + * mm-decode.el (mm-get-part): Add optional 'no-cache' argument. + (mm-insert-part): Ditto. + +2006-03-23 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-update-agent): Add again, with fixes from + Reiner. + (pgg-gpg-use-agent-p): Use it again. + +2006-03-23 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-update-agent): Remove, doesn't work with + older emacsen. + (pgg-gpg-use-agent-p): Don't use it. + +2006-03-23 Reiner Steib + + * pgg-gpg.el (pgg-gpg-update-agent): Only use make-network-process + if we can. + +2006-03-22 Sascha Wilde + + * pgg-gpg.el (pgg-gpg-use-agent): Disable by default. + (pgg-gpg-update-agent): New function. + (pgg-gpg-use-agent-p): New function. + (pgg-gpg-process-region, pgg-gpg-encrypt-region) + (pgg-gpg-encrypt-symmetric-region, pgg-gpg-decrypt-region) + (pgg-gpg-sign-region): Use it. + +2006-03-22 Katsumi Yamaoka + + * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro. + Reported by Ralf Wachinger . + +2006-03-21 Simon Josefsson + + * pgg-gpg.el: Ideas below based on patch from Sascha Wilde + . + (pgg-gpg-use-agent): New variable. + (pgg-gpg-process-region): Use it. + (pgg-gpg-encrypt-region): Likewise. + (pgg-gpg-encrypt-symmetric-region): Likewise. + (pgg-gpg-decrypt-region): Likewise. + (pgg-gpg-sign-region): Likewise. + (pgg-gpg-possibly-cache-passphrase): Don't cache a nil password. 2006-03-21 Reiner Steib @@ -1252,16 +3262,6 @@ * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add comment on version. -2006-03-20 Teodor Zlatanov - - * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable. - (spam-mark-junk-as-spam-routine): Use it. Allow to disable - assigning the spam-mark to new messages. - -2006-03-20 Adam Sj,Ax(Bgren - - (spam-ham-copy-or-move-routine): Don't declare `todo' twice. - 2006-03-20 Reiner Steib * smiley.el: Add missing test smiley. @@ -1281,6 +3281,26 @@ * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode. +2006-03-16 Reiner Steib + + * gmm-utils.el (gmm-image-load-path-for-library): Prefer user's + images in image-load-path. [Sync with image.el, revision 1.60, in + Emacs.] + +2006-03-15 Reiner Steib + + * gmm-utils.el (gmm-image-load-path-for-library): Pass value of + path rather than symbol. Always return list of directories. + Guarantee that image directory comes first. [Sync with image.el, + revision 1.59, in Emacs.] + + * message.el (message-make-tool-bar): Adjust to new API of + `gmm-image-load-path-for-library'. + + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. + + * gnus-group.el (gnus-group-make-tool-bar): Ditto. + 2006-03-15 Andreas Seltenreich * gnus-art.el (gnus-article-only-boring-p): @@ -1288,6 +3308,11 @@ intangible text. Reported by Ralf Wachinger . +2006-03-14 Reiner Steib + + * gmm-utils.el (gmm-image-load-path-for-library): Fix typo. Use + `defun' instead of `gmm-defun-compat'. + 2006-03-14 Simon Josefsson * message.el (message-unique-id): Don't use message-number-base36 @@ -1334,17 +3359,70 @@ * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update. + * gnus-group.el (gnus-group-redraw-when-idle) + (gnus-group-redraw-check): Remove. + (gnus-group-make-tool-bar): Remove gnus-group-redraw-check. + 2006-03-08 Katsumi Yamaoka * nnmail.el (nnmail-split-it): Invert match-partial-words behavior if optional last element is specified in splits (FIELD VALUE...). +2006-03-07 Reiner Steib + + * message.el (message-make-tool-bar): Rename gmm-image-load-path + to gmm-image-load-path-for-library. Call with no-error argument. + (message-tool-bar-gnome): Rename "mail/attach" to "attach". + + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. + + * gnus-group.el (gnus-group-make-tool-bar): Ditto. + + * gmm-utils.el (gmm-image-load-path): Remove alias. + +2006-03-06 Reiner Steib + + * gmm-utils.el (gmm-image-load-path): Add alias. + + * nnml.el (nnml-generate-nov-databases-directory): Rename from + nnml-generate-nov-databases-1. + (nnml-generate-nov-databases): Use it. + (nnml-generate-nov-databases-directory): Document no-active + argument. + + * gmm-utils.el (gmm-image-load-path-for-library): Return single + directory if path is t. Add no-error. + + * gnus-group.el (gnus-group-make-tool-bar): Use add-hook. + Suggested by Stefan Monnier . + + * gnus-art.el (gnus-article-browse-delete-temp-files): Simplify + resetting gnus-article-browse-html-temp-list. + + * gmm-utils.el (gmm-image-load-path-for-library): Sync with + mh-compat.el revision 1.9 in Emacs. Rename `gmm-image-load-path'. + Add example to docstring. Rename local variables. Move error + checks to default case in cond and simplify. + 2006-03-06 Katsumi Yamaoka * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether handle is multipart when calling it recursively. (mm-w3m-cid-retrieve): Display warning if retrieving fails. +2006-03-03 Daniel Pittman + + * nnimap.el (nnimap-request-update-info-internal): Optimize. + Don't `gnus-uncompress-range' to avoid excessive memory usage. + +2006-03-03 Katsumi Yamaoka + + * gnus-group.el (gnus-group-tool-bar-gnome): Check if gnus-topic.el + is loaded. + + * gnus-sum.el (gnus-summary-tool-bar-gnome): Check if spam.el is + loaded. + 2006-03-03 Reiner Steib * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23" @@ -1360,25 +3438,133 @@ * gnus-sum.el (gnus-summary-set-display-table): Don't nix out characters 160 through 255 in Emacs 23. +2006-03-02 Reiner Steib + + * gnus-art.el (gnus-article-browse-html-temp-list): Rename from + gnus-article-browse-html-temp. + (gnus-article-browse-delete-temp): Make it customizable. Add + `file'. Adjust doc string. + (gnus-article-browse-delete-temp-files): Add argument. Allow + query for each file. Adjust doc string. + (gnus-article-browse-html-parts): Add + `gnus-article-browse-delete-temp-files' to + `gnus-summary-prepare-exit-hook' and `gnus-exit-gnus-hook'. + +2006-03-02 Hynek Schlawack + + * gnus-art.el (gnus-article-browse-html-temp) + (gnus-article-browse-delete-temp): New variables. + (gnus-article-browse-delete-temp-files): New function. + (gnus-article-browse-html-parts): Use it. + +2006-03-02 Reiner Steib + + * gnus-group.el (gnus-group-redraw-check): Remove redundant tests. + + * gmm-utils.el (gmm-image-load-path): Mention ../etc search in doc + string. + + * gnus-sum.el (gnus-summary-tool-bar-gnome): Don't use + gnus-summary-insert-new-articles when unplugged. Remove + gnus-summary-search-article-forward. + + * gmm-utils.el (gmm-tool-bar-style): Test tool-bar-mode and + display-visual-class instead of display-color-cells. + 2006-03-02 Katsumi Yamaoka * mml.el (mml-generate-mime-1): Encode parts other than text/* or message/* containing non-ASCII text properly. +2006-03-01 Reiner Steib + + * message.el: Require gmm-utils, remove autoloads. + (message-tool-bar): Set default based on + gmm-tool-bar-style. + (message-tool-bar-gnome): Add gmm-customize-mode. + + * gnus-sum.el (gnus-summary-tool-bar): Set default based on + gmm-tool-bar-style. + (gnus-summary-tool-bar-gnome): Add gmm-customize-mode. + + * gnus-group.el (gnus-group-tool-bar): Set default based on + gmm-tool-bar-style. + (gnus-group-tool-bar-gnome): Add gmm-customize-mode. + + * gmm-utils.el (gmm-image-directory): Rename variable from + gmm-image-load-path. + (gmm-image-load-path): Use gmm-image-directory. + (gmm-customize-mode): New function. + (gmm-tool-bar-style): New variable. + + * gnus-group.el (gnus-group-redraw-when-idle): Rename from + gnus-group-redraw-line-number. + (gnus-group-redraw-check): Simplify. + (gnus-group-tool-bar-update): Remove redraw check. + (gnus-group-make-tool-bar): Add redraw check. + +2006-03-01 Michael Piotrowski (tiny change) + + * gnus-art.el (gnus-button): Add missing parentheses. + 2006-02-28 Katsumi Yamaoka * mm-util.el (mm-with-unibyte-current-buffer): Add note. -2006-02-28 Andreas Seltenreich - - * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. +2006-02-28 Reiner Steib + + * gnus-art.el (gnus-button): New face. + (gnus-article-button-face): Use it. + + * gnus-sum.el (gnus-summary-tool-bar-gnome): Add + gnus-summary-next-page. Re-order. + + * gnus-group.el (gnus-group-tool-bar-gnome): prev-node and + next-node are now included. + (gnus-group-redraw-line-number): New internal variable. + (gnus-group-redraw-check): Helper function for updating the tool + bar. + (gnus-group-tool-bar-update): Add gnus-group-redraw-check. + + * gmm-utils.el (gmm-tool-bar-item): Add TODO about modifiers. + + * spam.el (spam-spamassassin-score-regexp): New internal variable. + (spam-extra-header-to-number, spam-check-spamassassin-headers): + Use it to match format of Spamassassin 3.0 and later. Reported by + IRIE Tetsuya . + (spam-check-bogofilter) + (spam-bogofilter-register-with-bogofilter): Fix args of + `gnus-error' calls. 2006-02-28 Reiner Steib - * nnweb.el (nnweb-type-definition, nnweb-gmane-search): - Use new nov.php. - -2006-02-28 Andreas Seltenreich + * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid + unnecessary interaction when sending queued mails. Reported by + TAKAHASHI Yoshio . + +2006-02-27 Reiner Steib + + * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if + first or last are nil. + +2006-02-24 Andreas Seltenreich + + * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M. + +2006-02-24 Lars Magne Ingebrigtsen + + * gnus-int.el (gnus-open-server): Respect gnus-batch-mode. + +2006-02-24 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Protect more against buggy tcp output. + +2006-02-24 Reiner Steib + + * nnweb.el (nnweb-type-definition, nnweb-gmane-search): Use new + nov.php. + +2006-02-24 Andreas Seltenreich * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping) (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web @@ -1387,43 +3573,20 @@ (nnweb-google-create-mapping): Update regexps and add some progress indication. -2006-02-28 Reiner Steib - - * message.el (message-user-fqdn): Remove useless * in doc string. - - * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid - unnecessary interaction when sending queued mails. Reported by - TAKAHASHI Yoshio . - -2006-02-28 Lars Magne Ingebrigtsen - - * gnus-int.el (gnus-open-server): Respect gnus-batch-mode. - Merge of 2006-02-20 change from the trunk. - -2006-02-28 Lars Magne Ingebrigtsen - - * dns.el (query-dns): Protect more against buggy tcp output. - Merge of 2006-02-20 change from the trunk. - -2006-02-27 Reiner Steib - - * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if - first or last are nil. - -2006-02-24 Simon Josefsson - - * flow-fill.el (fill-flowed): Flow-fill unquoted lines too. - Merge of 2005-10-26 change from the trunk. - -2006-02-23 Lars Magne Ingebrigtsen - - * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. - Remove space stuffing, and only do quotes that actually start with - ">" at the beginning of the lines. - Merge of 2005-11-17 and 2004-07-25 from the trunk. - 2006-02-23 Reiner Steib + * gnus-group.el (gnus-group-tool-bar-gnome): Fix + gnus-agent-toggle-plugged. Re-order icons. + (gnus-group-tool-bar-gnome): Add + gnus-group-{prev,next}-unread-group. + (gnus-group-tool-bar-gnome): Re-order icons. + + * gnus-sum.el (gnus-summary-tool-bar-gnome): Move + gnus-summary-insert-new-articles. + + * message.el (message-tool-bar-gnome, message-tool-bar-retro): Fix + comments. + * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is also available in Emacs 21.3. @@ -1439,16 +3602,78 @@ * mm-view.el (mm-fill-flowed): Add :version. -2006-02-23 Ralf Angeli - - * mm-view.el (mm-fill-flowed): New variable. - (mm-inline-text): Use it. +2006-02-23 Katsumi Yamaoka + + * gmm-utils.el (gmm-image-load-path): Don't modify image-load-path + and load-path. + +2006-02-22 Reiner Steib + + * message.el: Autoload gmm-image-load-path. + (message-tool-bar-retro): Prepend "gnus/" subdirectory to some + icon file names. Use old Emacs 21 "mail_send.xpm" icon for + consitency. + + * gmm-utils.el (gmm-image-load-path): Also search in + "../etc/images". Don't set gmm-image-load-path if we don't find + the image. + +2006-02-22 Katsumi Yamaoka + + * gmm-utils.el (gmm-image-load-path): Don't make + `gmm-image-load-path' include subdirectories which the second arg + `image' might specify. + + * gnus-group.el (gnus-group-tool-bar-retro): Prepend the "gnus/" + subdirectory to icon file names. + + * gnus-sum.el (gnus-summary-tool-bar-retro): Ditto. + +2006-02-21 Reiner Steib + + * gnus-group.el (gnus-group-make-tool-bar): Add IMAGE argument to + gmm-image-load-path calls. + + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. + + * message.el (message-make-tool-bar): Ditto. + + * mml.el (mml-preview): Added comment concerning tool bar icons. + + * gnus-group.el (gnus-group-tool-bar-gnome): Use new icon names. + (gnus-group-make-tool-bar): Use `gmm-image-load-path'. + + * gnus-sum.el (gnus-summary-tool-bar-gnome): Use new icon names. + (gnus-summary-make-tool-bar): Use `gmm-image-load-path'. + + * message.el (message-tool-bar-gnome): Use new icon names. + (message-make-tool-bar): Use `gmm-image-load-path'. + + * gmm-utils.el (gmm-defun-compat, gmm-image-search-load-path): New + functions from MH-E. + (gmm-image-load-path): New variable from MH-E. + (gmm-image-load-path): New function from MH-E. Added arguments + LIBRARY, IMAGE and PATH. Don't modify paths. Don't use + *-image-load-path-called-flag. + +2006-02-21 Milan Zamazal + + * mm-view.el (mm-view-pkcs7-verify): Implement using smime.el. 2006-02-21 Wolfram Fenske (tiny change) * nnimap.el (nnimap-request-move-article): Change folder back to source group before deleting. +2006-02-20 Reiner Steib + + * mm-util.el (mm-charset-override-alist): Fix type in doc string. + + * gnus-art.el (mm-url-insert-file-contents-external): Autoload + mm-url. + + * mm-uu.el (mm-uu-type-alist): Improve `LaTeX'. + 2006-02-20 Katsumi Yamaoka * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the @@ -1473,17 +3698,37 @@ * gnus-art.el (article-strip-banner): Use gnus-extract-address-components instead of - mail-header-parse-addresses to make it work with non-ASCII text. + mail-header-parse-addresses to make it work with non-ASCII text; + remove mail-encode-encoded-word-string. * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter values which are surrounded with \"...\"; make it never cause a Lisp error; give up parsing of parameters if it failed in extracting type. +2006-02-14 Arne J,Ax(Brgensen + + * smime.el (smime-cert-by-ldap-1): Fix bug where + `smime-ldap-search' returns results without userCertificates. + 2006-02-15 Katsumi Yamaoka + * mm-util.el (mm-make-temp-file): Don't catch file-error in Emacs. + +2006-02-14 Reiner Steib + + * spam.el (spam-check-spamassassin-headers): Adapt format for + Spamassassin 3.0 or later. Reported by ARISAWA Akihiro + . + (spam-list-of-processors): Add spam-use-gmane. + +2006-02-14 Katsumi Yamaoka + * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of - make-temp-file; make it work with Emacs 20 and XEmacs as well. + make-temp-file; make it work with XEmacs as well. + + * gnus-art.el (gnus-article-browse-html-parts): Use the 3rd arg of + mm-make-temp-file. * mm-decode.el (mm-display-external): Use the 3rd arg of mm-make-temp-file. @@ -1497,6 +3742,18 @@ (gnus-draft-check-draft-articles): New function. (gnus-draft-edit-message, gnus-draft-send-message): Use it. +2006-02-13 Reiner Steib + + * gnus-art.el (gnus-article-browse-html-parts): + `hs-show-html-list' should read `gnus-article-browse-html-parts'. + Don't use suffix argument for mm-make-temp-file for Emacs 21 + compatibility. Remove useless `format'. + +2006-02-13 Andreas Seltenreich + + * nnweb.el (nnweb-google-wash-article): Update regexps. + (nnweb-group-alist): Use defvoo instead of defvar. + 2006-02-13 Katsumi Yamaoka * nnoo.el (nnoo-declare): Don't generate duplicate entries when @@ -1504,8 +3761,24 @@ 2006-02-10 Reiner Steib + * gnus-group.el (gnus-group-make-tool-bar): Remove duplicate check + for `tool-bar-mode' and don't check it's default-value. + + * gnus-sum.el (gnus-summary-make-tool-bar): Ditto. + + * message.el (message-make-tool-bar): Ditto. + + * gnus-art.el (gnus-article-browse-html-parts): Remove useless + `substring'. Shorten tmp-file name. + * gnus.el: Remove bogus comment. +2006-02-10 Hynek Schlawack + + * gnus-art.el (gnus-article-browse-html-parts): New function. + (gnus-article-browse-html-article): New function for viewing html + articles with a browser. + 2006-02-09 Daiki Ueno * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode. @@ -1581,10 +3854,6 @@ Update copyright notices of all files in the gnus directory. -2006-02-03 Reiner Steib - - * gnus-util.el (gnus-error): Describe `args'. - 2006-02-03 Andreas Seltenreich * nnweb.el (nnweb-request-group): Avoid growing overview files. @@ -1615,20 +3884,13 @@ (nnweb-possibly-change-server, nnweb-request-group): Remove some initialisations. Let nnoo do the work. -2006-01-31 Romain Francoise - - * message.el (message-alternative-emails): Improve docstring. - (message-setup-1): Call `message-use-alternative-email-as-from' - after `message-setup-hook' to give it precedence over posting - styles, etc. - (message-use-alternative-email-as-from): Add docstring. - Remove the original From header if present. - 2006-01-31 Katsumi Yamaoka * mm-uu.el (mm-uu-emacs-sources-extract, mm-uu-diff-extract): Say the part has been decoded. + * mm-view.el (mm-display-inline-fontify): Get decoded part rightly. + 2006-01-31 Kevin Ryde * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into @@ -1636,6 +3898,15 @@ will invert the meaning of a "nil" test previously determined by mailcap-mailcap-entry-passes-test. +2006-01-30 Katsumi Yamaoka + + * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map when + compiling. + + * gnus-sum.el: Ditto. + + * message.el: Don't bind tool-bar-map when compiling. + 2006-01-30 Reiner Steib * nnweb.el (nnweb-google-parse-1): Clarify some comments. @@ -1646,11 +3917,57 @@ (nnweb-google-create-mapping, nnweb-google-search): Adapt to current Google Groups. +2006-01-26 Reiner Steib + + * gnus-sum.el (gnus-summary-make-tool-bar): Add checks for XEmacs + and tool-bar-mode. + + * gnus-group.el (gnus-group-make-tool-bar): Add checks for XEmacs + and tool-bar-mode. + + * message.el (message-tool-bar-update): Simplify. + (message-make-tool-bar): Add checks for XEmacs and tool-bar-mode. + + * gnus-sum.el (gnus-summary-tool-bar-update): Check for + gnus-summary-buffer. + (gnus-summary-tool-bar-gnome): Use "reply-author" icon for + gnus-summary-reply. + + * gmm-utils.el (gmm): Add :version. + 2006-01-26 Katsumi Yamaoka * Makefile.in (clean): New rule. (distclean): Use it. +2006-01-26 Steve Youngs + + * gmm-utils.el (gmm-tool-bar-item, gmm-tool-bar-zap-list): Don't + autoload. + +2006-01-26 Katsumi Yamaoka + + * gmm-utils.el (gmm-verbose): Add :group. + +2006-01-25 Reiner Steib + + * message.el: Change some comments WRT tool-bars. + + * gnus-sum.el (gnus-summary-tool-bar) + (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) + (gnus-summary-tool-bar-zap-list): New variables. + (gnus-summary-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + + * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) + (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New + variables. + (gnus-group-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + (gnus-group-tool-bar-update): New function. + + * message.el (message-mode-field-menu): Add "Show hidden Headers". + 2006-01-25 Katsumi Yamaoka * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part @@ -1664,10 +3981,28 @@ mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test look for. +2006-01-24 Reiner Steib + + * gmm-utils.el (gmm-tool-bar-item): Add "Separator". + (gmm-tool-bar-from-list): Suppress tooltip for `gmm-ignore'. + + * message.el (message-tool-bar-gnome): Use gmm-ignore. + 2006-01-24 Katsumi Yamaoka - * mm-uu.el (mm-uu-dissect-text-parts): Reduce the number of - recursive calls. + * gnus-art.el (gnus-mime-security-button-commands): New variable. + (gnus-mime-security-button-menu): New definition. + (gnus-mime-security-button-map): Use them. + (gnus-mime-security-button-menu): New function. + (gnus-insert-mime-security-button): Addition to help echo. + (gnus-mime-security-run-function, gnus-mime-security-save-part) + (gnus-mime-security-pipe-part): New functions. + + * mm-uu.el (mm-uu-buttonize-original-text-parts): Remove. + (mm-uu-dissect-text-parts): Revert a part of 2006-01-23 change. + + * mm-decode.el (mm-handle-set-disposition): Remove. + (mm-handle-set-description): Remove. 2006-01-24 Katsumi Yamaoka @@ -1679,6 +4014,30 @@ * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use mm-w3m-standalone-supports-m17n-p to alter w3m usage. +2006-01-23 Reiner Steib + + * message.el (message-tool-bar-zap-list): Use + gmm-tool-bar-zap-list as custom type. + (message-tool-bar-update): New function. + (message-tool-bar, message-tool-bar-gnome) + (message-tool-bar-retro): Add message-tool-bar-update. + (message-tool-bar-gnome): Add flyspell-buffer. + + * gnus-util.el (gnus-error): Describe `args'. + + * gmm-utils.el (gmm-error): Describe `args'. + (gmm-tool-bar-zap-list): New widget. + (gmm-tool-bar-from-list): Improve description of `zap-list'. + +2006-01-23 Katsumi Yamaoka + + * mm-uu.el (mm-uu-buttonize-original-text-parts): New variable. + (mm-uu-dissect-text-parts): Buttonize original text parts; reduce + the number of recursive calls. + + * mm-decode.el (mm-handle-set-disposition): New macro. + (mm-handle-set-description): New macro. + 2006-01-23 Katsumi Yamaoka * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer @@ -1686,15 +4045,53 @@ 2006-01-20 Reiner Steib + * message.el (message-tool-bar-zap-list, message-tool-bar) + (message-tool-bar-gnome, message-tool-bar-retro): New variables. + (message-tool-bar-local-item-from-menu): Remove. + (message-tool-bar-map): Replace by `message-make-tool-bar'. + (message-make-tool-bar): New function. + (message-mode): Use `message-make-tool-bar'. + + * gmm-utils.el: New file. + (gmm-verbose, gmm-message, gmm-error): From gnus-utils.el. + (gmm-lazy): New widget copied from `nnmail.el'. + (gmm-tool-bar-from-list): New function for creating customizable + tool bars. + (gmm-tool-bar-from-list): Fix typos in doc string. Remove debug + output. + (gmm): Add :prefix to defgroup. + +2006-01-20 Per Abrahamsen + + * gmm-utils.el (gmm-widget-p): New function. + +2006-01-20 Reiner Steib + * mml.el (mml-attach-file): Describe `description' in doc string. (mml-menu): Add Emacs MIME manual and PGG manual. -2006-01-19 Reiner Steib - - * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) - (spam-group-spam-marks, spam-list-articles, spam-group-ham-marks): - Revert 2006-01-08 change because the functions will be used in No - Gnus. +2006-01-20 Richard M. Stallman + + * mm-url.el (mm-url-load-url): Require url-parse and url-vars. + +2006-01-20 Kevin Greiner + + * nntp.el (nntp-end-of-line): Doc fix. + +2006-01-20 Chong Yidong + + * imap.el (imap-open): Handle case where buffer is a buffer + object. + +2005-01-20 Stefan Monnier + + * gnus-delay.el (gnus-delay): Don't autoload. + It's useless and could trigger a bug in cus-dep.el causing ldefs-boot + to be re-loaded when customizing the `gnus-delay' group. + +2005-01-20 Chong Yidong + + * message.el (message-insert-citation-line): Use newlines. 2006-01-19 Katsumi Yamaoka @@ -1702,6 +4099,10 @@ * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts. +2006-01-19 Mark D. Baushke + + * pgg-gpg.el (pgg-gpg-encrypt-region): Add --textmode to gpg args. + 2006-01-17 Katsumi Yamaoka * mm-decode.el (mm-inlined-types): Add application/pgp. @@ -1716,9 +4117,6 @@ (nnrss-opml-import): Query whether to subscribe to each entry. * gnus-art.el: - * gnus-cus.el: - * gnus-group.el: - * gnus-start.el: * gnus-sum.el: * mm-uu.el: * mm-view.el: Update copyright. @@ -1731,19 +4129,11 @@ * ChangeLog: Fix and update copyright. -2006-01-16 Katsumi Yamaoka - - * mm-uu.el (mm-uu-text-plain-type): New variable. - (mm-uu-pgp-signed-extract-1): Use it. - (mm-uu-pgp-encrypted-extract-1): Use it. - (mm-uu-dissect): Use it; allow two optional arguments; one is a - flag specifying whether there's no message header; the other is - for a MIME type and parameters; bind mm-uu-text-plain-type with - the later one. - (mm-uu-dissect-text-parts): New function. - - * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to - dissect text parts. +2006-01-13 Romain Francoise + + * message.el (message-forward-subject-name-subject): Prefer the + address to 'nowhere' if the sender has no name. + Fix typo. Update copyright year. 2006-01-13 Katsumi Yamaoka @@ -1757,6 +4147,11 @@ gnus-article-wash-html-with-w3m-standalone. (mm-inline-text-html-render-with-w3m-standalone): New function. +2006-01-12 Reiner Steib + + * mm-uu.el (mm-uu-type-alist): Fix previous message-marks commit. + Improve LaTeX. + 2006-01-10 Katsumi Yamaoka * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable. @@ -1794,6 +4189,12 @@ fetch a feed. Suggested by Mark Plaksin . (nnrss-insert-w3): Ditto. +2005-12-22 Katsumi Yamaoka + + * gnus-uu.el (gnus-uu-digest-mail-forward): Reverse the order of + the articles to be forwarded including the case where neither a + number of articles nor a region is specified. + 2005-12-21 Katsumi Yamaoka * nnrss.el (nnrss-request-article): Fix last change; fill @@ -1805,7 +4206,23 @@ in text/plain part. (nnrss-check-group): Don't add excessive newline to dc:subject. -2005-12-19 Katsumi Yamaoka +2005-12-19 Mark Plaksin (tiny change) + + * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the + article. + +2005-12-18 Reiner Steib + + * nnml.el: Don't require gnus-bcklg. Autoload it. + (nnml-use-compressed-files, nnml-save-mail): Support other + comression programs such as bzip2. + +2005-12-17 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Make sure we check the buffer size before + removing tcp headers. + +2005-12-16 Katsumi Yamaoka * gnus-art.el (gnus-article-delete-text-of-type): Enable it to remove MIME buttons associated with multipart/alternative parts. @@ -1815,25 +4232,6 @@ * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons associated with multipart/alternative parts. -2005-12-19 Mark Plaksin (tiny change) - - * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the - article. - -2005-12-18 Lars Magne Ingebrigtsen - - * dns.el (query-dns): Make sure we check the buffer size before - removing tcp headers. - -2006-01-08 Chong Yidong - - * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p) - (spam-group-spam-marks): Delete functions. - (spam-list-articles): Just call spam-group-ham-marks directly. - (spam-group-ham-marks): Simplify. - -2005-12-16 Katsumi Yamaoka - * gnus-art.el (gnus-signature-separator): Fix custom type. * mm-decode.el (mm-inlined-types): Fix custom type. @@ -1843,6 +4241,22 @@ (mm-inline-override-types): Ditto. (mm-automatic-external-display): Ditto. +2005-12-15 Reiner Steib + + * spam-report.el (spam-report-user-mail-address) + (spam-report-user-agent): New variables. + (spam-report-url-ping-plain): Use spam-report-user-agent. + +2005-12-14 Ralf Angeli + + * gnus-art.el (gnus-button-handle-custom): Do not just use + `customize-apropos' for any "M-x customize-*" button but the + function called for. Accept both the function name and its + argument in order to achieve this. + (gnus-button-alist): Remove support for "custom:" URL's. Pass + function name to `gnus-button-handle-custom' in case of "M-x + customize-*" buttons. + 2005-12-12 Katsumi Yamaoka * gnus-art.el (gnus-buttonized-mime-types): Mention addition of @@ -1852,6 +4266,21 @@ * mm-decode.el (mm-discouraged-alternatives): Add xref to gnus-buttonized-mime-types in doc string. +2005-12-08 Reiner Steib + + * mm-decode.el (mm-discouraged-alternatives): Fix custom type. + Suggest image/.* in the doc string. + +2005-12-12 Reiner Steib + + * mm-uu.el (mm-uu-type-alist): Don't depend on message.el for + message-marks (Debian bug #342521). + +2005-12-12 Simon Josefsson + + * password.el (password-read-from-cache): Add. + (password-read): Use it. + 2005-12-12 Katsumi Yamaoka * rfc2047.el (rfc2047-charset-to-coding-system): Recognize @@ -1862,9 +4291,152 @@ 2005-12-09 Reiner Steib + * pop3.el (pop3-stream-type): Fix custom version. + + * mm-uu.el (mm-uu-type-alist): Simplify uu regexp. + +2005-12-09 ARISAWA Akihiro (tiny change) + + * mm-decode.el (mm-display-external): Add missing cdr. + +2005-12-07 Katsumi Yamaoka + + * mm-decode.el (mm-display-external): Use nametemplate (defined in + RFC1524) if it is in mailcap or add a suffix according to + mailcap-mime-extensions when generating a temp filename; postpone + deleting a temp file for 2 seconds for some wrappers, shell + scripts, and so on, which might exit right after having started a + viewer command as a background job. + +2005-12-06 Reiner Steib + + * nntp.el (nntp-marks-directory): Fix custom group. + + * gnus-fun.el (gnus-face-from-file): Decrease quant in smaller + steps when < 10. + * gnus-start.el (gnus-no-server-1): Mention `gnus-level-default-subscribed' in doc string. +2005-12-02 ARISAWA Akihiro (tiny change) + + * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced + parens. + +2005-11-26 Dave Love + + * tls.el (open-tls-stream): Rename arg SERVICE to PORT. + (tls-program, tls-success): Provide openssl alternative. + + * starttls.el: Doc fixes. + (starttls-open-stream-gnutls, starttls-open-stream): Rename arg + SERVICE to PORT. + + * pop3.el (pop3-open-server) : Clarify a loop. Deal with + port null or service name. + (starttls-negotiate): Autoload. + +2005-11-25 Katsumi Yamaoka + + * message.el (message-kill-to-signature): Fix interactive spec. + +2005-11-24 Katsumi Yamaoka + + * pop3.el (pop3-open-server): Recognize a string as a service name. + +2005-11-24 Pascal Rigaux (tiny change) + + * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. + +2005-11-23 Dave Love + + Add pop3s, pop3/starttls. + + * pop3.el (pop3-authentication-scheme): Clarify doc. + (open-tls-stream, starttls-open-stream): Autoload. + (pop3-stream-type): New. + (pop3-open-server): Use it. + + * mail-source.el (mail-sources): Fix some :types. Add stream type + for POP. + (mail-source-keyword-map): Add :stream for POP. + (mail-source-fetch-pop): Use pop3-stream-type. + +2005-11-22 Katsumi Yamaoka + + * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead + of current-time-string. + +2005-11-20 Stefan Schimanski (tiny change) + + * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid + date header. + +2005-11-19 Kevin Greiner + + * gnus-sum.el (gnus-fetch-old-headers): Updated docs to warn that + it can seriously impact performance as it bypasses the agent's + local caches. + +2005-11-19 Kevin Greiner + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server + must be explicitly online rather than "not explicitly offline" for + its flags to be synchronized. + + * gnus-sum.el (gnus-summary-remove-process-mark): Always return t so + that gnus-uu-unmark-thread will function correctly. + + * gnus-group.el (gnus-total-fetched-for): Reduced cutoff so that + 1024K is instead displayed as 1M. + +2005-11-17 Lars Magne Ingebrigtsen + + * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil. + +2005-11-16 Boris Samorodov (tiny change) + + * imap.el (imap-kerberos4-open): Ignore SSL stuff. + +2005-11-13 Kevin Greiner + + * gnus-agent.el (gnus-agent-read-local): Trivial fix to format of + error message to display actual error condition. + (gnus-agent-save-local): Avoid saving symbols that are bound to + nil as they simply result in a warning message in + gnus-agent-read-local. + +2005-11-13 Katsumi Yamaoka + + * gnus-start.el (gnus-dribble-read-file): Use make-local-variable + rather than make-variable-buffer-local for file-precious-flag. + +2005-11-12 Kevin Greiner + + * gnus-agent.el (gnus-agent-braid-nov): Now tests new nov entries + for duplicates which are removed. The invalid sort check then + triggers a rescan after the sort as sorting may have moved + duplicate entries such that they can be cheaply detected. + +2005-11-13 Katsumi Yamaoka + + * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag. + +2005-11-12 Kevin Greiner + + * gnus-agent.el (gnus-agent-article-alist-save-format): Changed + internal variable to a custom variable. Changed default value + from compressed(2) to uncompressed(1). + (gnus-agent-read-agentview): Reversed revision 7.8 to restore + support for uncompressed agentview files. Taken together, reading + the agentview file should now be 6-7 times faster. + +2005-11-11 Jan Nieuwenhuizen + + * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag, + as a buffer-local variable. This avoids creating truncated + dribble files as a result of a hang up, eg. + 2005-12-09 Reiner Steib * gnus-start.el (gnus-start-draft-setup): Enforce @@ -1877,37 +4449,15 @@ * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc string. -2005-12-09 ARISAWA Akihiro (tiny change) - - * mm-decode.el (mm-display-external): Add missing cdr. - -2005-12-12 Richard M. Stallman - - * mm-url.el (mm-url-load-url): Require url-parse and url-vars. - -2005-12-08 Reiner Steib - - * mm-decode.el (mm-discouraged-alternatives): Fix custom type. - Suggest image/.* in the doc string. - -2005-12-07 Katsumi Yamaoka - - * mm-decode.el (mm-display-external): Use nametemplate (defined in - RFC1524) if it is in mailcap or add a suffix according to - mailcap-mime-extensions when generating a temp filename; postpone - deleting a temp file for 2 seconds for some wrappers, shell - scripts, and so on, which might exit right after having started a - viewer command as a background job. - 2005-12-06 Reiner Steib * gnus-art.el (gnus-default-article-saver): Add user-defined `function' to custom type. -2005-12-02 ARISAWA Akihiro (tiny change) - - * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced - parens. +2005-10-30 Chong Yidong + + * imap.el (imap-open): Handle case where buffer is a buffer + object. 2005-11-29 Reiner Steib @@ -1918,168 +4468,20 @@ * gnus-agent.el (gnus-agent-rename-group) (gnus-agent-delete-group): Wrap doc strings. -2005-11-24 Pascal Rigaux (tiny change) - - * rfc2231.el (rfc2231-parse-string): Support non-ascii chars. - -2005-11-22 Katsumi Yamaoka - - * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead - of current-time-string. - -2005-11-20 Stefan Schimanski (tiny change) - - * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid - date header. - -2005-11-16 Boris Samorodov (tiny change) - - * imap.el (imap-kerberos4-open): Ignore SSL stuff. - -2005-11-14 Kevin Greiner - - * gnus-agent.el (gnus-agent-article-alist-save-format): Changed - internal variable to a custom variable. Changed default value - from compressed(2) to uncompressed(1). - (gnus-agent-read-agentview): Reversed revision 7.8 to restore - support for uncompressed agentview files. Taken together, reading - the agentview file should now be 6-7 times faster. - (gnus-agent-long-article, - gnus-agent-short-article, gnus-agent-score): Renamed category - keywords to match gnus-cus. - (gnus-agent-summary-fetch-series): Modified to protect against - gnus-agent-summary-fetch-group clearing processable flags. - (gnus-agent-synchronize-group-flags): Update live group buffer as - synchronization may occur due to the user toggling the plugged - status. - (gnus-agent-braid-nov): Now tests new nov entries - for duplicates which are removed. The invalid sort check then - triggers a rescan after the sort as sorting may have moved - duplicate entries such that they can be cheaply detected. - (gnus-agent-read-local): Trivial fix to format of - error message to display actual error condition. - (gnus-agent-save-local): Avoid saving symbols that are bound to - nil as they simply result in a warning message in - gnus-agent-read-local. - (gnus-agent-fetch-group-1): Clear downloadable flag when article - successfully downloaded. - (gnus-agent-regenerate-group): Use - gnus-agent-synchronize-group-flags to reset read status in both - gnus and server. - - * nntp.el (nntp-end-of-line): Doc fix. - (nntp-authinfo-rejected): New error condition. - (nntp-wait-for): Use new error condition to signal authentication - error. - (nntp-retrieve-data): Rethrow new error condition to break out of - recursive call to nntp-send-authinfo. - -2005-11-13 Katsumi Yamaoka - - * gnus-start.el (gnus-dribble-read-file): Use make-local-variable - rather than make-variable-buffer-local for file-precious-flag. - -2005-11-13 Katsumi Yamaoka - - * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag. - -2005-11-11 Jan Nieuwenhuizen - - * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag, - as a buffer-local variable. This avoids creating truncated - dribble files as a result of a hang up, eg. - -2005-11-04 Ken Manheimer - - * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for - pgg-add-passphrase-to-cache function. - - * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region) - (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric) - (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt) - (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache - function. - -2005-10-29 Ken Manheimer - - * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right - part of the decoded armor to find the key-identifier. - (pgg-gpg-lookup-key-owner): New function to return the - human-readable identifier of a key owner. - (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the - key itself. - (pgg-gpg-decrypt-region): Prompt with the key owner (rather than - the key value) if we have a key and can match it against a secret - key. Also, added a note pointing out fact that the prompt only - indicates the first matching key. - - * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to - pgg-decrypt-region. - (pgg-pending-timers): A new hash for tracking the passphrase cache - timers, so that new ones supercede old ones. - (pgg-add-passphrase-to-cache): Rename from - `pgg-add-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when new ones are added. - (pgg-remove-passphrase-from-cache): Rename from - `pgg-remove-passphrase-cache' to reduce confusion (all callers - changed). Modified to cancel old timers when their keys are - removed from the cache. - (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in - XEmacs, an indirection to delete-itimer. - (pgg-read-passphrase-from-cache, pgg-read-passphrase): - Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so - users can only check cache without risk of prompting. Correct bug in - notruncate behavior. - (pgg-read-passphrase-from-cache, pgg-read-passphrase) - (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): - Add informative docstrings. - (pgg-decrypt): Convey provided passphrase in subordinate call to - pgg-decrypt-region. - -2005-10-20 Ken Manheimer - - * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region) - (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region) - (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional - 'passphrase' argument, so the passphrase can be managed externally - and then passed in to the system. - - * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache) - (pgg-remove-passphrase-cache): Add optional 'notruncate' argument, - so the passphrase cache can be used reliably with identifiers - besides a pgp packet's key id. - - * pgg-gpg.el (pgg-pgp-encrypt-region) - (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric) - (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt) - (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase' - argument to all these routines, so the passphrase can be managed - externally and passed in to the system. - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional - 'notruncate' argument, so the passphrase cache can be used - reliably with identifiers besides a pgp packet's key id. - -2005-10-29 Sascha Wilde - - * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for - symmetric encryption. - (pgg-gpg-symmetric-key-p): New function to check for an symmetric - encrypted session key. - (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted - message ask for the passphrase in a proper way. - - * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region): - New user commands for symmetric encryption. + +2005-11-10 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-1): Add "native" to + gnus-predefined-server-alist. + + * gnus.el (gnus-method-to-server): Don't add "native" to the + lists here, because that leads to problems when + gnus-select-method is bound. + +2005-11-09 Simon Josefsson + + * gnus-sum.el (gnus-article-sort-by-date-reverse): Remove, + use (not sort-by-date) instead. 2005-11-30 Stefan Monnier @@ -2127,6 +4529,27 @@ * message.el (message-generate-headers): Downcase the argument given to message-check-element. +2005-11-08 Kevin Greiner + + * nntp.el (nntp-authinfo-rejected): New error condition. + (nntp-wait-for): Use new error condition to signal authentication + error. + (nntp-retrieve-data): Rethrow new error condition to break out of + recursive call to nntp-send-authinfo. + +2005-11-08 Romain Francoise + + * gnus-sum.el (gnus-summary-catchup-and-goto-prev-group): New function. + (gnus-summary-exit-map): Bind to `Z p'. + (gnus-summary-make-menu-bar): Add menu item. + +2005-11-02 Reiner Steib + + * gnus-art.el (gnus-article-treat-custom): Add `first'. + (gnus-treat-*): Add `first' in all doc strings. + + * gnus-group.el (gnus-group-compact-group): Fix typo. + 2005-11-01 Katsumi Yamaoka * gnus.el (gnus-parameters-case-fold-search): New variable. @@ -2140,7 +4563,26 @@ 2005-10-31 Katsumi Yamaoka - * mml.el (mml-preview): Doc fix. + * mm-util.el (mm-special-display-p): New function. + + * mml.el (mml-preview): Use it; doc fix. + +2005-10-29 Romain Francoise + + * message.el (message-fix-before-sending): Fix comment. + +2005-10-29 Jari Aalto + + * gnus-sum.el (gnus-article-sort-by-date-reverse): New function. + +2005-10-29 Jari Aalto + + * score-mode.el (gnus-score-edit-done-hook): Introduce variable. + Used in gnus-score.el. + +2005-10-28 Reiner Steib + + * mm-util.el (mm-codepage-setup): Remove bogus alias test. 2005-10-27 Reiner Steib @@ -2156,6 +4598,24 @@ Courier IMAP ("some version from 2004"). Mostly based on similar code in the same function. +2005-10-26 Didier Verna + + * gnus-group.el (gnus-group-compact-group): invalidate original + article buffer. + * gnus-srvr.el (gnus-server-compact-server): ditto. + * nnml.el (nnml-request-compact-group): handle self Xref: field in + NOV database and in article itself. + Invalidate article backlog. + +2005-10-26 Reiner Steib + + * mm-uu.el (mm-uu-hide-markers): Fix XEmacs case. + +2005-10-26 Simon Josefsson + + * flow-fill.el (fill-flowed): Flow-fill unquoted lines too, revert + part of 2004-07-25 change. + 2005-10-26 Katsumi Yamaoka * message.el (message-display-completion-list): New function. @@ -2186,10 +4646,21 @@ * gnus-score.el (gnus-default-adaptive-score-alist): Set defaults depending on gnus-score-decay-constant. -2005-10-25 Lars Magne Ingebrigtsen - - * nnslashdot.el (nnslashdot-request-article) - (nnslashdot-retrieve-headers-1): Update to new HTML. + * encrypt.el (encrypt-insert-file-contents) + (encrypt-write-file-contents): Don't use `gnus-message'. + + * mm-uu.el (mm-uu-verbatim-marks-extract): Add four start and end + arguments. + (mm-uu-type-alist): Add message-marks and insert-marks. Pass + arguments to mm-uu-verbatim-marks-extract. + (mm-uu-hide-markers): New variable. + (mm-uu-extract): Use face similar to `gnus-cite-3'. + + * gnus-fun.el (gnus-convert-image-to-x-face-command) + (gnus-convert-image-to-face-command): Use "convert" by default to + allow other input image formats. + (gnus-x-face-from-file, gnus-face-from-file): Adjust doc strings + accordingly. 2005-10-23 Simon Josefsson @@ -2197,6 +4668,12 @@ with latest GNU SASL. (imap-gssapi-open): Ignore 'Trying ...' messages from GNU SASL. +2005-10-21 Lars Magne Ingebrigtsen + + * nnslashdot.el (nnslashdot-retrieve-headers-1): Update to new + HTML. + (nnslashdot-request-article): Ditto. + 2005-10-20 Hiroshi Fujishima (tiny change) * mail-source.el (mail-source-fetch-pop): Require pop3. @@ -2214,6 +4691,9 @@ * message.el (message-tool-bar-local-item-from-menu): Fix comment. + * mm-bodies.el (mm-decode-string): Call + `mm-charset-to-coding-system' with allow-override argument. + 2005-10-19 Katsumi Yamaoka * rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable. @@ -2247,27 +4727,52 @@ * message.el (message-expand-group): Pass the common prefix substring of completion to `display-completion-list'. +2005-10-13 Reiner Steib + + * mml-sec.el (mml-secure-method): New internal variable. + (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) + (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New + functions using mml-secure-method. + + * mml.el (mml-mode-map): Add key bindings for those functions. + (mml-menu): Simplify security menu entries. Suggested by Jesper + Harder . + (mml-attach-file, mml-attach-buffer, mml-attach-external): Goto + end of message if point is the headers of the message. + + * message.el (message-in-body-p): New function. + + * assistant.el: Autoload gnus-util and netrc. + + * mm-util.el (mm-charset-to-coding-system): Add allow-override. + Use `mm-charset-override-alist' only when decoding. + + * mm-bodies.el (mm-decode-body): Call + `mm-charset-to-coding-system' with allow-override argument. + + * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch + `filename' from Content-Disposition if Content-Type doesn't + provide `name'. + (gnus-mime-view-part-as-type): Set default instead of + initial-input. + 2005-10-09 Daniel Brockman * format-spec.el (format-spec): Propagate text properties of % spec. -2005-01-21 Derek Atkins (tiny change) - - * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. - -2005-10-08 Simon Josefsson - - * pgg-parse.el (top-level): Don't require custom, it is - autoloaded. (To sync with No Gnus.) - -2005-05-09 Georg C. F. Greve (tiny change) - - * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching. - -2005-10-08 Simon Josefsson - - * pgg-def.el (top-level): Don't require custom, it is - autoloaded. (To sync with No Gnus.) +2005-10-12 Reiner Steib + + * gnus-art.el (gnus-treat-predicate): Add `first'. + +2005-10-11 Reiner Steib + + * mm-util.el (mm-charset-synonym-alist): Improve doc string. + (mm-charset-override-alist): New variable. + (mm-charset-to-coding-system): Use it. + (mm-codepage-setup): New helper function. + (mm-charset-eval-alist): New variable. + (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn + about unknown charsets. 2005-10-04 David Hansen @@ -2276,6 +4781,13 @@ 2005-10-04 Reiner Steib + * mm-uu.el (mm-uu-verbatim-marks-extract, mm-uu-latex-extract): + Rename x-gnus-verbatim to x-verbatim. + (mm-uu-type-alist): Fix regexp for verbatim-marks. + + * mm-decode.el (mm-automatic-display): Rename x-gnus-verbatim to + x-verbatim. + * mm-url.el (mm-url-predefined-programs): Add switches for curl. * gnus-util.el (gnus-remove-duplicates): Remove. @@ -2290,6 +4802,22 @@ * mm-util.el (mm-delete-duplicates): Use `delete-dups' if available, else use implementation from `delete-dups'. + * message.el (message-insert-expires): New function. + (message-mode-map): Add key binding. + (message-mode-field-menu): Add menu entry. + (message-mode): Document it. + (message-make-expires-date): Use `message-make-date'. + +2005-10-04 Josh Huber + + * message.el (message-make-expires-date): New function. + +2005-10-04 Katsumi Yamaoka + + * Makefile.in (list-installed-shadows): New entry. + (install): Use it. + (remove-installed-shadows): New entry. + 2005-10-02 Katsumi Yamaoka * time-date.el: Autoload parse-time-string, XEmacs needs it. @@ -2302,8 +4830,18 @@ (mm-viewer-completion-map, mm-viewer-completion-map): Move initialization inside declaration. +2005-09-29 Simon Josefsson + + * spam.el: Load hashcash when compiling, to avoid warnings. Don't + autoload mail-check-payment. + (spam-check-hashcash): Define unconditionally, since hashcash.el + is part of Gnus now. Ignore errors from payment checking. + 2005-09-28 Reiner Steib + * message.el (message-bold-region, message-unbold-region): Rename + from `bold-region' and `unbold-region'. + * message.el: Remove useless autoloads. 2005-09-28 Simon Josefsson @@ -2322,8 +4860,20 @@ (mm-uu-diff-groups-regexp): Change default value. (mm-uu-type-alist): Add doc string. (mm-uu-configure): Add doc string. Make it interactive. + (mm-uu-tex-groups-regexp): New variable. + (mm-uu-latex-extract, mm-uu-latex-test): New functions. + (mm-uu-type-alist): Add LaTeX documents. + (mm-uu-verbatim-marks-extract): Use "text/x-gnus-verbatim" instead + of "text/verbatim". (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit. + * mm-decode.el (mm-automatic-display): Use "text/x-gnus-verbatim" + instead of "text/verbatim". + + * message.el (message-mark-inserted-region) + (message-mark-insert-file): Use slrn style marks when called with + prefix argument. + 2005-09-27 Simon Josefsson * message.el (message-idna-to-ascii-rhs-1): Reformat. @@ -2348,7 +4898,10 @@ * gnus-art.el (gnus-mime-display-single): Don't modify text if it has been decoded. - * mm-decode.el (mm-insert-part): Don't modify text if it has been + * mm-decode.el (mm-automatic-display): Add text/verbatim. + (mm-insert-part): Don't modify text if it has been decoded. + + * mm-uu.el (mm-uu-verbatim-marks-extract): Say text has been decoded. * mm-view.el (mm-inline-text): Don't strip text props unless @@ -2384,6 +4937,36 @@ * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the default value is nil. + * mm-uu.el (mm-uu-type-alist): Added slrn style verbatim-marks. + (mm-uu-verbatim-marks-extract): New function. + (mm-uu-extract): New face. + (mm-uu-copy-to-buffer): Use it. + + * spam-report.el (spam-report-gmane-ham): Renamed from + `spam-report-gmane-unspam'. + (spam-report-gmane-internal): Renamed from `spam-report-gmane'. + Simplify use of UNSPAM argument. Fetch "X-Report-Unspam" header. + + * spam.el (spam-report-gmane-spam, spam-report-gmane-ham): + Autoload. + (spam-report-gmane-unregister-routine): Renamed + `spam-report-gmane-unspam' to `spam-report-gmane-ham'. + +2005-09-21 Teodor Zlatanov + + * spam.el (spam-use-gmane, spam-report-gmane-register-routine) + (spam-report-gmane-unregister-routine): Add support for gmane + unregistration. + + * spam-report.el (spam-report-gmane-unspam) + (spam-report-gmane-spam): Add new wrappers around spam-report-gmane. + (spam-report-gmane): Change to take a single article and do unspam + registration. + +2005-09-19 Reiner Steib + + * mm-url.el (mm-url-decode-entities): Fix regexp. + 2005-09-20 Lars Magne Ingebrigtsen * gnus-agent.el (gnus-agent-synchronize-flags): Switch the @@ -2391,9 +4974,39 @@ switches to something else, then the function should be fixed not be exceedingly slow. +2005-09-20 Teodor Zlatanov + + * gnus-start.el (gnus-activate-group): If the server is nil, don't + fail hard. + + * spam-report.el: Add better Keywords line. + + * spam.el: Add Maintainer and better Keywords line. + 2005-09-19 Reiner Steib - * mm-url.el (mm-url-decode-entities): Fix regexp. + * gnus-art.el (gnus-article-replace-part) + (gnus-mime-replace-part): New functions. + (gnus-mime-action-alist, gnus-mime-button-commands) + (gnus-mime-save-part-and-strip): Added file argument. + (gnus-article-part-wrapper): Added interactive argument. + + * gnus-sum.el (gnus-summary-mime-map): Add + `gnus-article-replace-part'. + +2005-09-19 Didier Verna + + The nnml compaction feature: + * nnml.el (nnml-request-compact-group): New function. + * nnml.el (nnml-request-compact): New function. + * gnus-int.el (gnus-request-compact-group): New function. + * gnus-int.el (gnus-request-compact): New function. + * gnus-group.el (gnus-group-compact-group): New function. + * gnus-group.el (gnus-group-group-map): Bind it to 'G z'. + * gnus-group.el (gnus-group-make-menu-bar): Add an entry for it. + * gnus-srvr.el (gnus-server-compact-server): New function. + * gnus-srvr.el (gnus-server-mode-map): Bind it to 'z'. + * gnus-srvr.el (gnus-server-make-menu-bar): Add an entry for it. 2005-09-18 Deepak Goel @@ -2404,6 +5017,10 @@ * gnus.el (gnus-group-startup-message): Bind image-load-path. +2005-09-15 Romain Francoise + + * message.el (message-fill-paragraph): Clarify docstring. + 2005-09-14 Katsumi Yamaoka * gnus-art.el (gnus-mime-display-part): Protect against broken @@ -2414,6 +5031,31 @@ * gnus-sum.el (gnus-summary-edit-article-done): Remove text props before parsing header. +2005-09-11 Jari Aalto + + * html2text.el: (html2text-replace-list): Add new entities. + +2005-09-11 Romain Francoise + + * message.el (message-alternative-emails): Improve docstring. + (message-setup-1): Call `message-use-alternative-email-as-from' + after `message-setup-hook' to give it precedence over posting + styles, etc. + (message-use-alternative-email-as-from): Add docstring. Remove + the original From header if present. + + * nnml.el (nnml-compressed-files-size-threshold): New variable. + (nnml-save-mail): Use it. + + * gnus-uu.el (gnus-uu-mark-series): Return number of marked + articles. Add new argument `silent'. + (gnus-uu-mark-all): Report the total number of marked articles. + +2005-09-10 Romain Francoise + + * gnus-uu.el (gnus-message-process-mark): Use gnus-message. + (gnus-uu-mark-series): Likewise. + 2005-09-10 Reiner Steib * spam-report.el (spam-report-gmane): Fix generation of spam @@ -2432,13 +5074,16 @@ This is only used if `spam-report-gmane-use-article-number' is nil. (spam-report-gmane-spam-header): Remove. Not used anymore. + * gnus-sum.el (gnus-thread-sort-by-recipient): New function to + make `gnus-summary-sort-by-recipient' work with threading. + * nnweb.el (nnweb-google-wash-article): Print a message if article is not available. 2005-09-07 TSUCHIYA Masatoshi - * gnus-art.el (gnus-mime-display-single): Decode text/* parts - content before displaying. + * gnus-art.el (gnus-mime-display-single): Revert 2004-10-07 + change. Decode text/* parts content before displaying. 2005-09-06 Reiner Steib @@ -2460,8 +5105,22 @@ * gnus-art.el (gnus-signature-limit) (gnus-article-mime-part-function): Ditto. +2005-09-05 Katsumi Yamaoka + + * mml.el (mml-mode): Silence the byte compiler. + + * gnus-art.el (gnus-article-jump-to-part): Redisplay the article + using `(sit-for 0)' before moving the point to the specified part; + skip unbuttonized parts. + (gnus-article-part-wrapper): Don't use save-window-excursion; don't + return to the summary window if gnus-auto-select-part is non-nil. + 2005-09-04 Reiner Steib + * mml.el (mml-dnd-protocol-alist, mml-dnd-attach-options): New + variables. + (mml-dnd-attach-file, mml-mode): Use them. + * nnweb.el (nnweb-type-definition, nnweb-google-wash-article): Make fetching article by MID work again for Google Groups. Added FIXME concerning gnus-group-make-web-group. @@ -2470,15 +5129,17 @@ Don't depend on Gnus by using mail-extract-address-components if gnus-extract-address-components is not bound. - * gnus.el (gnus-user-agent): Use list of symbols instead of - symbols. Display full version number for (S)XEmacs. Optionally - display (S)XEmacs codename. - - * gnus-util.el (gnus-emacs-version): Update for new - `gnus-user-agent'. - - * gnus-msg.el (gnus-extended-version): Make it possible to omit - Gnus version. +2005-09-04 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-display-security): Don't display the + signature, but only the signed part. + +2005-09-02 Katsumi Yamaoka + + * gnus-sum.el (gnus-thread-hide-subtree): Doc fix. + + * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using + list, not listp. 2005-09-02 Hrvoje Niksic @@ -2489,12 +5150,34 @@ De-canonicalize CRLF for all text content types, not just text/plain. -2005-09-02 Katsumi Yamaoka - - * gnus-sum.el (gnus-thread-hide-subtree): Doc fix. - - * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using - list, not listp. +2005-09-01 Katsumi Yamaoka + + * gnus-art.el (gnus-article-part-wrapper): Error if there's no + valid article; point arrow and cursor at the MIME button. + +2005-08-30 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-save-part-and-strip): Clarify prompt. + Suggested by Dan Christensen . + + * mm-decode.el (mm-save-part): Enable change of prompt. + +2005-08-29 Jari Aalto + + * gnus-msg.el (gnus-inews-add-send-actions): Made + `message-post-method' lambda parameter ARG `&optional'. + +2005-08-29 Reiner Steib + + * gnus-sum.el (gnus-summary-mime-map): Added + gnus-article-save-part-and-strip, gnus-article-delete-part and + gnus-article-jump-to-part. + + * gnus-art.el (gnus-article-edit-article): Added quiet argument. + (gnus-article-edit-part): Use it. + (gnus-article-part-wrapper): Added no-handle argument. + (gnus-article-save-part-and-strip, gnus-article-delete-part): New + functions. 2005-08-29 Romain Francoise @@ -2502,6 +5185,19 @@ docstring. (gnus-face-from-file): Likewise. +2005-08-29 Reiner Steib + + * gnus-art.el (gnus-mime-save-part-and-strip): Don't prompt. + (gnus-mime-delete-part): Don't prompt if `gnus-expert-user' is + non-nil. + (gnus-auto-select-part): New variable. + (gnus-article-jump-to-part): New function. + (gnus-article-edit-part, gnus-mime-save-part-and-strip) + (gnus-mime-delete-part): Allow selecting specified part after + deleting or stripping parts. + (gnus-article-jump-to-part): Don't use `read-number'. Use last + part if argument is bogus. + 2005-08-31 Juanma Barranquero * gnus-art.el (w3m-minor-mode-map): @@ -2548,22 +5244,40 @@ (pgg-insert-url-with-w3): Require url, to get url-insert-file-contents regardless of where it is defined. +2005-08-13 Romain Francoise + + * message.el (message-cite-original-1): New function. + (message-cite-original): Use it. + (message-cite-original-without-signature): Ditto. + +2005-08-08 Romain Francoise + + * message.el (message-yank-empty-prefix): New variable. + (message-indent-citation): Use it. + (message-cite-original-without-signature): Respect X-No-Archive. + 2005-08-08 Simon Josefsson * pgg.el: Autoload url-insert-file-contents instead of loading w3/url. (pgg-insert-url-with-w3): Don't load url here. +2005-08-07 Jesper Harder + + * message.el (message-kill-to-signature): Don't insert newline at + bol. + (message-newline-and-reformat): Bind fill-paragraph-function to nil. + +2005-08-06 Romain Francoise + + * message.el (message-user-fqdn): Fix typo in docstring. + 2005-08-05 Daiki Ueno * mml2015.el (mml2015-pgg-sign): Make sure micalg is correct. * pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2. -2005-08-06 Romain Francoise - - * message.el: Fix typo in docstring. - 2005-08-05 Katsumi Yamaoka * mm-bodies.el (mm-encode-body): Use coding system rather than @@ -2572,12 +5286,6 @@ * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the number of charsets if utf-8 is available (XEmacs). -2005-08-04 Lars Magne Ingebrigtsen - - * gnus-art.el (article-unsplit-urls): Don't anchor urls to the - start of the lines. - (gnus-picon-databases): Add /usr/share/picons. - 2005-08-04 Reiner Steib * gnus-art.el (gnus-button-valid-localpart-regexp): New variable @@ -2587,9 +5295,6 @@ for news:localpart@domain buttons. (gnus-button-ctan-directory-regexp): Update. - * message.el (message-kill-buffer): Raise the current frame. - (message-bury): Use `window-dedicated-p'. - 2005-08-02 Katsumi Yamaoka * sieve-manage.el (sieve-manage-interactive-login): Use @@ -2647,9 +5352,8 @@ (gnus-article-beginning-of-window): New macro. (gnus-article-next-page-1): Use it. (gnus-article-prev-page): Ditto. - (gnus-mime-save-part-and-strip): Use insert-buffer-substring - instead of insert-buffer. - (gnus-mime-delete-part): Ditto. + (gnus-article-edit-part): Use insert-buffer-substring instead of + insert-buffer. (gnus-article-edit-exit): Ditto. * gnus-util.el (gnus-beginning-of-window): Remove. @@ -2661,6 +5365,38 @@ to have the url package without w3. Reported by Daiki Ueno and Luigi Panzeri . +2005-07-20 Didier Verna + + * gnus-diary.el: Remove the description comment (nndiary is now + properly documented in the Gnus manual). + Fix the spelling of "Back End". + * nndiary.el: Ditto. + Fix the copyright notice. + +2005-07-18 Romain Francoise + + * gnus-sum.el (gnus-summary-to-prefix, + gnus-summary-newsgroup-prefix): New variables. + (gnus-summary-from-or-to-or-newsgroups): Use them. + +2005-07-17 Romain Francoise + + * mml2015.el (mml2015-clean-buffer): Prefix buffer name with a + space as it's generally not especially interesting to the user. + +2005-07-16 Romain Francoise + + * nnfolder.el (nnfolder-save-buffer): Bind `copyright-update' to + nil to avoid prompting and file modification if one of the + messages at the top of the nnfolder file contains a copyright + notice. + Update copyright notice. + + * gnus-uu.el (gnus-uu-save-article): Use `message-make-date' + instead of `current-time-string' as the latter creates a time + string that is not RFC 2822 compliant (it lacks the zone). + Update copyright notice. + 2005-07-21 Stefan Monnier * mml.el (mml-minibuffer-read-disposition): Don't use inline by default @@ -2668,12 +5404,6 @@ * mm-uu.el (mm-uu-copy-to-buffer): Use with-current-buffer. -2005-07-16 Romain Francoise - - * gnus-uu.el (gnus-uu-save-article): Use `message-make-date' - instead of `current-time-string' as the latter creates a time - string that is not RFC 2822 compliant (it lacks the zone). - 2005-07-16 Lars Magne Ingebrigtsen * gnus-msg.el (gnus-button-mailto): Remove @@ -2689,10 +5419,22 @@ * gnus-util.el (gnus-beginning-of-window): New function. (gnus-end-of-window): New function. +2005-07-14 Hiroshi Fujishima (tiny change) + + * gnus-score.el (gnus-score-edit-all-score): Set + gnus-score-edit-exit-function to gnus-score-edit-done and call + gnus-message. + +2005-07-14 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-button-mailto): Remove + save-selected-window-window hackery because it relies on + save-selected-window internals. + 2005-07-13 Katsumi Yamaoka * gnus-salt.el (gnus-pick-mode): Remove the 5th arg of - gnus-add-minor-mode. + add-minor-mode. (gnus-binary-mode): Ditto. * gnus-topic.el (gnus-topic-mode): Ditto. @@ -2730,7 +5472,7 @@ 2005-06-30 Katsumi Yamaoka * gnus-art.el (article-display-face): Correct the position in - which Faces are inserted; use dolist. + which Faces are inserted. 2005-06-29 Didier Verna @@ -2740,13 +5482,22 @@ 2005-06-29 Katsumi Yamaoka * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify. + (gnus-fill-real-hashtb): Use hash table instead of obarray. (gnus-nocem-check-article): Fetch the Type header. (gnus-nocem-message-wanted-p): Fix the way to examine types. (gnus-nocem-verify-issuer): Use functionp instead of fboundp. - (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized. + (gnus-nocem-enter-article): Use hash tables rather than obarrays; + make sure gnus-nocem-hashtb is initialized. + (gnus-nocem-alist-to-hashtb): Use hash table instead of obarray. + (gnus-nocem-unwanted-article-p): Ditto. * pgg.el (pgg-verify): Return the verification result. +2005-06-27 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mime-copy-part): Check whether coding-system + is ascii. + 2005-06-24 Juanma Barranquero * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not @@ -2770,8 +5521,18 @@ * mm-extern.el (mm-extern-local-file, mm-inline-external-body): * pop3.el (pop3-user): Don't use `format' on `error' arguments. +2005-06-16 Arne J,Ax(Brgensen + + * smime.el (smime-cert-by-ldap-1): Detect PEM format without + header by looking for magic "MII" at the beginnig. + 2005-06-16 Miles Bader + * assistant.el (assistant-field): Remove "-face" suffix from face name. + (assistant-field-face): New backward-compatibility alias for renamed + face. + (assistant-render-text): Use renamed assistant-field face. + * spam.el (spam): Remove "-face" suffix from face name. (spam-face): New backward-compatibility alias for renamed face. (spam-face, spam-initialize): Use renamed spam face. @@ -2906,6 +5667,11 @@ * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while executing enriched-decode. +2005-06-07 Katsumi Yamaoka + + * mm-util.el (mm-find-buffer-file-coding-system): Don't examine + charset of tar files. + 2005-06-04 Luc Teirlinck * gnus-art.el (article-update-date-lapsed): Use `save-match-data'. @@ -2919,13 +5685,23 @@ * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy. +2005-06-02 Katsumi Yamaoka + + * pop3.el (pop3-apop): Run md5 in the binary mode. + + * starttls.el (starttls-set-process-query-on-exit-flag): + Use eval-and-compile. + +2005-05-31 Simon Josefsson + + * smime.el (smime-replace-in-string): Define. + (smime-cert-by-ldap-1): Use it. + 2005-05-31 Katsumi Yamaoka * gnus-art.el (article-display-x-face): Replace process-kill-without-query by gnus-set-process-query-on-exit-flag. - * gnus-group.el: Bind gnus-cache-active-hashtb when compiling. - * gnus-util.el (gnus-set-process-query-on-exit-flag): Alias to set-process-query-on-exit-flag or process-kill-without-query. @@ -2954,21 +5730,30 @@ (nntp-open-ssl-stream): Ditto. (nntp-open-tls-stream): Ditto. -2005-05-31 Simon Josefsson - - * imap.el (imap-ssl-open): Use imap-process-connection-type, - instead of hard coding to nil. - -2005-05-31 Kevin Greiner - - * gnus-group.el: Require gnus-sum and autoload functions to - resolve warnings when gnus-group.el compiled alone. + * starttls.el (starttls-set-process-query-on-exit-flag): Alias to + set-process-query-on-exit-flag or process-kill-without-query. + (starttls-open-stream-gnutls): Use it instead of + process-kill-without-query. + (starttls-open-stream): Ditto. + +2005-05-31 Ulf Stegemann (tiny change) + + * smime.el (smime-cert-by-ldap-1): Don't use + replace-regexp-in-string. + +2005-05-31 Arne J,Ax(Brgensen + + * smime-ldap.el (smime-ldap-search): Add compatibility for XEmacs. + + * smime.el (smime-cert-by-ldap-1): Handle certificates distributed + in PEM format. Adjust to the XEmacs compability. 2005-05-30 Reiner Steib + * encrypt.el (encrypt-xor-process-buffer): Replace `string-to-int' + by `string-to-number'. * gnus-agent.el (gnus-agent-regenerate-group) - (gnus-agent-fetch-articles): Replace `string-to-int' by - `string-to-number'. + (gnus-agent-fetch-articles): Ditto. * gnus-art.el (gnus-button-fetch-group): Ditto. * gnus-cache.el (gnus-cache-generate-active) (gnus-cache-articles-in-group): Ditto. @@ -3063,7 +5848,9 @@ * dig.el (dig): Add :group. - * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Add :group. + * dns-mode.el (dns-mode): Add :group. + + * encrypt.el (encrypt): Add :group. * gnus-cite.el (gnus-cite-attribution-face): Add :group. (gnus-cite-face-1, gnus-cite-face-2, gnus-cite-face-3): Ditto. @@ -3101,8 +5888,20 @@ (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto. (gnus-summary-normal-read-face, gnus-splash-face): Ditto. + * hashcash.el (hashcash): New custom group. + (hashcash-default-payment): Add :group. + (hashcash-payment-alist): Ditto. + (hashcash-default-accept-payment): Ditto. + (hashcash-accept-resources): Ditto. + (hashcash-path): Ditto. + (hashcash-extra-generate-parameters): Ditto. + (hashcash-double-spend-database): Ditto. + (hashcash-in-news): Ditto. + * message.el (message-minibuffer-local-map): Add :group. + * netrc.el (netrc): Add :group. + * sieve-manage.el (sieve-manage-log): Add :group. (sieve-manage-default-user): Diito. (sieve-manage-server-eol, sieve-manage-client-eol): Ditto. @@ -3122,6 +5921,17 @@ * spam.el (spam, spam-face): Add :group. +2005-05-16 Lars Magne Ingebrigtsen + + * nntp.el (nntp-next-result-arrived-p): Some news servers may + return \n.\n.\n at the end of articles. Protect against that. + (nntp-with-open-group): Allow debugging. + + * nnheader.el (mail-header-set-extra): Make into a function + because I just could't understand how to quote the list properly. + + * dns.el (query-dns-cached): New function. + 2005-05-26 Lute Kamstra * score-mode.el (gnus-score-mode): Use run-mode-hooks. @@ -3130,7 +5940,10 @@ * gnus-art.el: Don't autoload mail-extract-address-components. - * gnus.el: Use eval-and-compile to autoload message-y-or-n-p. + * gnus.el: Remove duplicated autoload for message-y-or-n-p; use + eval-and-compile to evaluate it. + + * hashcash.el: Don't autoload executable-find. * nndb.el: Don't declare the nndb back end two or more times; don't autoload news-reply-mode, news-setup, cancel-timer and telnet. @@ -3138,54 +5951,76 @@ * nntp.el: Autoload format-spec instead of format; use eval-and-compile to evaluate autoload forms. - * spam-report.el (spam-report-process-queue): Use gnus-point-at-eol. +2005-05-09 Georg C. F. Greve (tiny change) + + * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching. + +2005-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump version. + +2005-05-01 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.3 is released. 2005-04-28 Katsumi Yamaoka + * gnus-art.el (gnus-article-edit-part): Disable undo. + +2005-04-25 Katsumi Yamaoka + + * gnus-art.el (article-date-ut): Don't delete X-Sent header when + gnus-article-date-lapsed-new-header is t if date timer is active; + skip headers in which the original date value is empty. + (gnus-article-save-original-date): Redefine it as a macro. + (gnus-display-mime): Use it. + +2005-04-22 Katsumi Yamaoka + * gnus-art.el (article-date-ut): Support converting date in forwarded parts as well. - (gnus-article-save-original-date): New macro. + (gnus-article-save-original-date): New function. (gnus-display-mime): Use it. -2005-04-28 David Hansen +2005-04-22 David Hansen * nnrss.el (nnrss-check-group, nnrss-request-article): Support the enclosure element of . -2005-04-24 Teodor Zlatanov - - * spam-report.el (spam-report-unplug-agent) - (spam-report-plug-agent, spam-report-deagentize) - (spam-report-agentize, spam-report-url-ping-temp-agent-function): - support for the Agent in spam-report: when unplugged, report to a - file; when plugged, submit all the requests. - [Added missing offline functionality from trunk.] - -2005-04-24 Reiner Steib - - * spam-report.el (spam-report-url-to-file) - (spam-report-requests-file): New function and variable for offline - reporting. - (spam-report-url-ping-function): Add `spam-report-url-to-file' - and user defined function. - (spam-report-process-queue): New function. - Process requests from `spam-report-requests-file'. - (spam-report-url-ping-mm-url): Autoload. - [Added missing offline functionality from trunk.] +2005-04-21 Reiner Steib + + * message.el (message-kill-buffer-query): Renamed from + `message-kill-buffer-query-if-modified'. Added :version. + +2005-04-19 Katsumi Yamaoka + + * mml.el (mml-preview): Bind gnus-message-buffer while setting the + window layout. + +2005-04-18 Katsumi Yamaoka + + * mml.el: Autoload dnd when compiling. + +2005-04-18 Reiner Steib + + * mml.el (mml-mode, mml-dnd-attach-file): Use dnd-* instead of + x-dnd-*. 2005-04-18 Katsumi Yamaoka * qp.el (quoted-printable-encode-region): Save excursion. +2005-04-14 Teodor Zlatanov + + * message.el (message-kill-buffer-query-if-modified): Add new variable + so the user can kill a modified message buffer quickly. + (message-kill-buffer): Use it. + 2005-04-13 Katsumi Yamaoka * gnus-art.el (gnus-mime-inline-part): Use mm-string-to-multibyte. * qp.el (quoted-printable-encode-region): Use mm-string-to-multibyte. -2005-04-13 Miles Bader - - * mm-util.el (mm-string-to-multibyte): Use Gnus trunk definition. - 2005-04-12 Katsumi Yamaoka * nnrss.el (nnrss-node-text): Replace CRLFs (which might be @@ -3193,19 +6028,43 @@ 2005-04-11 Lute Kamstra - * message.el (message-make-date): Handle byte-compiler warnings + * nnimap.el (nnimap-date-days-ago): Handle byte-compiler warnings differently. - * nnimap.el (nnimap-date-days-ago): Ditto. 2005-04-10 Stefan Monnier - * mm-util.el (mm-string-to-multibyte): New function. - (mm-detect-coding-region): Typo. + * mm-util.el (mm-detect-coding-region): Typo. 2005-04-11 Katsumi Yamaoka * gnus-art.el (gnus-article-read-summary-keys): Fix misplaced parens. +2005-04-06 D Goel + + * spam-stat.el (spam-stat-score-buffer): Add a call to a + user-function allow user modifications of the scores. + (spam-stat-score-buffer-user): New function, to allow + user-computed modifications to the score. + (spam-stat-score-buffer-user-functions): list of additional + scoring functions + (spam-stat-error-holder): global temporary error holder + (spam-stat-split-fancy): use the new `spam-stat-error-holder' + variable + +2005-04-06 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-clean-empty-function) + (gnus-registry-trim, gnus-registry-fetch-groups) + (gnus-registry-delete-group): Groups that match + `gnus-registry-ignored-groups' are removed from the registry + entries, not just ignored for splitting. This helps clean up the + registry. Also, `gnus-registry-fetch-groups' is a convenient way + to get all the groups a message ID is in. + + * spam-stat.el (spam-stat-split-fancy-spam-threshold) + (spam-stat-split-fancy): Change "threshhold" to "threshold" + (spam-stat-score-buffer-user-functions): Add :number custom type. + 2005-04-06 Katsumi Yamaoka * mm-util.el (mm-coding-system-p): Don't return binary for the nil @@ -3217,132 +6076,19 @@ failed. (nnrss-get-encoding): Return a compatible encoding according to nnrss-compatible-encoding-alist. - (nnrss-opml-export): Use dolist. (nnrss-find-el): Use consp instead of listp. - (nnrss-order-hrefs): Use dolist. - -2005-04-06 Arne J,Ax(Brgensen - - * nnrss.el (nnrss-verbose): Remove. - (nnrss-request-group): Use `nnheader-message' instead. - -2005-04-06 Mark Plaksin (tiny change) - - * nnrss.el (nnrss-verbose): New variable. - (nnrss-request-group): Make it say nnrss is requesting a group. + (nnrss-opml-export, nnrss-order-hrefs, nnrss-find-el): Use dolist. 2005-04-06 Katsumi Yamaoka - * gnus-agent.el (gnus-agent-group-path): Decode group name. - (gnus-agent-group-pathname): Ditto. - - * gnus-cache.el (gnus-cache-file-name): Decode group name. - - * gnus-group.el (gnus-group-line-format-alist): Use decoded group - name for only %g and %c. - (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group - instead of gnus-tmp-group to decoded group name. - (gnus-group-make-group): Decode group name. - (gnus-group-delete-group): Ditto. - (gnus-group-make-rss-group): Exclude `/'s from group names; - register the group data after opening the nnrss group; unify - non-ASCII group names; encode group name. - (gnus-group-catchup-current): Decode group name. - (gnus-group-expire-articles-1): Ditto. - (gnus-group-set-current-level): Ditto. - (gnus-group-kill-group): Ditto. - - * gnus-spec.el (gnus-update-format-specifications): Flush the - group format spec cache if it doesn't support decoded group names. - - * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl. - - * nnrss.el: Require rfc2047 and mml. - (nnrss-file-coding-system): New variable. - (nnrss-format-string): Redefine it as an inline function. - (nnrss-decode-group-name): New function. - (nnrss-string-as-multibyte): Remove. - (nnrss-retrieve-headers): Decode group name; don't use - nnrss-format-string. - (nnrss-request-group): Decode group name. - (nnrss-request-article): Decode group name; allow a Message-ID as - well as an article number; don't use nnrss-format-string; encode a - Message-ID string which may contain non-ASCII characters; use - mml-to-mime to compose a MIME article; use search-forward instead - of re-search-forward. - (nnrss-request-expire-articles): Decode group name. - (nnrss-request-delete-group): Delete entries in nnrss-group-alist - as well; decode group name. - (nnrss-get-encoding): Fix regexp. - (nnrss-fetch): Clarify error message. - (nnrss-read-server-data): Use insert-file-contents instead of load; - bind file-name-coding-system; use multibyte buffer. - (nnrss-save-server-data): Insert newline; bind - coding-system-for-write to the value of nnrss-file-coding-system; - bind file-name-coding-system; add coding cookie. - (nnrss-read-group-data): Use insert-file-contents instead of load; - bind file-name-coding-system; use multibyte buffer. - (nnrss-save-group-data): Bind coding-system-for-write to the - value of nnrss-file-coding-system; bind file-name-coding-system. - (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string; - make it work with non-ASCII text. - (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead - of set-buffer-file-coding-system. - (nnrss-find-el): Check carefully whether there's a list of string - which old xml.el may return rather than a string; make it work - with old xml.el as well. - -2005-04-06 Tsuyoshi AKIHO - - * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name. - - * nnrss.el (nnrss-get-encoding): New function. - (nnrss-fetch): Use unibyte buffer initially; bind - coding-system-for-read while performing mm-url-insert; remove ^Ms; - decode contents according to the encoding attribute. - (nnrss-save-group-data): Add coding cookie. - (nnrss-mime-encode-string): New function. - (nnrss-check-group): Use it to encode subject and author. - -2005-04-06 Maciek Pasternacki (tiny change) - - * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also - failed. - -2005-04-06 Joakim Verona (tiny change) - - * nnrss.el (nnrss-read-group-data): Fix off-by-one error. - -2005-04-06 Jesper Harder - - * mm-util.el (mm-subst-char-in-string): Support inplace. - - * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of - checkdoc.el). - (nnrss-request-article): Cleanup. - (nnrss-request-delete-group): Use nnrss-make-filename. - (nnrss-read-server-data): Use nnrss-make-filename; use load. - (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1. - (nnrss-read-group-data): hash on description if link is missing; - use nnrss-make-filename; use load. - (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1. - (nnrss-make-filename): New function. - (nnrss-close): New function. - (nnrss-check-group): Hash on description if link is missing. - (nnrss-get-namespace-prefix): Use string= to compare strings! - Reported by David D. Smith . - (nnrss-opml-export): Turn on sgml-mode. - -2005-04-06 Mark A. Hershberger - - * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. + * time-date.el (time-to-seconds): Don't use the #xhhhh syntax + which Emacs 20 doesn't support. + (seconds-to-time, days-to-time, time-subtract, time-add): Ditto. 2005-04-04 Reiner Steib - * message.el (message-make-date): Add defvars in order to silence - the byte compiler inside the defun. - - * nnimap.el (nnimap-date-days-ago): Ditto. + * nnimap.el (nnimap-date-days-ago): Add defvars in order to + silence the byte compiler inside the defun * gnus-demon.el (parse-time-string): Add autoload. @@ -3352,84 +6098,13 @@ * nnultimate.el (parse-time): Require for `parse-time-string'. -2005-04-03 Katsumi Yamaoka - - * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the - "Unrecognized menu descriptor" error in XEmacs. - -2005-03-25 Katsumi Yamaoka - - * message.el (message-resend): Bind rfc2047-encode-encoded-words. - - * mm-util.el (mm-replace-in-string): New function. - (mm-xemacs-find-mime-charset-1): Ignore errors while loading - latin-unity, which cannot be used with XEmacs 21.1. - - * rfc2047.el (rfc2047-encode-function-alist): Rename from - rfc2047-encoding-function-alist in order to avoid conflicting with - the old version. - (rfc2047-encode-message-header): Remove useless goto-char. - (rfc2047-encodable-p): Don't move point. - (rfc2047-syntax-table): Treat `(' and `)' as is. - (rfc2047-encode-region): Concatenate words containing non-ASCII - characters in structured fields; don't encode space-delimited - ASCII words even in unstructured fields; don't break words at - char-category boundaries; encode encoded words in structured - fields; treat text within parentheses as special; show the - original text when error has occurred; move point to the end of - the region after encoding, suggested by IRIE Tetsuya - ; treat backslash-quoted characters as - non-special; check carefully whether to encode special characters; - fix some kind of misconfigured headers; signal a real error if - debug-on-quit or debug-on-error is non-nil; don't infloop, - suggested by Hiroshi Fujishima ; assume - the close parenthesis may be included in the encoded word; encode - bogus delimiters. - (rfc2047-encode-string): Use mm-with-multibyte-buffer. - (rfc2047-encode-max-chars): New variable. - (rfc2047-encode-1): New function. - (rfc2047-encode): Use it; encode text so that it occupies the - maximum width within 76-column; work correctly on Q encoding for - iso-2022-* charsets; fold the line before encoding; don't append a - space if the encoded word includes close parenthesis. - (rfc2047-fold-region): Use existing whitespace for LWSP; make it - sure not to break a line just after the header name. - (rfc2047-b-encode-region): Remove. - (rfc2047-b-encode-string): New function. - (rfc2047-q-encode-region): Remove. - (rfc2047-q-encode-string): New function. - (rfc2047-encode-parameter): New function. - (rfc2047-encoded-word-regexp): Don't use shy group. - (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change. - (rfc2047-parse-and-decode): Ditto. - (rfc2047-decode): Treat the ascii coding-system as raw-text by default. - -2005-03-25 Lars Magne Ingebrigtsen - - * rfc2047.el (rfc2047-encode-encoded-words): New variable. - (rfc2047-field-value): Strip props. - (rfc2047-encode-message-header): Disable header folding -- not - all headers can be folded, and this should be done by the message - composition mode. Probably. I think. - (rfc2047-encodable-p): Say that =? needs encoding. - (rfc2047-encode-region): Encode =? strings. - -2005-03-25 Jesper Harder - - * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 - language tags; remove unnecessary '+'. Reported by Stefan Wiens - . - (rfc2047-decode-string): Don't cons a string unnecessarily. - (rfc2047-parse-and-decode, rfc2047-decode): Use a character for - the encoding to avoid consing a string. - (rfc2047-decode): Use mm-subst-char-in-string instead of - mm-replace-chars-in-string. - -2005-03-25 TSUCHIYA Masatoshi - - * rfc2047.el (rfc2047-encode): Use uppercase letters to specify - encodings of MIME-encoded words, in order to improve - interoperability with several broken MUAs. +2005-03-31 Reiner Steib + + * gnus-art.el (gnus-copy-article-ignored-headers): Update :version. + + * gnus-score.el (gnus-adaptive-pretty-print): Ditto. + + * smime.el (smime-ldap-host-list): Add :version. 2005-03-21 Reiner Steib @@ -3475,23 +6150,14 @@ 2005-03-13 Andrey Slusar (tiny change) + * gnus-async.el: Require timer-funcs at compile time when in + XEmacs for `run-with-idle-timer'. + +2005-03-13 Andrey Slusar (tiny change) + * gnus.el: Don't try and mark `gnus-agent-save-groups' as an autoloaded function. -2005-03-13 Steve Youngs - - * mm-url.el: Require timer-funcs at compile time when in XEmacs - for `with-timeout'. - - * mail-source.el: Require timer-funcs at compile time when in - XEmacs for `run-with-idle-timer'. - - * gnus-async.el: Ditto. - -2005-03-16 Lute Kamstra - - * message.el (message-make-date): Require parse-time. - 2005-03-10 Stefan Monnier * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change. @@ -3500,12 +6166,45 @@ * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw. +2005-03-09 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-confirm-mail-reply-to-news): Add + gnus-expert-user to default. + +2005-03-08 Juergen Kreileder (tiny change) + + * nnimap.el (nnimap-open-server): Ditto. + + * imap.el (imap-authenticate): Fix typo. + 2005-03-08 Bjorn Solberg (tiny change) * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV buffer (since IMAP server might return FETCH response out of order, and the nntp buffer must be sorted). +2005-03-06 Kevin Greiner + + * gnus-start.el (gnus-convert-old-newsrc): Fixed numeric + comparison on string. + + * gnus-agent.el (gnus-agent-long-article, + gnus-agent-short-article, gnus-agent-score): Renamed category + keywords to match gnus-cus. + (gnus-agent-summary-fetch-series): Modified to protect against + gnus-agent-summary-fetch-group clearing processable flags. + (gnus-agent-synchronize-group-flags): Update live group buffer as + synchronization may occur due to the user toggle the plugged + status. + (gnus-agent-fetch-group-1): Clear downloadable flag when article + successfully downloaded. + (gnus-agent-expire-group-1): Avoid using markers when the overview + is in ascending order; greatly improves performance. + (gnus-agent-regenerate-group): Use + gnus-agent-synchronize-group-flags to reset read status in both + gnus and server. + (gnus-agent-update-files-total-fetched-for): Fixed initial size. + 2005-03-04 Reiner Steib * message.el: Don't autoload former message-utils variables. @@ -3526,12 +6225,59 @@ * nnweb.el (nnweb-type-definition): Use groups.google.de instead of broken groups(-beta).google.com. +2005-03-03 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-move-article): Pass move-is-internal + parameter to invoked gnus-request-move-article; remove the + redundant gnus-sum-hint-move-is-internal variable; apply the marks + all at once instead of once per article. + (gnus-summary-remove-process-mark): Accept a list of articles as + well as a single article for processing. + + * gnus-int.el (gnus-request-move-article): Add move-is-internal + parameter. + + * nnml.el (nnml-request-move-article): Add move-is-internal parameter. + + * nnmh.el (nnmh-request-move-article): Add move-is-internal parameter. + + * nnmbox.el (nnmbox-request-move-article): Add move-is-internal + parameter. + + * nnmaildir.el (nnmaildir-request-move-article): Add move-is-internal + parameter. + + * nnimap.el (nnimap-request-move-article): Add move-is-internal + parameter and remove the gnus-sum-hint-move-is-internal variable. + + * nnfolder.el (nnfolder-request-move-article): Add move-is-internal + parameter. + + * nndraft.el (nndraft-request-move-article): Add move-is-internal + parameter. + + * nndiary.el (nndiary-request-move-article): Add move-is-internal + parameter. + + * nndb.el (nndb-request-move-article): Add move-is-internal parameter. + + * nnbabyl.el (nnbabyl-request-move-article): Add move-is-internal + parameter. + + * nnagent.el (nnagent-request-move-article): Add move-is-internal + parameter. + 2005-03-01 Stefan Monnier * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in a more conservative way. -2005-02-27 Arne J,Ax(Brgensen +2005-02-26 Stefan Monnier + + * gnus-sum.el (gnus-summary-exit): Move point after displaying the + buffer, so it moves the window's cursor. + +2005-02-26 Arne J,Ax(Brgensen * mm-decode.el (mm-dissect-buffer): Pass the from field on to `mm-dissect-multipart' and receive the from field as an (optional) @@ -3540,10 +6286,16 @@ pass it on when we call `mm-dissect-buffer' on MIME parts. Fixes verification/decryption of signed/encrypted MIME parts. -2005-02-26 Stefan Monnier - - * gnus-sum.el (gnus-summary-exit): Move point after displaying the - buffer, so it moves the window's cursor. +2005-02-25 Teodor Zlatanov + + * gnus-sum.el (gnus-summary-move-article): Set + gnus-sum-hint-move-is-internal for gnus-request-move-article and + whatever it calls (right now, only nnimap-request-move article + respects it). + + * nnimap.el (nnimap-request-move-article): When + gnus-sum-hint-move-is-internal is set, don't do the extra + nnimap-request-article. 2005-02-24 Reiner Steib @@ -3558,12 +6310,43 @@ * gnus-group.el (gnus-group-clear-data): Mention process/prefix in doc string. +2005-02-22 Simon Josefsson + + * encrypt.el (encrypt-password-cache-expiry): Remove (use + `password-cache-expiry' instead). Reported by Arne J,Ax(Brgensen + . + (encrypt): Add password-cache and password-cache-expiry as group + members. + 2005-02-22 Arne J,Ax(Brgensen - * smime.el (smime-sign-buffer): Signal an error if - `smime-sign-region' fails. + * smime.el (smime-ldap-host-list): Doc fix. + (smime-ask-passphrase): Use `password-read-and-add' to read (and + cache) password. + (smime-sign-region): Use it. + (smime-decrypt-region): Use it. + (smime-sign-buffer): Signal an error if `smime-sign-region' fails. (smime-encrypt-buffer): Signal an error if `smime-encrypt-region' fails. + (smime-cert-by-ldap-1): Use `base64-encode-string' to convert + certificate from DER to PEM format rather than calling openssl. + + * mml-smime.el (mml-smime-encrypt-query): Remove obsolete comment. + + * mml-sec.el (mml-secure-message): Insert keyfile/certfile tags + for signing/encryption. + + * mml.el (mml-parse-1): Use them. + +2005-02-21 Arne J,Ax(Brgensen + + * nnrss.el (nnrss-verbose): Removed. + (nnrss-request-group): Use `nnheader-message' instead. + +2005-02-19 Mark Plaksin (tiny change) + + * nnrss.el (nnrss-verbose): New variable. + (nnrss-request-group): Make it say nnrss is requesting a group. 2005-02-21 Reiner Steib @@ -3579,17 +6362,17 @@ * mml.el (mime-to-mml): Ditto. - * rfc2047.el (rfc2047-quote-decoded-words-containing-tspecials): - New variable. + * rfc2047.el (rfc2047-encode-parameter): Use ietf-drums-tspecials. + (rfc2047-quote-decoded-words-containing-tspecials): New variable. (rfc2047-decode-region): Quote decoded words containing special characters when rfc2047-quote-decoded-words-containing-tspecials is non-nil. 2005-02-16 Teodor Zlatanov - * gnus-registry.el (gnus-registry-delete-group): Minor bug fix. - - * gnus.el (gnus-install-group-spam-parameters): Doc fix. + * gnus-registry.el (gnus-registry-delete-group): Add minor bug fix. + + * gnus.el (gnus-install-group-spam-parameters): Add minor doc fix. 2005-02-15 Simon Josefsson @@ -3597,6 +6380,43 @@ * imap.el (imap-debug): Doc fix. +2005-02-15 Katsumi Yamaoka + + * gnus-art.el: Avoid "Recursive load suspected" error in Emacs 21.1. + +2005-02-14 Teodor Zlatanov + + * gnus.el (spam-contents): Improve docs for spam-contents + parameter in its variable incarnation. + +2005-02-14 Simon Josefsson + + * smime-ldap.el: Use require instead of load-library for ldap. + (smime-ldap-search): Indent. + (smime-ldap-search-internal): Shorten line. + + * smime.el (smime-cert-by-dns): Add doc-string. + (smime-cert-by-ldap-1): Indent. + + * mml-smime.el (mml-smime-get-ldap-cert): Renamed from + mml-smime-get-dns-ldap. + (mml-smime-encrypt-query): Use new function. Default to ldap. + +2005-02-14 Arne J,Ax(Brgensen + + * smime.el: Require smime-ldap. + (smime-ldap-host-list): New variable. + (smime-cert-by-ldap, smime-cert-by-ldap-1): New functions. + + * mml-smime.el (mml-smime-encrypt-query): New function. + (mml-smime-encrypt-query): Use it. + + * smime-ldap.el: New file. + +2005-02-13 Katsumi Yamaoka + + * gnus-agent.el: Remove garbage made while merging the Emacs trunk. + 2005-02-14 Reiner Steib * gnus-group.el (gnus-group-make-doc-group): Mention prefix @@ -3615,15 +6435,95 @@ Change Emacs release version from 21.4 to 22.1 throughout. Change Emacs development version from 21.3.50 to 22.0.50. +2005-02-12 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-copy-part): Don't decode compressed parts. + + * mm-util.el (mm-coding-system-to-mime-charset): Make it work with + non-Mule XEmacs as well. + (mm-decompress-buffer): Signal an error intentionally if it does + not decompress compressed data because auto-compression-mode is + disabled. + +2005-02-11 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-delete-group): Fix bug: leaves + an ID in the registry even if it has no groups. + +2005-02-10 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): Remove; + merge it into mm-decompress-buffer. + (gnus-mime-copy-part): Use the MIME part charset, the value which + a user specified or gnus-newsgroup-charset for decoding, like + gnus-mime-inline-part does; set buffer-file-coding-system to tell + save-buffer what was used. Suggested by Kevin Ryde + . + (gnus-mime-inline-part): Allow the name parameter as well as the + filename parameter; force decompressing of compressed data; always + display contents being not decoded as unibyte. + + * mm-view.el (mm-display-inline-fontify): Allow the name parameter + as well as the filename parameter. + + * mm-util.el (mm-decompress-buffer): Merge + gnus-mime-jka-compr-maybe-uncompress. + (mm-find-buffer-file-coding-system): Doc fix; force decompressing + of compressed data. + 2005-02-08 Simon Josefsson * imap.el (imap-log): Doc fix. +2005-02-07 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-inline-part): Decode parts according to + the coding cookies; decompress compressed parts. + + * mml.el (mml-generate-mime-1): Add the charaset parameter according + to the value which a user specified manually or the coding cookie. + + * mm-util.el (mm-string-to-multibyte): New function. + (mm-detect-mime-charset-region): Work with Emacs 22 as well. + (mm-coding-system-to-mime-charset): New function. + (mm-decompress-buffer): New function. + (mm-find-buffer-file-coding-system): New function. + + * mm-view.el (mm-insert-inline): Make sure a part ends with a newline. + (mm-display-inline-fontify): Rewrite for decoding and decompressing + parts. + +2005-02-07 TSUCHIYA Masatoshi + + * mm-view.el (mm-display-inline-fontify): Decode a part according + to the charset parameter. + 2005-02-03 Katsumi Yamaoka * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a prefix arg is neither nil nor a number, as info specifies. +2005-02-02 Katsumi Yamaoka + + * nntp.el (nntp-marks-changed-p): Use time-less-p to compare the + timestamps. + +2005-02-02 Jari Aalto + + * gnus-sum.el (gnus-list-of-unread-articles): Improve active + groups error checking and notify user. + +2005-02-02 Jari Aalto + + * message.el (message-send-mail-function): Check existence of + sendmail-program first before using default value + `message-send-mail-with-sendmail'. Otherwise use more generic + `smtpmail-send-it'. + +2005-02-01 Katsumi Yamaoka + + * nntp.el (nntp-request-update-info): Always return nil. + 2005-01-30 Stefan Monnier * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space. @@ -3644,11 +6544,46 @@ * gnus-art.el (gnus-article-prepare): Remove message-strip-forbidden-properties from the local hook. +2005-01-27 Simon Josefsson + + * password.el (password-cache-add): Only start one timer per key. + Reported by Derek Atkins . + +2005-01-26 Steve Youngs + + * run-at-time.el: Removed. It is no longer needed as + timer-funcs.el in the xemacs-base package has a working version of + `run-at-time'. + + * password.el: Require timer-funcs instead of run-at-time in + XEmacs. + Remove `password-run-at-time' macro. + (password-cache-add): Use `run-at-time' instead of + `password-run-at-time'. + + * mail-source.el: Require timer-funcs instead of itimer in XEmacs + for `run-with-idle-timer'. + + * gnus-demon.el: Require timer-funcs instead of itimer in XEmacs + for `run-at-time'. + + * mm-url.el: Require timer-funcs at compile time when in XEmacs + for `with-timeout'. + 2005-01-24 Katsumi Yamaoka * mml.el (mml-generate-mime-1): Convert string into unibyte when inserting " *mml*" buffer's contents into a unibyte temp buffer. +2005-01-24 Harald Meland (tiny change) + + * mail-source.el (mail-source-fetch-imap): Search for ^From case + sensitively. + +2005-01-21 Derek Atkins (tiny change) + + * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache. + 2005-01-20 Katsumi Yamaoka * mm-decode.el (mm-insert-part): Switch the multibyteness of data @@ -3656,11 +6591,91 @@ rather than the type of contents. Suggested by ARISAWA Akihiro . + * nnrss.el (nnrss-find-el): Check carefully whether there's a list + of string which old xml.el may return rather than a string. + +2005-01-17 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-idna-message): Silence byte compiler. + +2005-01-16 Simon Josefsson + + * gnus-sum.el (gnus-summary-idna-message): Fail gracefully if + idn/idna.el isn't available. + (gnus-summary-idna-message): Doc fix. Suggested by Michael Cook + . + + * hashcash.el: Remove non-FSF copyright header. + + * hashcash.el (hashcash-extra-generate-parameters): New variable. + (hashcash-generate-payment): Use it. + (hashcash-generate-payment-async): Use it. + +2005-01-15 Simon Josefsson + + * message.el (message-idna-to-ascii-rhs): Decode Reply-To too. + Suggested by Raymond Scholz . + + * gnus-sum.el (gnus-summary-wash-map): Bind "W i" to + gnus-summary-idna-message. + (gnus-summary-make-menu-bar): Add De-IDNA menu entry. + (gnus-summary-idna-message): New function. + +2005-01-13 Reiner Steib + + * gnus-msg.el (gnus-confirm-mail-reply-to-news): Change default to + gnus-novice-user. + +2005-01-12 Katsumi Yamaoka + + * nnrss.el (nnrss-request-delete-group): Delete entries in + nnrss-group-alist as well. + (nnrss-save-server-data): Insert newline. + +2005-01-10 Reiner Steib + + * gnus.el (gnus-user-agent): Use list of symbols instead of + symbols. Display full version number for (S)XEmacs. Optionally + display (S)XEmacs codename. + + * gnus-util.el (gnus-emacs-version): Update for new + `gnus-user-agent'. + + * gnus-msg.el (gnus-extended-version): Make it possible to omit + Gnus version. + 2005-01-05 Reiner Steib * spam.el (spam-face): New face. Don't use `gnus-splash-face' which is unreadable in some setups. +2005-01-06 Katsumi Yamaoka + + * gnus-spec.el (gnus-update-format-specifications): Flush the + group format spec cache if it doesn't support decoded group names. + +2005-01-03 Reiner Steib + + * gnus-score.el (gnus-decay-scores, gnus-score-load-file): Allow + to apply decay on score files matching a regexp. + +2004-12-30 Katsumi Yamaoka + + * gnus-group.el (gnus-group-line-format-alist): Keep the forward + compatibility in %g and %c. + +2004-12-29 Katsumi Yamaoka + + * gnus-group.el (gnus-group-line-format-alist): Use decoded group + name for only %g and %c. + (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group instead + of gnus-tmp-group to decoded group name. + (gnus-group-make-rss-group): Exclude `/'s from group names. + +2004-12-28 Katsumi Yamaoka + + * nnrss.el (nnrss-get-encoding): Fix regexp. + 2004-12-27 Simon Josefsson * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when @@ -3673,17 +6688,95 @@ * gnus-sum.el (gnus-summary-mode-map): Likewise. +2004-12-26 Tsuyoshi AKIHO + + * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name. + +2004-12-26 Katsumi Yamaoka + + * nnrss.el: Require rfc2047 and mml. + (nnrss-file-coding-system): New variable. + (nnrss-format-string): Redefine it as an inline function. + (nnrss-decode-group-name): New function. + (nnrss-string-as-multibyte): Remove. + (nnrss-retrieve-headers): Decode group name; don't use + nnrss-format-string. + (nnrss-request-group): Decode group name. + (nnrss-request-article): Decode group name; allow a Message-ID as + well as an article number; don't use nnrss-format-string; encode a + Message-ID string which may contain non-ASCII characters; use + mml-to-mime to compose a MIME article. + (nnrss-request-expire-articles): Decode group name. + (nnrss-request-delete-group): Decode group name. + (nnrss-fetch): Clarify error message. + (nnrss-read-server-data): Use insert-file-contents instead of load; + bind file-name-coding-system; use multibyte buffer. + (nnrss-save-server-data): Bind coding-system-for-write to the + value of nnrss-file-coding-system; bind file-name-coding-system; + add coding cookie. + (nnrss-read-group-data): Use insert-file-contents instead of load; + bind file-name-coding-system; use multibyte buffer. + (nnrss-save-group-data): Bind coding-system-for-write to the + value of nnrss-file-coding-system; bind file-name-coding-system. + (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string; + make it work with non-ASCII text. + (nnrss-find-el): Make it work with old xml.el as well. + +2004-12-26 Tsuyoshi AKIHO + + * nnrss.el (nnrss-get-encoding): New function. + (nnrss-fetch): Use unibyte buffer initially; bind + coding-system-for-read while performing mm-url-insert; remove ^Ms; + decode contents according to the encoding attribute. + (nnrss-save-group-data): Add coding cookie. + (nnrss-mime-encode-string): New function. + (nnrss-check-group): Use it to encode subject and author. + +2004-12-23 Teodor Zlatanov + + * spam.el (spam-check-BBDB): Don't get the symbol-value of an + imaginary variable. + 2004-12-22 Katsumi Yamaoka * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works correctly even if there are wide characters. +2004-12-21 Teodor Zlatanov + + * spam.el (spam-check-BBDB): Fix the BBDB caching code to use + downcased symbol names; make a new cache instead of reusing + bbdb-hashtable. + 2004-12-21 Katsumi Yamaoka * rfc2231.el (rfc2231-parse-string): Decode encoded value after concatenating segments rather than before concatenating them. Suggested by ARISAWA Akihiro . + * message.el (message-get-reply-headers): Bind `extra'. + +2004-12-21 Lars Magne Ingebrigtsen + + * message.el (message-extra-wide-headers): New variable. + (message-get-reply-headers): Use it. + +2004-12-20 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-group-path): Decode group name. + (gnus-agent-group-pathname): Ditto. + + * gnus-cache.el (gnus-cache-file-name): Decode group name. + + * gnus-group.el (gnus-group-make-group): Decode group name. + (gnus-group-make-rss-group): Register the group data after opening + the nnrss group. + +2004-12-17 Paul Jarc + + * nnmaildir.el (nnmaildir-request-expire-articles): Articles moved + by expiry now get marked as read. + 2004-12-17 Katsumi Yamaoka * mm-util.el (mm-xemacs-find-mime-charset): New macro. @@ -3702,6 +6795,34 @@ * gnus-cache.el (gnus-cache-delete-group): Use it. +2004-12-16 Katsumi Yamaoka + + * gnus-group.el (gnus-group-make-rss-group): Unify non-ASCII group + names. + +2004-12-16 Simon Josefsson + + * hashcash.el (hashcash-payment-alist): Fix custom :type. + +2004-12-15 Katsumi Yamaoka + + * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl. + + * gnus-group.el (gnus-group-expire-articles-1): Decode group name. + (gnus-group-set-current-level): Decode group name. + +2004-12-15 Maciek Pasternacki (tiny change) + + * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also + failed. + +2004-12-14 Katsumi Yamaoka + + * gnus-group.el (gnus-group-delete-group): Decode group name. + (gnus-group-make-rss-group): Encode group name. + (gnus-group-catchup-current): Decode group name. + (gnus-group-kill-group): Decode group name. + 2004-12-08 Stefan Monnier * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min. @@ -3715,6 +6836,53 @@ gnus-message-archive-method. Suggested by Lute Kamstra . +2004-12-10 Arnaud Giersch (tiny change) + + * gnus-sum.el (gnus-summary-exit-no-update): Don't clear the + global counterparts of the buffer-local variables. + +2004-11-16 Romain Francoise + + * gnus-sum.el (gnus-summary-exit): Don't clear the global + counterparts of the buffer-local variables. + +2004-11-25 Reiner Steib + + * message.el (message-forbidden-properties): Fixed typo in doc + string. + +2004-11-25 Reiner Steib + + * gnus-util.el (gnus-replace-in-string): Added doc string. + + * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 + to avoid problems when splitting mails with many recipients. + +2004-11-22 Stefan Monnier + + * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful + pop-to-buffer, covered by the subsequent gnus-configure-windows. + +2004-12-05 Nelson Ferreira + + * spam-stat.el (spam-stat-save): Load the hashtable from disk only + if there is no hashtable in memory or file modification time is + newer than cached timestamp. + +2004-12-03 Reiner Steib + + * gnus-sum.el (gnus-summary-limit-to-recipient): Implement + not-matching option. + +2004-12-02 Reiner Steib + + * gnus-sum.el (gnus-summary-limit-to-recipient): New function. + Suggested David Mazieres in analogy to rmail-summary-by-recipients. + (gnus-summary-limit-map, gnus-summary-make-menu-bar): Add it. + (gnus-article-sort-by-recipient, gnus-summary-sort-by-recipient): + New functions. Suggested by Uwe Brauer . + (gnus-summary-mode-map, gnus-summary-make-menu-bar): Add it. + 2004-12-02 Katsumi Yamaoka * message.el (message-forward-make-body-mml): Remove headers @@ -3725,16 +6893,36 @@ * message.el (message-forward-make-body-plain): Always remove headers according to message-forward-ignored-headers. +2004-12-01 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Remove the + gnus-summary-limit pop for now, it has problems with ham marks for + me. + +2004-11-29 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Use gnus-summary-limit + correctly. + +2004-11-28 Carl Henrik Lunde (tiny change) + + * format-spec.el (format-spec): Message the char. + +2004-11-26 Teodor Zlatanov + + * gnus-art.el (gnus-split-methods): Reformat comments. + + * spam.el (spam-summary-prepare-exit): Remove article limits + before exiting the summary buffer. + 2004-11-26 Katsumi Yamaoka * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in order to silence the byte compiler. - * pop3.el (pop3-md5): Define it before being used. - * spam.el: Fix the way to silence the byte compiler, which - complained about bbdb-buffer, bbdb-create-internal, - bbdb-search-simple, mail-check-payment, spam-BBDB-register-routine, + complained about bbdb-buffer, bbdb-create-internal, bbdb-records, + bbdb-search-simple, spam-BBDB-register-routine, spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam, spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam, spam-stat-buffer-is-spam, spam-stat-load, @@ -3771,21 +6959,40 @@ * spam.el (spam-blackhole-good-server-regex): Ditto. -2004-11-25 Reiner Steib - - * message.el (message-forbidden-properties): Fix typo in doc string. - -2004-11-25 Lars Magne Ingebrigtsen - - * message.el (message-strip-forbidden-properties): - Bind buffer-read-only (etc) to nil. - -2004-11-25 Reiner Steib - - * gnus-util.el (gnus-replace-in-string): Add doc string. - - * nnmail.el (nnmail-split-header-length-limit): Increase to 2048 - to avoid problems when splitting mails with many recipients. +2004-11-25 Katsumi Yamaoka + + * mml.el (mml-preview): Widen the message buffer before copying + the contents to the preview buffer; sort headers before previewing. + + * message.el (message-hidden-headers): Fix the way to avoid a bug + in the `repeat' widget in Emacs 21.3 or earlier. + +2004-11-25 Katsumi Yamaoka + + * message.el (message-hidden-headers): Default to "^References:". + Improve customization type. Suggested by Reiner Steib + . + +2004-11-25 Romain Francoise + + * message.el (message-strip-forbidden-properties): Remove check for + obsolete `message-hidden' text property, hidden headers are not + accessible in the buffer anymore. + +2004-11-22 Romain Francoise + + * message.el (message-header-format-alist): Add `From' in list + so that it can be sorted. + (message-fix-before-sending): Widen and sort headers before + sending. + (message-hide-headers): Use narrowing to hide headers by moving + them to the top of the buffer and narrowing to the region + underneath. + +2004-11-23 Lars Magne Ingebrigtsen + + * message.el (message-strip-forbidden-properties): Bind + buffer-read-only (etc) to nil. 2004-11-23 Katsumi Yamaoka @@ -3796,22 +7003,77 @@ * nnfolder.el (nnfolder-request-create-group): Save current buffer. -2004-11-22 Stefan Monnier - - * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful - pop-to-buffer, covered by the subsequent gnus-configure-windows. - -2004-11-14 Luc Teirlinck - - * nnfolder.el (nnfolder-save-marks): Add missing format field in - call to `error'. - * nnml.el (nnml-save-marks): Ditto. +2004-11-19 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Use sit-for to time instead of + accept-process-output, since that doesn't seem to work on udp + sockets. + +2004-11-17 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Encode bogus delimiters. + +2004-11-15 Jesper Harder + + * pop3.el (pop3-leave-mail-on-server): Don't quote nil in + doc string. Improve doc string. + +2004-11-15 Katsumi Yamaoka + + * nntp.el (nntp-request-update-info): Return nil if + nntp-marks-is-evil is true so that gnus-get-unread-articles-in-group + may not call gnus-activate-group which uselessly issues the GROUP + commands for all nntp groups and wastes time. Reported by Romain + Francoise . + + * gnus-start.el (gnus-get-unread-articles): Remove redundant test. + +2004-11-15 Simon Josefsson + + * gnus-art.el (gnus-header-button-alist): Handle URLs in OpenPGP: + headers separately. + (gnus-button-openpgp): New function, inspired by Jochen K,A|(Bpper + . 2004-11-14 Reiner Steib * gnus-start.el (gnus-convert-old-newsrc): Assign legacy-gnus-agent to 5.10.7. +2004-11-14 Lars Magne Ingebrigtsen + + * gnus-art.el (article-unsplit-urls): Don't anchor urls to the + start of the lines. + +2004-11-14 Magnus Henoch + + * hashcash.el (hashcash-default-payment): Change default to 20 + (hashcash-default-accept-payment): Change default to 20 + (hashcash-process-alist): New variable + (hashcash-generate-payment-async): Add + (hashcash-already-paid-p): Add + (hashcash-insert-payment): Don't generate payments twice + (hashcash-insert-payment-async): Add + (hashcash-insert-payment-async-2): Add + (hashcash-cancel-async): Add + (hashcash-wait-async): Add + (hashcash-processes-running-p): Add + (hashcash-wait-or-cancel): Add + (mail-add-payment): New optional argument. Conditionally start + asynchronous calculation. + (mail-add-payment-async): Add + + * message.el (message-send-mail): Wait for asynchronous hashcash + results. Don't clobber existing X-Hashcash headers. + (message-setup-1): Call mail-add-payment-async when + message-generate-hashcash is non-nil. + +2004-11-11 ARISAWA Akihiro (tiny change) + + * message.el (message-use-alternative-email-as-from): Examine the + From header as well; use message-make-from in order to include a + user's full name. + 2004-11-10 Katsumi Yamaoka * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by @@ -3820,12 +7082,26 @@ (gnus-emphasis-custom-value-to-external): New function. (gnus-emphasis-custom-value-to-internal): New function. +2004-11-09 Lars Magne Ingebrigtsen + + * dns.el (query-dns): Resolve reverse addresses. + +2004-10-23 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news): Use it. + + * gnus-start.el (gnus-check-reasonable-setup): New function. + 2004-11-07 Katsumi Yamaoka * gnus-msg.el (gnus-configure-posting-styles): Don't cause the "Args out of range" error. Reported by Arnaud Giersch . +2004-11-07 Stefan Wiens (tiny change) + + * gnus-sum.el (gnus-summary-clear-local-variables): Use symbolp. + 2004-11-04 Richard M. Stallman * spam.el (spam group): Add :version. @@ -3838,35 +7114,11 @@ article buffer with a draft file. This is a temporary measure against the 2004-08-22 change to gnus-article-edit-mode. -2004-11-02 Ilya N. Golubev . - - * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 - entry. - 2004-11-02 Katsumi Yamaoka * html2text.el (html2text-get-attr): Remove unused argument `tag'. (html2text-format-tags): Remove unused variable `attr'. - * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of - after-load-alist. - - * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when - Mule-UCS is loaded under XEmacs. - (mm-mime-mule-charset-alist): Avoid duplicated entries. - - * mm-util.el (mm-coding-system-p): Return a coding-system. - (mm-mime-mule-charset-alist): Use shift_jis instead of - iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new - entries for the mime charsets iso-2022-jp-3 and shift_jis. - (mm-coding-system-priorities): Use shift_jis and iso-8859-1 - instead of japanese-shift-jis and iso-latin-1 respectively in - order to share the default value with both Emacs and XEmacs-mule. - (mm-mule-charset-to-mime-charset): - Make mm-coding-system-priorities effective. - (mm-sort-coding-systems-predicate): Canonicalize coding-systems - while predicating of candidates upon the priorities. - 2004-11-01 Reiner Steib * gnus-msg.el (gnus-summary-resend-default-address): Add :version. @@ -3955,6 +7207,20 @@ * html2text.el (html2text-format-tag-list): Add "strong" and "em". +2004-10-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-hashtb): Create the registry + when package is loaded. + + * spam.el (spam-summary-score-preferred-header): Add global preference + for people who want to override the default SpamAssassin over + Bogofilter preference (when both are set). + (spam-necessary-extra-headers): Add spam-use-bogofilter as an option. + (spam-user-format-function-S): Check + spam-summary-score-preferred-header. + (spam-extra-header-to-number): Add X-Bogosity header parsing. + (spam-user-format-function-S): Format the score correctly. + 2004-10-29 Katsumi Yamaoka * gnus-msg.el (gnus-configure-posting-styles): Work with empty @@ -3976,352 +7242,132 @@ * gnus-spec.el (gnus-update-format-specifications): Return a list of updated types. +2004-10-27 Katsumi Yamaoka + + * gnus-start.el (gnus-check-reasonable-setup): Use fboundp instead + of boundp to check if display-warning is available. + +2004-10-26 Teodor Zlatanov + + * nnimap.el (nnimap-open-connection): Fix prog1/prog2 bug. + 2004-10-26 Katsumi Yamaoka * nnspool.el (nnspool-spool-directory): Use news-path if the news-directory variable is not bound. - * gnus-group.el (gnus-group-line-format-alist): Convert the value - of gnus-tmp-news-method into string if it may be passed to - gnus-correct-length which takes only a string argument. + * gnus-start.el (gnus-check-reasonable-setup): Use an alternative + function instead of display-warning if it is not available. + +2004-10-26 Reiner Steib + + * gnus-agent.el (gnus-agent-expire-group-1): Fix last merge from + v5-10: Use `point-at-bol'. + +2004-10-26 Simon Josefsson + + * hashcash.el: Fix URL in comment, reported by Cheng Gao + . 2004-10-25 Reiner Steib * html2text.el (html2text-buffer-head): Remove. Use `goto-char' instead. -2004-10-24 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Fix numeric - comparison on string. +2004-10-25 Teodor Zlatanov + + * nnimap.el (nnimap-remove-server-from-buffer-alist): Add function + to remove a server from the nnimap-server-buffer-alist. + (nnimap-open-connection, nnimap-close-server): Use it. + + * gnus-encrypt.el: Remove file in favor of encrypt.el. 2004-10-21 Katsumi Yamaoka * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when running the major-mode function. -2004-10-21 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Two of the converters - have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a - boolean check to not apply converters that apply to future - versions of gnus. - 2004-10-19 Katsumi Yamaoka * gnus-sum.el (gnus-update-summary-mark-positions): Search for dummy marks in the right way. -2004-10-18 Kevin Greiner - - * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to - avoid infinite recursion via gnus-get-function. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-group-flags): - When necessary, pass full group name to gnus-request-set-marks. - (gnus-agent-synchronize-group-flags): Add support for sync'ing - tick marks. - (gnus-agent-synchronize-flags-server): Be silent when writing file. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-group-flags): - Replace gnus-request-update-info with explicit code to sync the - in-memory info read flags with the marks being sync'd to the backend. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers - that are offline. Avoids having gnus-agent-toggle-plugged first ask if - you want to open a server and then, even when you responded with no, - asking if you want to synchronize the server's flags. - (gnus-agent-synchronize-flags-server): Rewrite read loop to handle - multi-line expressions. - (gnus-agent-synchronize-group-flags): New internal function. - Updates marks in memory (in the info structure) AND in the backend. - (gnus-agent-check-overview-buffer): Fix range of - deletion to remove entire duplicate line. Fixes merged article - number bug. - - * gnus-util.el (gnus-remassoc): Fix typo in documentation. - - * nnagent.el (nnagent-request-set-mark): - Use gnus-agent-synchronize-group-flags, not backend's request-set-mark - method, to ensure that synchronization updates marks in the - backend and in the info (in memory) structure. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing - unless plugged. Disable the agent so that an open failure causes - an error. - -2004-10-18 Reiner Steib - - * gnus-agent.el (gnus-agent-fetched-hook): Add :version. - (gnus-agent-go-online): Change :version. - (gnus-agent-expire-unagentized-dirs) - (gnus-agent-auto-agentize-methods): Add :version. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el - (gnus-agent-convert-to-compressed-agentview-prompt): - New function. Used internally to only display 'gnus converting - files' message when actually necessary. - - * gnus-sum.el: Remove (require 'gnus-agent) as required - methods now autoloaded. - - * gnus-int.el (gnus-request-move-article): - Use gnus-agent-unfetch-articles in place of gnus-agent-expire to - improve performance. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-cat-groups): Rewrite avoiding defsetf - to avoid run-time CL dependencies. - (gnus-agent-unfetch-articles): New function. - (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate - article numbers even when local .overview file is missing. - (gnus-agent-read-article-number): New function. Only accepts - 27-bit article numbers. - (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): - Use gnus-agent-read-article-number. - (gnus-agent-braid-nov): Rewrote to validate article numbers coming - from backend while recognizing that article numbers in .overview - must be valid. - - * gnus-start.el (gnus-convert-old-newsrc): Change message text as - some users confused by references to .newsrc when they only have a - .newsrc.eld file. - (gnus-convert-mark-converter-prompt) - (gnus-convert-converter-needs-prompt): Fix use of property list. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-get-unread-articles-in-group): Don't do - stuff for non-living groups. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. - (gnus-agent-regenerate-group): Using nil messages aren't valid. - -2004-10-18 Lars Magne Ingebrigtsen - - * gnus-agent.el (gnus-agent-read-agentview): - Inline gnus-uncompress-range. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el - (gnus-agent-convert-to-compressed-agentview): Fix typos with - help from Florian Weimer - - * gnus-agent.el (gnus-agentize): - gnus-agent-send-mail-real-function no longer set to current value - of message-send-mail-function but rather a lambda that calls - message-send-mail-function. The change makes the agent real-time - responsive to user changes to message-send-mail-function. - -2004-10-18 Reiner Steib - - * gnus-start.el (gnus-get-unread-articles): Fix last commit. - -2004-10-18 Kevin Greiner - - * gnus-cache.el (gnus-cache-rename-group): New function. - (gnus-cache-delete-group): New function. - - * gnus-agent.el (gnus-agent-rename-group): New function. - (gnus-agent-delete-group): New function. - (gnus-agent-save-group-info): Use gnus-command-method when - `method' parameter is nil. Don't write nil entries into the - active file. - (gnus-agent-get-group-info): New function. - (gnus-agent-get-local): Add optional parameters to avoid calling - gnus-group-real-name and gnus-find-method-for-group. - (gnus-agent-set-local): Delete stored entry if either min, or max, - are nil. - (gnus-agent-fetch-session): Reword error/quit messages. - On quit, use gnus-agent-regenerate-group to record existance of any - articles fetched to disk before the quit occurred. - - * gnus-int.el (gnus-request-delete-group): - Use gnus-cache-delete-group and gnus-agent-delete-group to keep the - local disk in sync with the server. - (gnus-request-rename-group): - Use gnus-cache-rename-group and gnus-agent-rename-group to keep the - local disk in sync with the server. - - * gnus-start.el (gnus-get-unread-articles): - Cosmetic simplification to logic. - - * gnus-group.el (gnus-group-delete-group): No longer update - gnus-cache-active-altered as gnus-request-delete-group now keeps - the cache in sync. - (gnus-group-list-active): Let the agent store a server's active - list if currently plugged. - - * gnus-util.el (gnus-rename-file): New function. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-regenerate-group): Activate the group - when the group's active is not available. - -2004-10-18 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to - error. - -2004-10-18 Kevin Greiner - - * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion - message to newsrc-dribble when an actual conversion is performed. - -2004-10-18 Kevin Greiner - - * gnus-agent.el (gnus-agent-read-local): - Bind nnheader-file-coding-system to gnus-agent-file-coding-system to - avoid the implicit assumption that they will always be equal. - (gnus-agent-save-local): Bind buffer-file-coding-system, not - coding-system-for-write, as the with-temp-file macro first prints - to a buffer then saves the buffer. - -2004-10-18 Kevin Greiner - - * legacy-gnus-agent.el (): New. Provides converters that are only - loaded when gnus-convert-old-newsrc needs to call them. - - * gnus-agent.el (gnus-agent-read-agentview): Remove support for - old file versions. - (gnus-group-prepare-hook): Remove function that converted list - form of gnus-agent-expire-days to group properties. - - * gnus-start.el (gnus-convert-old-newsrc): Register new - converters to handle old agent file formats. Added logic for a - "backup before upgrading warning". - (gnus-convert-mark-converter-prompt): Developers can mark - functions as needing (default), or not needing, - gnus-convert-old-newsrc's "backup before upgrading warning". - (gnus-convert-converter-needs-prompt): Tests whether the user - should be protected from potentially irreversable changes by the - function. - -2004-10-18 Kevin Greiner - - * gnus-int.el (gnus-request-accept-article): Inform the agent that - articles are being added to a group. - (gnus-request-replace-article): Inform the agent that articles - need to be uncached as the cached contents are no longer valid. - - * gnus-agent.el (gnus-agent-file-header-cache): Remove. - (gnus-agent-possibly-alter-active): Avoid null in numeric comparison. - (gnus-agent-set-local): Refuse to save null in local object table. - (gnus-agent-regenerate-group): The REREAD parameter can now be a - list of articles that will be marked as unread. - -2004-10-18 Kevin Greiner - - * gnus-range.el (gnus-sorted-range-intersection): Now accepts - single-interval range of the form (min . max). Previously the - range had to look like ((min . max)). Likewise, return - (min . max) rather than ((min . max)). - (gnus-range-map): Use gnus-range-normalize to accept - single-interval range. - - * gnus-sum.el (gnus-summary-highlight-line): Articles stored in - the cache, but not the agent, now appear with their usual face. - -2004-10-18 Kevin Greiner - - * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of - marks consisting of a single range {for example, (3 . 5)} rather - than a list of a single range { ((3 . 5)) }. - -2004-10-18 Kevin Greiner - - * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the - uncompressed list. - -2004-10-18 Kevin Greiner - - * gnus-draft.el (gnus-group-send-queue): Pass the group name - "nndraft:queue" along to gnus-draft-send. - Use gnus-agent-prompt-send-queue. - (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group - is "nndraft:queue". Suggested by Gaute Strokkenes - - - * gnus-group.el (gnus-group-catchup): Use new - gnus-sequence-of-unread-articles, not - gnus-list-of-unread-articles, to avoid exhausting memory with huge - numbers of articles. Use gnus-range-map to avoid having to - uncompress the unread list. - (gnus-group-archive-directory) - (gnus-group-recent-archive-directory): Fix invalid ange-ftp reference. - - * gnus-range.el (gnus-range-map): Iterate over list or sequence. - (gnus-sorted-range-intersection): Intersection of two ranges - without requiring that they first be uncompressed. - - * gnus-start.el (gnus-activate-group): Unless blocked by the - caller, possibly expand the active range to include both cached - and agentized articles. - (gnus-convert-old-newsrc): Rewrote in anticipation of having - multiple version-dependent converters. - (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with - gnus-agent-save-active. - (gnus-save-newsrc-file): Save dirty agent range limits. - - * gnus-sum.el (gnus-select-newgroup): Replace inline code with - gnus-agent-possibly-alter-active. - (gnus-adjust-marked-articles): Faster handling of simple lists. - 2004-10-18 David Edmondson * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call excessively. +2004-10-18 Teodor Zlatanov + + * gnus-util.el (gnus-split-references): Accept a nil references + string and go on blissfully. + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): Catch + cases where the references string is non-nil but has no references. + + * encrypt.el: Add autoload tags. + + * spam.el (spam-resolve-registrations-routine): Remove article + from unregistration list too. Reported by David Hanak + + 2004-10-18 Reiner Steib - * mml.el (mml-preview): Use `pop-to-buffer'. - - * message.el (message-goto-mail-followup-to): Insert after "To". - (message-carefully-insert-headers): Add comment. - - * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. - - * gnus-art.el (gnus-button-alist): - Improve `gnus-button-handle-library' entry. - - * gnus-art.el (gnus-button-alist): Fix regexp for manual links. - - * gnus-group.el (gnus-group-get-new-news-this-group): Add doc-string. - - * gnus-start.el (gnus-activate-group): Add doc-string. - - * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to - handle manual section. - - * imap.el (imap-store-password): New variable. - (imap-interactive-login): Use it. - Suggested by Mark Plaksin . - - * gnus-art.el (gnus-button-alist, gnus-header-button-alist): - Allow / in mailto URLs. - - * spam.el (spam-directory): Derive from `gnus-directory'. - - * gnus-sum.el (gnus-pick-line-number): Add autoload. + * gnus-art.el (gnus-copy-article-ignored-headers): Default to + nil. Changed custom type. + +2004-10-17 Reiner Steib + + * gnus-art.el (gnus-copy-article-ignored-headers): New variable. + + * gnus-sum.el (gnus-summary-move-article): Use it. + +2004-10-15 Teodor Zlatanov + + * encrypt.el: Add autoload cookies. + + * spam.el (spam-backend-article-list-property) + (spam-backend-get-article-todo-list) + (spam-backend-put-article-todo-list, ) + (spam-summary-prepare-exit, spam-resolve-registrations-routine): + Resolve registrations separately. + (spam-register-routine): Format comments. + (spam-unregister-routine, spam-register-routine): Always call with + specific-articles, no default list. + (spam-summary-prepare-exit): Use the spam-classifications function. + + * netrc.el (autoload, netrc-parse): Use encrypt.el instead of + gnus-encrypt.el. + + * encrypt.el: copied from gnus-encrypt.el + + * gnus-encrypt.el: commented that it's obsolete + +2004-10-15 Reiner Steib + + * gnus-score.el (gnus-adaptive-pretty-print): New variable. + (gnus-score-save): Use it. + + * message.el (message-bury): Use `window-dedicated-p'. + +2004-10-15 Simon Josefsson + + * pop3.el (top-level): Don't require nnheader. + (pop3-read-timeout): Add. + (pop3-accept-process-output): Add. + (pop3-read-response, pop3-retr): Use it. + +2004-10-14 Teodor Zlatanov + + * spam.el (spam-register-routine): Move comment. + (spam-verify-bogofilter): Use 'unknown for the initial + spam-bogofilter-valid state, not 'never. + + * netrc.el (netrc-machine-user-or-password): Add convenience wrapper + for netrc-machine. + + * nnimap.el (nnimap-open-connection): Use + netrc-machine-user-or-password. 2004-10-17 Richard M. Stallman @@ -4346,21 +7392,25 @@ (message-ignored-resent-headers) (message-forward-ignored-headers): Improve custom type. -2004-10-15 Simon Josefsson - - * pop3.el (top-level): Don't require nnheader. - (pop3-read-timeout): Add. - (pop3-accept-process-output): Add. - (pop3-read-response, pop3-retr): Use it. - 2004-10-13 Katsumi Yamaoka * message.el (message-tokenize-header): Fix 2004-09-06 change which used point-min in the wrong place. -2004-10-11 Reiner Steib - - * message.el (message-bury): Use `window-dedicated-p'. +2004-10-12 Simon Josefsson + + * tls.el (tls-certtool-program): New variable. + (tls-certificate-information): New function, based on + ssl-certificate-information. + +2004-10-12 Katsumi Yamaoka + + * compface.el: Move the version of ELisp-based uncompface program + to the contrib directory because of the copyright problem. + +2004-10-12 Reiner Steib + + * message.el (message-kill-buffer): Raise the current frame. 2004-10-10 Reiner Steib @@ -4385,6 +7435,31 @@ * mml.el (mml-minibuffer-read-disposition): Require match. Suggested by Dave Love . +2004-10-11 Reiner Steib + + * gnus-group.el (gnus-group-delete-group): Change "\t." to " " in + doc string. + +2004-10-08 Katsumi Yamaoka + + * mm-uu.el (mm-uu-dissect-text-parts): Support all text/* types. + +2004-10-07 TSUCHIYA Masatoshi + + * gnus-art.el (gnus-mime-display-single): Call `mm-display-inline' + instead of calling `mm-insert-inline', to decode text/* parts + before displaying them. + +2004-10-07 Katsumi Yamaoka + + * mm-uu.el (mm-uu-text-plain-type): New variable. + (mm-uu-pgp-signed-extract-1): Use it. + (mm-uu-pgp-encrypted-extract-1): Use it. + (mm-uu-dissect): Allow MIME type and parameters as an optional arg; + bind mm-uu-text-plain-type with that value. + (mm-uu-dissect-text-parts): Pass MIME type and parameters to + mm-uu-dissect. + 2004-10-06 Katsumi Yamaoka * gnus-group.el (gnus-update-group-mark-positions): @@ -4393,8 +7468,6 @@ * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead of string-as-multibyte. - * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. - 2004-10-05 Juri Linkov * gnus-group.el (gnus-update-group-mark-positions): @@ -4403,99 +7476,289 @@ * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert 8-bit unibyte values to a multibyte string for search functions. +2004-10-06 Katsumi Yamaoka + + * mm-uu.el (mm-uu-dissect): Allow optional arg. + (mm-uu-dissect-text-parts): New function. + + * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to + dissect text parts. + + * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq. + (gnus-summary-force-verify-and-decrypt): Revert 2004-08-18 change. + + * mm-decode.el (mm-dissect-singlepart): Revert 2004-08-18 change. + + * gnus-topic.el (gnus-topic-hierarchical-parameters): Use + gnus-current-topics instead of gnus-current-topic. + +2004-10-06 Jesper Harder + + * gnus-sum.el (gnus-summary-show-article): Use with-current-buffer. + +2004-10-05 Jesper Harder + + * nnsoup.el (nnsoup-read-active-file): Use dolist, mapc or last + where approriate. + + * nnml.el (nnml-generate-active-info): do. + + * nndiary.el (nndiary-generate-active-info): do. + + * gnus-topic.el (gnus-topic-hierarchical-parameters): do. + (gnus-topic-move): do. + + * gnus-sum.el (gnus-data-enter-list, gnus-summary-process-mark-set) + (gnus-summary-set-local-parameters, gnus-summary-read-document): do. + + * gnus-srvr.el (gnus-server-prepare) + (gnus-server-open-all-servers): do. + + * gnus-msg.el (gnus-summary-cancel-article) + (gnus-summary-resend-message) + (gnus-summary-mail-crosspost-complaint): do. + + * gnus-move.el (gnus-change-server): do. + + * gnus-group.el (gnus-group-unmark-all-groups) + (gnus-group-set-current-level): do. + +2004-10-04 Simon Josefsson + + * message.el (message-generate-hashcash): Doc fix. + +2004-10-02 Kevin Greiner + + * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to + avoid infinite recursion via gnus-get-function. + +2004-10-02 Jesper Harder + + * mm-partial.el (mm-partial-find-parts): Use with-current-buffer. + + * nnfolder.el (nnfolder-generate-active-file): Use dolist. + + * nnmail.el (nnmail-split-history): do. + + * nnml.el (nnml-generate-nov-databases-1, nnml-request-rename-group) + (nnml-request-delete-group): do. + + * nnslashdot.el (nnslashdot-read-groups): do. + + * nnsoup.el (nnsoup-delete-unreferenced-message-files): do. + (nnsoup-unpack-packets, nnsoup-make-active): Simplify. + + * nnspool.el (nnspool-find-id): Use with-temp-buffer. + (nnspool-sift-nov-with-sed): Use last + (nnspool-retrieve-headers-with-nov): Use mapc. + (nnspool-request-newgroups): Use dolist. + (nnspool-request-group): Use last. + + * nntp.el (nntp-read-server-type): Use dolist. + + * nnvirtual.el (nnvirtual-create-mapping) + (nnvirtual-update-read-and-marked): Use dolist. + (nnvirtual-convert-headers): Simplify. + +2004-10-01 Kevin Greiner + + * gnus-agent.el (gnus-agent-synchronize-group-flags): Added + support for sync'ing tick marks. + 2004-10-01 Katsumi Yamaoka * gnus-sum.el (gnus-summary-toggle-header): Make it work even if there's no visible header. +2004-10-01 Kevin Greiner + + * gnus-agent.el (gnus-agent-synchronize-group-flags): When + necessary, pass full group name to gnus-request-set-marks. + 2004-10-01 Simon Josefsson * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free acroread. -2004-09-29 Jesper Harder - - * gnus.el (gnus-method-to-server): Oops, move it don't delete it. - -2004-09-28 Jesper Harder - - * gnus-picon.el: Require cl. - - * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus. - - * mml-smime.el: Require cl. Autoload message-fetch-field. - - * gnus-fun.el: Require gnus-ems and gnus-util. - - * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr). - - * gnus-art.el (gnus-article-edit-mode): Define before first reference. - - * gnus.el (gnus-method-to-server): Move defsubst before first use. - - * spam.el (spam-check-spamoracle, spam-spamoracle-learn): - Fix format string mismatch. - * nnml.el (nnml-request-set-mark, nnml-save-marks): Do. - * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): Do. - -2004-09-27 Reiner Steib - - * gnus.el (gnus-version-number): Set to 5.11. +2004-10-01 Lars Magne Ingebrigtsen + + * spam-report.el (spam-report-gmane): Fix interactive. + + * gnus-art.el (gnus-treat-body-boundary): Only do stuff under X. + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Be silent + when writing file. + (gnus-agent-synchronize-flags): Don't default to being + interactive. + +2004-09-30 Simon Josefsson + + * message.el (message-generate-hashcash): Add. + (message-send-mail): Use it, call mail-add-payment. + +2004-09-29 Teodor Zlatanov + + * spam.el (spam-verify-bogofilter): Use -V, not -sV option. + +2004-09-28 Kevin Greiner + + * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced + gnus-requst-update-info with explicit code to sync the in-memory + info read flags with the marks being sync'd to the backend. + + *gnus-util.el (gnus-pp): Added optional stream to match pp API. + +2004-09-28 Teodor Zlatanov + + * spam.el (spam-verify-bogofilter): Add new function. + (spam-check-bogofilter) + (spam-bogofilter-register-with-bogofilter): Use it. + (spam-verify-bogofilter): Add small fixes. + +2004-09-28 Simon Josefsson + + * hashcash.el (hashcash-generate-payment): Revert. + +2004-09-28 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): Use + gnus-extract-references instead of gnus-split-references. + + * gnus-util.el (gnus-extract-references): Add new function, analogous + to gnus-split-references but extracts only the message-ID without + anything extra. + + * hashcash.el (hashcash-generate-payment) + (hashcash-check-payment): Do the right thing if hashcash-path is + nil (because the hashcash program could not be found). + + * spam.el (spam-use-hashcash): Remove comment. + +2004-09-27 Jesper Harder + + * gnus-cache.el (gnus-cache-possibly-remove-articles-1) + (gnus-cache-enter-article, gnus-cache-remove-article) + (gnus-cache-braid-heads, gnus-cache-generate-active): Use dolist. + + * gnus-async.el (gnus-async-prefetch-remove-group): do. + + * gnus-art.el (article-hide-boring-headers) + (article-translate-strings, article-display-face) + (gnus-article-mime-match-handle-first) + (gnus-article-highlight-headers) + (gnus-article-add-buttons-to-head): do. + +2004-09-27 Simon Josefsson + + * hashcash.el: New version, from + http://users.actrix.co.nz/mycroft/hashcash.el. Previously in + ../contrib/. 2004-09-27 Katsumi Yamaoka * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte. -2004-09-26 Christian Neukirchen (tiny change) - - * mm-util.el (mm-image-load-path): Handle nil in load-path. - 2004-09-26 Jesper Harder - * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if - GROUP is a virtual group. - - * mm-util.el (mm-charset-synonym-alist): Remove obsolete entries - for big5 and gb2312. - - * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid - padding. - - * mm-bodies.el (mm-7bit-chars): Don't include \r. - - * mml.el (mml-compute-boundary-1): Don't uncompress files. - - * rfc2047.el (rfc2047-qp-or-base64): New function to reduce - dependencies. - (rfc2047-encode): Use it. - - * flow-fill.el: Typo. - - * mml.el (mml-generate-mime-1): Don't use format=flowed with - inline PGP. - - * gnus.el (gnus-getenv-nntpserver): Strip whitespace. - - * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is - alive. Reported by Laurent Martelli . - - * html2text.el (html2text-replace-list): Add & and '. - - * nnheader.el (nnheader-max-head-length): Increase to 8192. - - * message.el (message-clone-locals): Clone sendmail and smtp - variables. + * gnus-dup.el (gnus-dup-open): Use mapc. + (gnus-dup-enter-articles, gnus-dup-suppress-articles): Use dolist. + + (gnus-dup-enter-articles): Remove excess ID's from gnus-dup-hashtb. + Reported by Stefan Wiens . + + * gnus.el (gnus-shutdown): Use dolist. + + * gnus-undo.el (gnus-undo): Use mapc. + + * nnrss.el (nnrss-generate-active): do. + + * message.el (message-cite-original-without-signature) + (message-cite-original): Use mapc. + (message-do-actions, message-make-forward-subject): Use dolist. + +2004-09-25 Kevin Greiner + + * gnus-agent.el (gnus-agent-check-overview-buffer): Fixed range of + deletion to remove entire duplicate line. Fixes merged article + number bug. + +2004-09-25 Kevin Greiner + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore + servers that are offline. Avoids having gnus-agent-toggle-plugged + first ask if you want to open a server and then, even when you + responded with no, asking if you want to synchronize the server's + flags. + (gnus-agent-synchronize-flags-server): Rewrote read loop to handle + multi-line expressions. + (gnus-agent-synchronize-group-flags): New internal function. + Updates marks in memory (in the info structure) AND in the + backend. + + * gnus-util.el (gnus-remassoc): Fixed typo in documentation. + + * nnagent.el (nnagent-request-set-mark): Use + gnus-agent-synchronize-group-flags, not backend's request-set-mark + method, to ensure that synchronization updates marks in the + backend and in the info (in memory) structure. + +2004-09-24 Katsumi Yamaoka + + * gnus-uu.el (gnus-uu-digest-mail-forward): Obey the process/prefix + convention fully; don't miss the root article of a thread; make + the X-Draft-From header with correct article numbers. + +2004-09-23 Kevin Greiner + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing + unless plugged. Disable the agent so that an open failure causes + an error. + + * gnus-int.el (gnus-request-set-mark, gnus-request-update-mark): + Reverted 2004-09-21 change. The backend must be opened while + synchronizing flags even when the backend stores the flags + locally. 2004-09-23 Reiner Steib * gnus-msg.el (gnus-configure-posting-styles): Narrow to headers in `header' match. Reported by Svend Tollak Munkejord. + * message.el (message-cite-original): Fix use of + `message-cite-articles-with-x-no-archive'. + +2004-09-22 Katsumi Yamaoka + + * gnus-win.el (gnus-buffer-configuration): Add mml-preview. + (gnus-window-to-buffer): Ditto. + + * mml.el (mml-preview-buffer): New variable. + (mml-preview): Manage window layout with gnus-buffer-configuration. + + * gnus-msg.el (gnus-setup-message): Put article numbers into the + X-Draft-From header even if those articles aren't quoted. + +2004-09-21 Kevin Greiner + + * gnus-int.el (gnus-servers-that-use-local-marks): New variable. + (gnus-request-set-mark, gnus-request-update-mark): Use new + g-s-t-u-l-m to decide to use backend even when unplugged. + +2004-09-21 Katsumi Yamaoka + + * gnus-msg.el (gnus-inews-make-draft-meta-information): Don't add + a trailing whitespace. Suggested by Cheng Gao . + +2004-09-20 Simon Josefsson + + * mm-util.el (mm-charset-synonym-alist): Map "unicode" to + "utf-16-le". + 2004-09-20 Stefan Monnier * mm-decode.el (mm-copy-to-buffer): Preserve the data's unibyteness. -2004-09-20 Reiner Steib +2004-09-19 Reiner Steib * uudecode.el (uudecode-use-external): Add :version. @@ -4647,29 +7910,48 @@ * gnus-sum.el (gnus-fetch-old-headers): Add custom choices `t' and `invisible'. +2004-09-10 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-trim): Watch out for negatives + in gnus-registry-trim. + 2004-09-13 Simon Josefsson + * dns-mode.el: Add XEmacs auto-mode-alist autoload cookie. + * nnimap.el (nnimap-demule): Revert 2004-08-30 change. + * dns-mode.el (dns-mode): Fix menu for XEmacs, reported by Steve + Youngs and suggested by Katsumi Yamaoka + . + (dns-mode-font-lock-keywords): Fix faces, reported by Steve Youngs + and suggested by Katsumi Yamaoka + . + + * sieve.el (sieve-manage-mode): Ditto. + 2004-09-13 Reiner Steib * gnus-sum.el (gnus-summary-copy-article): Fix doc string. +2004-09-11 Simon Josefsson + + * dns-mode.el: Add. + + * mm-view.el (mm-display-dns-inline): Add. + + * mm-decode.el (mm-inline-media-tests): Add text/dns. + (mm-automatic-display): Ditto. + + * mailcap.el (mailcap-mime-data): Add text/dns. + (mailcap-mime-extensions): Map .soa to text/dns. + 2004-09-10 Miles Bader - * nnimap.el (nnimap-open-connection): Remove extraneous end-paren. - -2004-09-10 Teodor Zlatanov - - * nnimap.el (nnimap-open-connection): Allow 'imaps' as a synonym - for the 'imap' port in netrc files. - - * gnus-registry.el (gnus-registry-trim): Watch out for negatives - in gnus-registry-trim. - -2004-09-10 Simon Josefsson - - * nndb.el (require): Remove tcp and duplicate cl. + * gnus-art.el (article-decode-mime-words, article-babel) + (gnus-article-highlight-signature, gnus-article-add-buttons) + (gnus-signature-toggle): Remove unnecessary bindings of + `inhibit-read-only' inherited from v5.10 merge. 2004-09-08 Reiner Steib @@ -4686,7 +7968,7 @@ * flow-fill.el (fill-flowed-display-column) (fill-flowed-encode-column): Ditto. -2004-09-06 Stefan Monnier +2004-09-06 Stefan * message.el (message-tokenize-header, message-send-mail-with-qmail): Use point-min rather than 1. @@ -4699,14 +7981,59 @@ (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1. (gnus-highlight-selected-tree): Use point-min rather than 1 and 2. +2004-09-10 Simon Josefsson + + * nndb.el (require): Remove tcp and duplicate cl. + +2004-09-10 Katsumi Yamaoka + + * gnus-agent.el (directory-files-and-attributes): Move forward. + +2004-09-09 Kevin Greiner + + * gnus-agent.el (directory-files-and-attributes): Optionally + defined to support XEmacs. + +2004-09-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf + to avoid run-time CL dependencies. + (gnus-agent-unfetch-articles): New function. + (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate + article numbers even when local .overview file is missing. + (gnus-agent-read-article-number): New function. Only accepts + 27-bit article numbers. + (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use + gnus-agent-read-article-number. + (gnus-agent-braid-nov): Rewrote to validate article numbers coming + from backend while recognizing that article numbers in .overview + must be valid. + (gnus-agent-update-files-total-fetched-for): Use + directory-files-and-attributes to improve performance. + * gnus-int.el (gnus-request-move-article): Use + gnus-agent-unfetch-articles in place of gnus-agent-expire to + improve performance. + + * gnus-start.el (gnus-convert-old-newsrc): Changed message text as + some users confused by references to .newsrc when they only have a + .newsrc.eld file. + (gnus-convert-mark-converter-prompt, + gnus-convert-converter-needs-prompt): Fixed use of property list. + * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt): + New function. Used internally to only display 'gnus converting + files' message when actually necessary. + + * gnus-sum.el (): Removed (require 'gnus-agent) as required + methods now autoloaded. + 2004-09-03 Katsumi Yamaoka - * gnus-sum.el (gnus-summary-insert-subject): Remove list identifiers. - -2004-09-03 Hiroshi Fujishima (tiny change) - - * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty. - (spam-stat-save): Accept prefix argument. + * gnus-sum.el (gnus-summary-insert-subject): Remove list + identifiers. + +2004-09-02 Reiner Steib + + * gnus-picon.el: Fix indentation and closing parenthesis. 2004-09-01 Simon Josefsson @@ -4723,43 +8050,2659 @@ * sha1-el.el: Renamed to sha1.el. +2004-08-30 Juanma Barranquero + + * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant. + +2004-08-30 Stefan Monnier + + * nnimap.el (nnimap-demule): Avoid string-as-multibyte. + +2004-08-30 Kim F. Storm + + * nntp.el (nntp-authinfo-file): Add :group 'nntp. + + * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache): + Add :group 'nnimap. + +2004-08-30 Andreas Schwab + + * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for + ?* and ?\;. + + * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; + and ?\' to symbol instead of whitespace. + +2004-08-30 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. + + * gnus-sum.el (gnus-summary-morse-message): Use search-forward + instead of re-search-forward. + + * gnus-uu.el (gnus-uu-save-article): Ditto. + (gnus-uu-post-encode-uuencode): Ditto. + + * html2text.el (html2text-clean-list-items): Ditto. + (html2text-clean-dtdd): Ditto. + (html2text-format-tags): Ditto. + + * message.el (message-send-mail-with-sendmail): Fix regexp. + (message-fill-field-general): Use search-forward instead of + re-search-forward. + (unbold-region): Ditto. + + * nnrss.el (nnrss-request-article): Ditto. + + * nnslashdot.el (nnslashdot-request-article): Ditto. + + * nnweb.el (nnweb-gmane-wash-article): Ditto. + + * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the + "Unrecognized menu descriptor" error in XEmacs. + +2004-08-26 Stefan Wiens (tiny change) + + * gnus-sum.el (gnus-read-header): Don't remove a header for the + parent article of a sparse article in the thread hashtb. + +2004-08-26 David Hedbor (tiny change) + + * nnmail.el (nnmail-split-lowercase-expanded): New user option. + (nnmail-expand-newtext): Lowercase expanded entries if + nnmail-split-lowercase-expanded is non-nil. + +2004-08-26 Katsumi Yamaoka + + * nndoc.el (nndoc-type-alist): Fix regexp in the rfc822-forward + entry. + + * gnus-group.el (gnus-group-line-format-alist): Convert the value + of gnus-tmp-news-method into string under XEmacs. It will be + passed to gnus-correct-length which takes only a string argument. + +2004-08-24 Katsumi Yamaoka + + * gnus-util.el (gnus-bind-print-variables): New macro. + (gnus-prin1): Use it. + (gnus-prin1-to-string): Use it. + (gnus-pp): New function. + (gnus-pp-to-string): New function. + + * gnus-cus.el (gnus-agent-cat-prepare-category-field): Replace + pp-to-string with gnus-pp-to-string. + * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. + * gnus-group.el (gnus-group-make-kiboze-group): Ditto. + * gnus-msg.el (gnus-debug): Ditto. + * gnus-score.el (gnus-score-save): Ditto. + * gnus-spec.el (gnus-update-format): Replace pp-to-string with + gnus-pp-to-string. + * legacy-gnus-agent.el (gnus-agent-unlist-expire-days): Replace pp + with gnus-pp. + * score-mode.el (gnus-score-pretty-print): Ditto. + * webmail.el (webmail-debug): Ditto. + +2004-08-23 Katsumi Yamaoka + + * gnus-art.el (article-display-face, article-display-x-face): Use + buffer-read-only. + +2004-08-22 Katsumi Yamaoka + + * gnus-art.el (article-hide-list-identifiers): Bind + inhibit-read-only as t. + +2004-08-22 Reiner Steib + + * gnus-mlspl.el (gnus-group-split-update): Fix docstring. + +2004-08-22 Stefan Monnier + + * gnus-art.el: Use inhibit-read-only instead of buffer-read-only. + (gnus-narrow-to-page): Don't assume point-min == 1. + (gnus-article-edit-mode): Derive from message-mode. + + * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume + point-min == 1. + + * imap.el (imap-parse-address-list, imap-parse-body-ext): + Disable incorrect use of `assert'. + + * message.el (message-mode): Set comment-start-skip. + + +2004-08-22 Sam Steingold + + * pop3.el (pop3-leave-mail-on-server): New user variable. + (pop3-movemail): Delete mail only when it is nil. + +2004-08-21 Reiner Steib + + * nntp.el (nntp-marks-is-evil): Fix typo in docstring. + + * mml.el (mml-preview): Use `pop-to-buffer'. + + * message.el (message-goto-mail-followup-to): Insert after "To". + (message-carefully-insert-headers): Add comment. + + * gnus.el: Remove unused variable `gnus-article-check-size'. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. + + * gnus-art.el (gnus-button-alist): Improve + `gnus-button-handle-library' entry. + +2004-08-19 Sebastian Freundt (tiny change) + + * nnmaildir.el (nnmaildir--emlink-p, nnmaildir--enoent-p): Use + downcase, since XEmacs capitalizes error messages differently. + +2004-08-18 Jesper Harder + + * nntp.el: Add (require 'gnus) due to reference to + `gnus-directory'. Reported by Matt Swift . + +2004-08-18 Florian Weimer + + * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind + `mm-fill-flowed'. + + * mm-decode.el (mm-dissect-singlepart): Check it. + +2004-08-17 Teodor Zlatanov + + * nnimap.el (nnimap-open-connection): Add 'imaps' synonym to + 'imap' for netrc parsing. + +2004-08-16 Reiner Steib + + * mailcap.el (mailcap-mime-data): Mark as risky. + +2004-08-15 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Assume the close parenthesis + may be included in the encoded word. + (rfc2047-encode): Don't append a space if the encoded word + includes close parenthesis. + +2004-08-12 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-1, rfc2047-encode): Improve encoding + of text within parentheses. + +2004-08-06 Teodor Zlatanov + + * gnus-encrypt.el (gnus-encrypt-insert-file-contents) + (gnus-encrypt-write-file-contents): Make the password key the file + name PLUS the cipher, not just the cipher. Also remove failed + passwords from the cache. + +2004-08-06 Simon Josefsson + + * gnus-sum.el (gnus-article-loose-mime): Change default to t. Doc + fix. + +2004-08-05 Katsumi Yamaoka + + * rfc2047.el (rfc2047-fold-region): Use trailing whitespace as + LWSP. + +2004-08-04 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): Try + to append in-reply-to: data to the references: header. + + * netrc.el: Remove old encryption support, autoload gnus-encrypt.el + (netrc-parse): Use gnus-encrypt.el functions. + + * gnus-encrypt.el: Add new file for encryption support; currently + does only a few GPG ciphers and an internal XOR cipher. + + * password.el: Add comments on using password-read-and-add. + (password-read-and-add): Add function to read and add the + password to the cache at once. + +2004-07-28 Simon Josefsson + + * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign + parameter (but don't use it, for now). + + * imap.el (imap-ssl-open): Use imap-process-connection-type, + instead of hard coding to nil. + +2004-07-28 Katsumi Yamaoka + + * mm-view.el (mm-inline-image-emacs): Open lines under an image + as mm-inline-image-xemacs does. + +2004-07-26 Simon Josefsson + + * gnus-group.el (gnus-group-group-map, gnus-group-make-menu-bar): + Revert part of 2004-07-17 change below. + +2004-07-25 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Don't infloop. Suggested by + Hiroshi Fujishima . + +2004-07-25 Lars Magne Ingebrigtsen + + * flow-fill.el (fill-flowed): Remove space stuffing, and only do + quotes that actually start with ">" at the beginning of the + lines. + +2004-07-23 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Fix last change. + (rfc2047-encode-parameter): Remove useless concat. + +2004-07-22 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Check carefully whether to + encode special characters; fix some kind of misconfigured headers; + signal a real error if debug-on-quit or debug-on-error is non-nil. + (rfc2047-encode-max-chars): New variable. + (rfc2047-encode-1): Use it. + (rfc2047-encode-parameter): New function. + + * mml.el (mml-insert-parameter): Remove an excessive space. + +2004-07-17 Simon Josefsson + + * gnus-group.el (gnus-group-make-group-simple): Add, suggested by + Kai Grossjohann . + (gnus-group-group-map): Use it, instead of gnus-group-make-group. + (gnus-group-make-menu-bar): Ditto. + + * gnus-util.el (gnus-group-server): Add. + +2004-07-16 Jesper Harder + + * message.el (message-clone-locals): Clone sendmail and smtp + variables. + +2004-07-12 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Fix last change. + +2004-07-12 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Treat backslash-quoted + characters as non-special. + +2004-07-09 Simon Josefsson + + * gnus-agent.el (gnus-agent-synchronize-flags): Revert to ask. + Users will lose all flag changes made while unplugged with + e.g. nntp unless flag synchronization happens, thus `nil' is not a + good default. See numerous reports on ding mailing list. + +2004-07-09 Katsumi Yamaoka + + * nndoc.el (nndoc-type-alist): Improve regexp for article-begin, + add generate-head-function and generate-article-function to the + rfc822-forward entry. + (nndoc-rfc822-forward-generate-article): New function. + (nndoc-rfc822-forward-generate-head): New function. + + * mm-decode.el (mm-dissect-buffer): Simplify cleaning of CTE. + +2004-07-06 Dan Christensen + + * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded, + respect display group parameter and gnus-summary-expunge-below. + (gnus-articles-to-read): Remove unused reference to display group + parameter. + +2004-07-03 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-uniquify-message-id): New experimental + variable. + (nnheader-nov-read-message-id): Use it. + + * spam-report.el (spam-report-gmane): Add interactive. + +2004-07-02 Katsumi Yamaoka + + * mm-encode.el (mm-content-transfer-encoding-defaults): Use + qp-or-base64 for the application/* types. + +2004-07-02 Joakim Verona (tiny change) + + * nnrss.el (nnrss-read-group-data): Fix off-by-one error. + +2004-06-30 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-trim): Don't allow a negative + trim value. + +2004-01-25 Paul Jarc + + * nnmaildir.el (nnmaildir--condcase, nnmaildir--enoent-p): + New macro and function. + (nnmaildir--new-number, nnmaildir-request-set-mark): Use them. + +2004-06-29 Katsumi Yamaoka + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of + after-load-alist. + +2004-06-29 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-get-new-news-this-group): Don't + update info that isn't there. + +2004-06-29 Ilya N. Golubev . + + * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251 + entry. + +2004-06-29 Katsumi Yamaoka + + * mm-view.el (mm-inline-render-with-function): Use multibyte + buffer; decode html source by charset. + + * mm-encode.el (mm-content-transfer-encoding-defaults): Doc fix. + + * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when + Mule-UCS is loaded under XEmacs. + (mm-mime-mule-charset-alist): Avoid duplicated entries. + +2004-06-28 Jesper Harder + + * nnheader.el (nnheader-max-head-length): Increase to 8192. + +2004-06-28 Katsumi Yamaoka + + * mm-util.el (mm-coding-system-p): Return a coding-system. + (mm-mime-mule-charset-alist): Use shift_jis instead of + iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new + entries for the mime charsets iso-2022-jp-3 and shift_jis. + (mm-coding-system-priorities): Use shift_jis and iso-8859-1 + instead of japanese-shift-jis and iso-latin-1 respectively in + order to share the default value with both Emacs and XEmacs-mule. + (mm-mule-charset-to-mime-charset): Make + mm-coding-system-priorities effective. + (mm-sort-coding-systems-predicate): Canonicalize coding-systems + while predicating of candidates upon the priorities. + +2004-06-27 Jesper Harder + + * gnus-sum.el (gnus-summary-make-menu-bar): Add + gnus-uu-invert-processable. + + * gnus.el: Autoload gnus-uu-invert-processable. + +2004-06-24 Katsumi Yamaoka + + * mm-util.el (mm-with-multibyte-buffer): New macro. + + * rfc2047.el (rfc2047-encode-string): Use it. + (rfc2047-encode-region): Move point to the end of the region after + encoding. Suggested by IRIE Tetsuya . + +2004-06-23 Katsumi Yamaoka + + * gnus-cite.el (gnus-cite-parse): Don't ignore case when finding + ">From ". Thanks to Reiner Steib . + +2004-06-23 Katsumi Yamaoka + + * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. + (gnus-cite-parse): Ignore quoted envelope From_. Suggested by + Karl Chen . + +2004-06-23 Jesper Harder + + * message.el (message-idna-to-ascii-rhs-1): Don't choke on + invalid addresses. + +2004-06-21 Teodor Zlatanov + + * spam.el: Change section markers, revise TODO list. + (spam-backends): Make new master list of all installed backends. + (spam-summary-exit-behavior): Add new variable to determine how + messages moves are done at summary exit. + (spam-move-spam-nonspam-groups-only) + (spam-process-ham-in-nonham-groups) + (spam-process-ham-in-spam-groups): Remove variables, the + spam-summary-exit-behavior variable should be used to manage this + behavior. + (spam-old-ham-articles, spam-old-spam-articles): Remove. + (spam-old-articles): Add variable, replacing spam-old-ham-articles + and spam-old-spam-articles. + (spam-use-copy, spam-use-move, spam-use-gmane, spam-use-resend): + Add empty variables, placeholders for the backends they represent. + (spam-set-difference): Move, unchanged. + (spam-list-of-processors): Declare OBSOLETE, not used anymore + unless the user has a processor variable. + (spam-classifications, spam-classification-valid-p) + (spam-backend-properties, spam-backend-property-valid-p) + (spam-backend-function-type-valid-p) + (spam-process-type-valid-p, spam-list-articles): Add helper functions. + (spam-report-articles-gmane, spam-report-articles-resend): + Remove functions, they are not needed. + (spam-install-backend-super, spam-backend-list) + (spam-backend-check, spam-backend-valid-p, spam-backend-info) + (spam-backend-function, spam-backend-ham-registration-function) + (spam-backend-spam-registration-function) + (spam-backend-ham-unregistration-function) + (spam-backend-spam-unregistration-function) + (spam-backend-statistical-p, spam-backend-mover-p) + (spam-install-backend-alias, spam-install-checkonly-backend) + (spam-install-mover-backend, spam-install-nocheck-backend) + (spam-install-backend, spam-install-statistical-backend) + (spam-install-statistical-checkonly-backend): Add backend installation + support. + (spam-summary-prepare-exit): Rewrite to use the new backend code. + (spam-group-processor-p): Use the new backend code and respect the + summary exit behavior. + (spam-mark-spam-as-expired-and-move-routine): Remove. + (spam-summary-prepare): Change to use the new spam-old-articles + variable. + (spam-copy-or-move-routine, spam-copy-spam-routine) + (spam-move-spam-routine, spam-copy-ham-routine) + (spam-move-ham-routine): Add code to copy/move ham or spam. + (spam-fetch-field-fast): Improve doc and code, plus allow the + 'number request. + (spam-list-of-checks, spam-list-of-statistical-checks): Remove + variables. + (spam-split, spam-find-spam): Use the new backend code. + (spam-registration-functions): Remove variable. + (spam-unregister-routine): Add convenience wrapper. + (spam-log-undo-registration, spam-register-routine) + (spam-log-processing-to-registry) + (spam-log-unregistration-needed-p): Rename "check" to "backend" + where possible. + (spam-check-gmane-xref, spam-check-regex-headers) + (spam-check-blackholes, spam-check-stat, spam-check-ifile) + (spam-check-BBDB, spam-check-whitelist, spam-check-blacklist) + (spam-check-bogofilter-headers, spam-check-spamoracle) + (spam-check-spamassassin-headers, spam-check-bsfilter-headers) + (spam-check-crm114-headers): Use the spam-split-group that + spam-split prepares, no need to determine it every time. + + * nnimap.el (nnimap-retrieve-headers-progress): Add the message number + to the nnheader-parse-naked-head call. + + * nnheader.el (nnheader-generate-fake-message-id): Fix indentation. + + * gnus-sum.el (gnus-nov-parse-line): Add the message number to + the nnheader-nov-read-message-id call. + +2004-06-21 Katsumi Yamaoka + + * gnus-group.el (gnus-group-get-new-news-this-group): Don't call + gnus-activate-group twice. Suggested by Markus Peter + . + +2004-06-18 Katsumi Yamaoka + + * gnus-art.el (gnus-article-time-format): Exchange the order of + day and month in the default value; fix customization type. + (article-date-ut): Use add-text-properties. + (article-make-date-line): Use message-make-date instead of + current-time-string. + + * message.el (message-fetch-field): Don't use set-text-properties. + (message-make-date): Simplify. + +2004-06-17 Katsumi Yamaoka + + * rfc2047.el (rfc2047-syntax-table): Treat `(' and `)' as is. + (rfc2047-encode-region): Treat text within parentheses as special; + show the original text when error has occurred. + + * gnus-group.el (gnus-group-get-new-news-this-group): Pass the + already-computed method to gnus-activate-group. + + * gnus-start.el (gnus-make-hashtable-from-newsrc-alist): Make the + same select-methods identical Lisp objects. + + * gnus-srvr.el (gnus-server-set-info): Don't make a new Lisp + object when modifying the info. + +2004-06-16 Katsumi Yamaoka + + * gnus-srvr.el (gnus-server-set-info): Remove the server from + gnus-opened-servers since it has never been opened with the new + configuration yet. + +2004-06-15 Katsumi Yamaoka + + * nnheader.el (nnheader-nov-read-message-id): Pass the optional + arg to nnheader-generate-fake-message-id. + +2004-06-14 Teodor Zlatanov + + * nnheader.el (nnheader-generate-fake-message-id): Accept a + number and build a fake message ID localized to a group and + article number (so it's repeatable from that point on). + (nnheader-fake-message-id-p): Change regex to accomodate new fake + ID format. + + * gnus-sum.el (gnus-get-newsgroup-headers): Call + nnheader-generate-fake-message-id with the article number. + +2004-06-12 YAGI Tatsuya (tiny change) + + * gnus-art.el (gnus-article-next-page): Fix the way to find a real + end-of-buffer. + +2004-06-12 Lars Magne Ingebrigtsen + + * message.el (message-ignored-supersedes-headers): Add Approved. + +2004-06-11 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-message-header): Remove useless + goto-char. + (rfc2047-encode): Fold the line before encoding. + +2004-06-10 Lars Magne Ingebrigtsen + + * rfc2047.el (rfc2047-encode-message-header): Disabled header + folding -- not all headers can be folded, and this should be done + by the message composition mode. Probably. I think. + +2004-06-10 Katsumi Yamaoka + + * gnus-util.el (gnus-remove-text-with-property): Make it slightly + fast. + + * gnus-ems.el (gnus-remove-image): Don't use + message-text-with-property; remove only the image found first. + +2004-06-09 Jesper Harder + + * message.el (message-send-mail-with-sendmail): Use with-current-buffer. + +2004-06-09 Katsumi Yamaoka + + * message.el (message-text-with-property): Make it fast and accept + optional arguments. + (message-strip-forbidden-properties): Use it. + (message-fix-before-sending): Follow the m-t-w-p change. + + * gnus-ems.el (gnus-remove-image): Follow the m-t-w-p change. + +2004-06-08 Katsumi Yamaoka + + * gnus-art.el (article-hide-headers): Don't change the buffer + mistakenly when performing mml-preview even if + gnus-single-article-buffer is nil. + +2004-06-08 Kai Grossjohann + + * message.el (message-expand-name-databases): New user option. + (message-expand-name): Use it. + +2004-06-07 Teodor Zlatanov + + * spam.el (spam-report-articles-resend) + (spam-report-resend-register-routine): Allow ham reporting. + (spam-report-resend-register-ham-routine): Add wrapper. + (spam-registration-functions): Add ham resending functions. + (spam-list-of-processors): Add ham resend processor. + + * gnus.el (ham-resend-to): Add new group parameter. + (spam-process): Add ham resend option. + + * spam-report.el (spam-report-resend): Allow reporting ham. + (spam-report-resend-ham): Add wrapper. + +2004-06-06 Lars Magne Ingebrigtsen + + * message.el (message-cite-articles-with-x-no-archive): New + variable. + (message-cite-original): Use it. + +2004-06-04 Lars Magne Ingebrigtsen + + * message.el (message-cite-original): Respect X-No-Archive. + +2004-06-04 Katsumi Yamaoka + + * gnus-art.el (article-hide-headers): Refer to the values for + gnus-ignored-headers and gnus-visible-headers in the summary + buffer since a user may have set them as group parameters. + +2004-06-03 Teodor Zlatanov + + * assistant.el (assistant-node-name): Add convenience function. + (assistant-render-text, assistant-render-node): Add error handling, + plus handle multiple next nodes. + (assistant-find-next-node): Comment out for now. + (assistant-find-next-nodes): Add function, returns list of next + nodes. + +2004-06-02 Reiner Steib + + * mail-source.el (mail-source-directory): Fix doc-string. + +2004-05-29 Teodor Zlatanov + + * assistant.el (assistant-render-text, assistant-eval): Add :set + widget type, which is different because it takes and returns a + list. Much hilarity ensues. + +2004-05-28 Reiner Steib + + * gnus-art.el (gnus-button-alist): Fixed regexp for manual links. + + * gnus-group.el (gnus-group-get-new-news-this-group): Added + doc-string. + + * gnus-start.el (gnus-activate-group): Added doc-string. + +2004-05-28 Katsumi Yamaoka + + * mm-encode.el (mm-safer-encoding): Consider 7bit is safe. + +2004-05-27 Teodor Zlatanov + + * assistant.el (assistant-render-text): Try to add a :set + widget, more to come. + + * spam.el (spam-group-spam-contents-p): Handle empty groupname + strings. + (spam-report-articles-resend) + (spam-register-routine): Do registration iff any articles warrant + it. + (spam-summary-prepare-exit): Change log message for nil group + destinations. + +2004-05-27 Daniel Pittman + + * spam.el (spam-report-resend-register-routine): Allow + spam-report-resend-to to be a group parameter or a global value. + +2004-05-26 Simon Josefsson + + * starttls.el: Merge with my GNUTLS based starttls.el. + (starttls-gnutls-program, starttls-use-gnutls) + (starttls-extra-arguments, starttls-process-connection-type) + (starttls-connect, starttls-failure, starttls-success): New + variables. + (starttls-program, starttls-extra-args): Doc fix. + (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New + functions. + (starttls-negotiate, starttls-open-stream): Check + `starttls-use-gnutls' and pass on to corresponding *-gnutls + function if it is set. + +2004-05-27 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-region): Encode encoded words in + structured fields. + +2004-05-26 Katsumi Yamaoka + + * message.el (message-resend): Bind rfc2047-encode-encoded-words. + +2004-05-26 Teodor Zlatanov + + * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add + variable. + (spam-mark-junk-as-spam-routine): Use it. Allow to disable + assigning the spam-mark to new messages. + +2004-05-26 Adam Sj,Ax(Bgren (tiny change) + + (spam-ham-copy-or-move-routine): Don't declare `todo' twice. + +2004-05-26 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encodable-p): Don't move point. + (rfc2047-decode): Treat the ascii coding-system as raw-text by + default. + +2004-05-25 Anand Mitra (tiny change) + + * gnus-sum.el (gnus-summary-delete-article): invoke hook with + correct data. + +2004-05-24 Teodor Zlatanov + + * spam.el (spam-list-of-processors): Use nil for nonexistent processors. + (spam-group-processor-p): Fix function. + (spam-group-processor-multiple-p) + (spam-group-spam-processor-report-gmane-p) + (spam-group-spam-processor-report-resend-p) + (spam-group-spam-processor-bogofilter-p) + (spam-group-spam-processor-blacklist-p) + (spam-group-spam-processor-ifile-p) + (spam-group-ham-processor-ifile-p) + (spam-group-spam-processor-spamoracle-p) + (spam-group-spam-processor-crm114-p) + (spam-group-ham-processor-bogofilter-p) + (spam-group-spam-processor-stat-p) + (spam-group-ham-processor-stat-p) + (spam-group-ham-processor-whitelist-p) + (spam-group-ham-processor-BBDB-p) + (spam-group-ham-processor-spamoracle-p) + (spam-group-ham-processor-copy-p): Remove functions with some + prejudice against unneeded code. + (spam-report-articles-resend) + (spam-report-resend-register-routine): Allow the group/topic + spam-resend-to value to override spam-report-resend-to. + (spam-summary-prepare-exit): Invoke spam-group-processor-p + properly now. + + * gnus.el (spam-resend-to): Add group/topic parameter. + (spam-process): Move the OBSOLETE processors to the end of the + choices. + +2004-05-24 Daniel Pittman + + * spam-report.el (spam-report-resend-to, spam-report-resend): Start + with resend-to set to nil, and then ask the user if necessary. + (spam-report-resend): spam-report-resend takes a list of articles, not + separate article numbers. + +2004-05-23 Katsumi Yamaoka + + * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in + addition to emacs-w3m. + +2004-05-23 Lars Magne Ingebrigtsen + + * assistant.el (assistant-authinfo-data): New function. + (assistant-eval): Eval for entire assistant. + + * netrc.el (netrc-services-file): New variable. + (netrc-parse-services): New function. + (netrc-find-service-name): New function. + (netrc-find-service-number): New function. + (netrc-port-equal): New function. + (netrc-machine): Use it. + + * nnimap.el (nnimap-open-connection): Use netrc. + + * gnus-util.el (gnus-netrc-get): Remove aliases. + + * gnus-sum.el (gnus-auto-center-summary): Change default to 2. + + * assistant.el (wid-edit): Fix compilation. + + * gnus-util.el (gnus-set-file-modes): Just ignore errors. + +2004-05-23 Paul Stodghill + + * gnus-util.el (gnus-set-file-modes): New function. (small + patch). + +2004-05-23 Lars Magne Ingebrigtsen + + * gnus-topic.el (gnus-topic-jump-to-topic): Goto missing topic. + + * assistant.el (assistant-render-node): Fix up rendering and + read-only text. + (assistant-render-node): Reset. + (assistant-make-read-only): Not sticky. + +2004-05-20 Danny Siu + + * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto + centered even when gnus-auto-center-summary is t + +2004-05-22 Lars Magne Ingebrigtsen + + * dns.el (dns-get-txt-answer): New function. + (dns-read-txt): Ditto. + (query-dns): Use it. + +2004-05-21 Katsumi Yamaoka + + * gnus-start.el (gnus-get-unread-articles): Don't invalidate + active for foreign groups even if the group level is higher than + the specified value. + +2004-05-21 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-group-jump-to-group): Don't prompt for + non-active groups. + + * gnus-art.el (gnus-picon-databases): Add /usr/share/picons. + +2004-05-20 Magnus Henoch + + * dns.el (dns-read-type): Add support for SVR. (small patch) + +2004-05-20 Teodor Zlatanov + + * spam.el (spam-use-crm114, spam-crm114, spam-crm114-program) + (spam-crm114-header, spam-crm114-spam-switch) + (spam-crm114-spam-strong-switch, spam-crm114-ham-strong-switch) + (spam-crm114-positive-spam-header) + (spam-crm114-database-directory, spam-list-of-processors) + (spam-group-spam-processor-crm114-p) + (spam-group-ham-processor-crm114-p, spam-extra-header-to-number) + (spam-generic-score, spam-list-of-checks) + (spam-list-of-statistical-checks, spam-registration-functions) + (spam-check-crm114-headers, spam-crm114-score) + (spam-check-crm114, spam-crm114-register-with-crm114) + (spam-crm114-register-spam-routine) + (spam-crm114-unregister-spam-routine) + (spam-crm114-register-ham-routine) + (spam-crm114-unregister-ham-routine): Add CRM114 support. From + asjo@koldfront.dk (Adam Sj,Ax(Bgren). + + * gnus.el: Add spam-use-crm114. + + * spam.el (spam-list-of-processors, spam-registration-functions): + Add spam-use-resend. + (spam-group-spam-processor-report-resend-p): Add utility wrapper. + (spam-report-articles-gmane): Add doc fix. + (spam-report-articles-resend, + spam-report-resend-register-routine): Add wrappers around + spam-report-resend-to. + + * spam-report.el (spam-report-resend-to, spam-report-resend): + Add support for resending spam. + (spam-report-gmane): Fix line length >80. + + * gnus.el (spam-process): Add spam-use-resend. + +2004-05-20 TSUCHIYA Masatoshi + + * spam.el (spam-mark-spam-as-expired-and-move-routine): Return the + number of processed spam messages. + (spam-ham-copy-or-move-routine): Return the number of processed + ham messages. + (spam-summary-prepare-exit): Use the above values to decide + whether status messages shouled be displayed. + +2004-05-20 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encode-function-alist): Renamed from + `rfc2047-encoding-function-alist' in order to avoid conflicting + with the old version. + (rfc2047-encode-region): Concatenate words containing non-ASCII + characters in structured fields; don't encode space-delimited + ASCII words even in unstructured fields; don't break words at + char-category boundaries. + (rfc2047-encode-1): New function. + (rfc2047-encode): Use it; encode text so that it occupies the + maximum width within 76-column; work correctly on Q encoding for + iso-2022-* charsets. + (rfc2047-fold-region): Use existing whitespace for LWSP; make it + sure not to break a line just after the header name. + (rfc2047-b-encode-region): Removed. + (rfc2047-b-encode-string): New function. + (rfc2047-q-encode-region): Removed. + (rfc2047-q-encode-string): New function. + + * mm-util.el (mm-replace-in-string): New function. + +2004-05-20 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-make-draft-meta-information): Really + get it right. + (gnus-inews-make-draft): Really. + +2004-05-19 Ben Menasha + + * nnmh.el (nnmh-request-list-1): Don't check the link count + before descending. (small patch) + 2004-05-19 Lars Magne Ingebrigtsen - * pgg-pgp.el (pgg-pgp-verify-region): Clean up. - -2004-05-19 Michael Schierl (tiny change) - - * pgg-pgp.el (pgg-pgp-verify-region): Default when signature - isn't a string. + * gnus-msg.el (gnus-inews-make-draft-meta-information): Fix quote + stuff. + + * gnus-start.el (gnus-subscribe-hierarchical-interactive): Match + on real group name. + + * gnus-art.el (gnus-signature-limit): Doc fix. + + * gnus-msg.el (gnus-inews-make-draft): Quote list. + +2004-05-19 Lars Magne Ingebrigtsen + + * gnus-draft.el (gnus-draft-send): Bind + rfc2047-encode-encoded-words. + + * rfc2047.el (rfc2047-encode-region): Encode =? strings. + (rfc2047-encodable-p): Say that =? needs encoding. + (rfc2047-encode-encoded-words): New variable. + + * gnus-group.el (gnus-group-select-group): Doc fix. + + * gnus-draft.el (gnus-draft-setup): Mark all replied as replied. + + * gnus-group.el (gnus-group-mode): Set show-trailing-whitespace + to nil. + + * gnus-cache.el (gnus-cache-possibly-enter-article): Use it. + + * nnheader.el (nnheader-get-lines-and-char): New function. + +2004-05-19 Reiner Steib + + * gnus-msg.el (gnus-summary-followup-with-original): Document + yanking of region when active. + +2004-05-19 Katsumi Yamaoka + + * gnus-start.el (gnus-get-unread-articles): Do nothing for foreign + groups if the group level is higher than the specified value. + +2004-05-18 Reiner Steib + + * gnus-group.el (gnus-group-jump-to-group-prompt): Allow an alist. + (gnus-group-jump-to-group): Added prefix argument using + `gnus-group-jump-to-group-prompt'. Query before jumping to + non-active group. + + * compface.el (uncompface): Be verbose when changing + `uncompface-use-external'. + + * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to + handle manual section. + +2004-05-18 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-alist): Revert previous change. + +2004-05-18 Reiner Steib + + * message.el (message-idna-to-ascii-rhs-1): Fix typo. + +2004-05-18 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-inews-do-gcc): Don't use read-only-p to see + whether backend can accept message. + + * message.el (message-idna-to-ascii-rhs-1): Don't use equalp. + +2004-05-18 Kai Grossjohann + + * nntp.el (nntp-request-set-mark, nntp-request-update-info): + Avoid creating directory when nntp-marks-is-evil is true. + Reported by Reiner Steib. + +2004-05-18 Reiner Steib + + * gnus-picon.el (gnus-picon-style): New variable. + (gnus-picon-insert-glyph): Added optional `nostring' argument. + (gnus-picon-transform-address): Support `gnus-picon-style'. From + Jesper Harder . + +2004-05-18 Lars Magne Ingebrigtsen + + * message.el (message-fill-field): Return point. + (message-generate-headers): Go to end of field. + + * gnus-start.el (gnus-get-unread-articles-in-group): Don't do + stuff for non-living groups. + +2004-05-18 Jesper Harder + + * gnus-art.el (gnus-article-followup-with-original) + (gnus-article-reply-with-original): gnus-mark-active-p -> + gnus-region-active-p. + +2004-05-17 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Fix messages, so they show + only when there is spam or ham to be processed. + +2004-05-17 Lars Magne Ingebrigtsen + + * mail-source.el (mail-source-delete-crash-box): Refactor. + (mail-source-fetch): Use it. + (mail-source-fetch-file): Ditto. + (mail-source-fetch-directory): Run postscript in loop. + (mail-source-fetch-pop): Delete. + (mail-source-fetch-maildir): Ditto. + (mail-source-fetch-imap): Ditto. + + * imap.el (imap-authenticators): Comment out sasl. + + * message.el (message-skip-to-next-address): New function. + (message-fill-header-address): Refactor. + (message-fill-address): Use it. + (message-delete-address): Use it. + (message-fill-header-general): Refactor. + (message-fill-field-address): Rename. + (message-narrow-to-field): Find the start of the header. + (message-header-format-alist): Don't pre-fill. + (message-fill-header): Removed. + (message-insert-header): New function. + (message-shorten-references): Use it. + + * rfc2047.el (rfc2047-field-value): Strip props. + + * mail-parse.el (mail-header-make-address): New alias. + + * ietf-drums.el (ietf-drums-make-address): New function. + + * imap.el: Add compiler directives. + + * gnus-score.el (gnus-score-edit-done): run-hook->run-hooks. + + * gnus-art.el (article-decode-idna-rhs): Don't use + message-idna-inside-rhs-p. + +2004-05-16 Lars Magne Ingebrigtsen + + * message.el (message-idna-inside-rhs-p): Removed. + (message-idna-to-ascii-rhs-1): Use proper address parsing. + + * gnus-art.el (gnus-emphasis-alist): Removed strikethru; too many + false positives. + +2004-05-16 Kim Minh Kaplan + + * imap.el (imap-sasl-make-mechanisms): Use sasl. + +2004-05-16 Lars Magne Ingebrigtsen + + * nneething.el (nneething-file-name): Don't create spurions + files. + + * gnus-msg.el (gnus-inews-do-gcc): Ignore read-only groups. + (gnus-inews-do-gcc): Remove sleep. + + * gnus-art.el (gnus-mime-delete-part): Error message when no MIME + part under point. + + * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. + (gnus-agent-regenerate-group): Using nil messages aren't valid. + +2004-05-15 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Fixed (length). + +2004-05-14 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Fix to produce "marking spam + as expired without moving it" message when there are spam + messages left. + +2004-05-14 Nelson Ferreira (tiny change) + + * gnus-dup.el (gnus-dup-unsuppress-article): don't assume the mail + header is not nil. + +2004-05-14 Kai Grossjohann + + * nntp.el (nntp-request-set-mark, nntp-request-update-info): Call + nntp-possibly-create-directory, not nntp-possibly-change-group. + (nntp-marks-changed-p): New arg SERVER. + (nntp-request-update-info): Adjust caller. + +2004-05-14 Kai Grossjohann + + * nntp.el (nntp-save-marks): Pass missing arg. + +2004-05-13 Kai Grossjohann + + * nntp.el: Support marks. + (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks) + (nntp-marks-modtime, nntp-marks-directory): New variables. + (nntp-request-set-mark, nntp-request-update-info) + (nntp-possibly-create-directory, nntp-marks-changed-p) + (nntp-save-marks, nntp-open-marks, nntp-marks-directory): New + functions. + +2004-05-12 Jesper Harder + + * gnus-score.el (gnus-score-insert-help): Use + gnus-select-lowest-window. + + * gnus-ems.el (gnus-select-lowest-window): Copy definition of + appt-select-lowest-window and rename to gnus-select-lowest-window. + + * gnus.el: do. + +2004-05-12 TSUCHIYA Masatoshi + + * rfc2047.el (rfc2047-encode): Use uppercase letters to specify + encodings of MIME-encoded words, in order to improve + interoperability with several broken MUAs. + +2004-05-07 TSUCHIYA Masatoshi + + * mm-view.el (mm-inline-text-html-render-with-w3): Check META + tags, only when charsets are not specified in headers. + (mm-inline-text-html-render-with-w3m): Ditto. + +2004-05-06 TSUCHIYA Masatoshi + + * gnus-art.el (article-strip-banner): Use MIME-encoded from fields + instead of MIME-decoded from fields when checking + `gnus-article-address-banner-alist'. + +2004-05-03 Jesper Harder + + * nnrss.el (nnrss-check-group, nnrss-read-group-data): Hash on + description rather than subject. + +2004-05-01 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + +2004-05-01 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.2 is released. + +2004-05-01 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-read-agentview): Inline + gnus-uncompress-range. + +2004-05-01 TSUCHIYA Masatoshi + + * spam.el (spam-bsfilter-path): Use `executable-find' instead of + `exec-installed-p'. + +2004-04-30 TSUCHIYA Masatoshi + + * gnus.el (spam-process, spam-autodetect-methods): Add + bsfilter and bsfilter-headers. + + * spam.el (spam-bsfilter): New customize group. + (spam-use-bsfilter, spam-use-bsfilter-headers, spam-bsfilter-path) + (spam-bsfilter-header, spam-bsfilter-probability-header) + (spam-bsfilter-spam-switch, spam-bsfilter-ham-switch) + (spam-bsfilter-spam-strong-switch, spam-bsfilter-ham-strong-switch) + (spam-bsfilter-database-directory): New options. + (spam-install-hooks, spam-list-of-processors, spam-list-of-checks) + (spam-list-of-statistical-checks, spam-registration-functions): + Add `spam-use-bsfilter' and `spam-use-bsfilter-headers'. + (spam-bsfilter-score): New command. + (spam-check-bsfilter-headers, spam-check-bsfilter) + (spam-bsfilter-register-with-bsfilter) + (spam-bsfilter-register-spam-routine) + (spam-bsfilter-unregister-spam-routine) + (spam-bsfilter-register-ham-routine) + (spam-bsfilter-unregister-ham-routine): New functions. + (spam-generic-score): Support bsfilter; Accept an optional argument + to recalcurate spam score even if scoring header has already been + added. + (spam-bogofilter-score, spam-spamassassin-score): Accept an + optional argument to recalcurate spam score even if scoring header + has already been added. + +2004-04-29 Jesper Harder + + * nnrss.el (nnrss-get-namespace-prefix): Use string= to compare + strings! Reported by David D. Smith . + (nnrss-check-group, nnrss-read-group-data): Hash on Subject if + link is missing. + +2004-04-28 Jesper Harder + + * html2text.el (html2text-replace-list): Add & and '. + (html2text-get-attr): Rewrite. + + * message.el (message-setup-1): Remove redundant put-text-property + on mail-header-separator. + +2004-04-27 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-cache-whitespace) + (gnus-registry-action, gnus-registry-spool-action) + (gnus-registry-split-fancy-with-parent): Change message levels + from 5 to 3 or 7, as needed. + + * spam.el (spam-summary-prepare-exit) + (spam-mark-junk-as-spam-routine, spam-fetch-field-fast) + (spam-split, spam-find-spam, spam-log-undo-registration) + (spam-check-blackholes, spam-enter-ham-BBDB): Changed message + level from 5 to 6. + +2004-04-26 Katsumi Yamaoka + + * gnus-ems.el: Autoload appt-select-lowest-window (revert + 2004-03-04 change). + +2004-04-25 Jesper Harder + + * spam-stat.el (spam-stat-score-buffer): Simplify mapcar usage. + Use mapc when appropriate. + + * sieve-manage.el (sieve-manage-open): do. + + * nnweb.el (nnweb-insert-html): do. + + * nnvirtual.el (nnvirtual-catchup-group, nnvirtual-partition-sequence) + (nnvirtual-partition-sequence, nnvirtual-create-mapping): do. + + * nnspool.el (nnspool-request-group): do. + + * nnrss.el (nnrss-opml-export, nnrss-find-el, nnrss-order-hrefs): + do. + + * nnml.el (nnml-request-update-info): do. + + * nnmh.el (nnmh-request-group, nnmh-request-list-1, nnmh-active-number) + (nnmh-request-create-group, nnmh-update-gnus-unreads): do. + + * nnimap.el (nnimap-request-close, nnimap-acl-edit) + (nnimap-request-set-mark): do. + + * nnfolder.el (nnfolder-request-update-info): do. + + * mm-view.el (mm-pkcs7-signed-magic, mm-pkcs7-enveloped-magic): + do. + + * mml.el (mml-destroy-buffers, mml-compute-boundary-1): do. + + * gnus-uu.el (gnus-uu-find-articles-matching): do. + + * gnus-topic.el (gnus-topic-check-topology, gnus-topic-remove-group): + do. + + * gnus-sum.el (gnus-summary-fetch-faq, gnus-read-move-group-name): + do. + + * gnus-score.el (gnus-score-load-file, gnus-sort-score-files): do. + + * gnus-nocem.el (gnus-nocem-scan-groups): do. + + * gnus-int.el (gnus-start-news-server): do. + + * gnus-group.el (gnus-group-make-kiboze-group) + (gnus-group-browse-foreign-server): do. + +2004-04-22 Teodor Zlatanov + + FIXME: Make separate entries for each person. + + From Dan Christensen , asjo@koldfront.dk (Adam + Sj,Ax(Bgren), Wes Hardaker , and Michael Shields + : + + * spam.el (spam-necessary-extra-headers): Get the extra headers we + may need for spam sorting and scoring. + (spam-user-format-function-S): Add user format function suitable for + general use. + (spam-article-sort-by-spam-status): Add sorting function for summary + sorting. + (spam-extra-header-to-number): Add function to get a score from a + header. + (spam-summary-score): Add function to get a numeric score from the + headers. + (spam-generic-score): Fixed function doc, was in wrong place. + (spam-initialize): Take symbols when it's run, and install the + extra headers that spam-necessary-extra-headers thinks we need. + +2004-04-21 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Add logic and message fix. + Reported by bojohan+news@dd.chalmers.se (Johan Bockg,Ae(Brd). + +2004-04-17 Jesper Harder + + * gnus-sum.el (gnus-set-global-variables) + (gnus-build-all-threads, gnus-get-newsgroup-headers) + (gnus-article-get-xrefs, gnus-summary-best-group) + (gnus-summary-next-article, gnus-summary-enter-digest-group) + (gnus-summary-set-bookmark, gnus-offer-save-summaries) + (gnus-summary-update-info, gnus-kill-or-deaden-summary): Use + with-current-buffer. + +2004-04-16 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Simplify logic. + (spam-fetch-article-header): Read the article header if it's not + available. + (spam-list-articles): Simplify logic. + (spam-filelist-register-routine): Fix bug with unregister-list. + + * gnus-registry.el: Fix comments at beginning. + +2004-04-16 Jesper Harder + + * message.el (message-cater-to-broken-inn): Remove. + (message-shorten-references): Make sure the total folded length of + References is shorter than 998 characters to cater to a bug in INN + 2.3. Also, don't pretend that references aren't folded -- this + hasn't worked for a while. + +2004-04-15 Kevin Greiner + + * gnus-agent.el (gnus-agentize): + gnus-agent-send-mail-real-function no longer set to current value + of message-send-mail-function but rather a lambda that calls + message-send-mail-function. The change makes the agent real-time + responsive to user changes to message-send-mail-function. + +2004-04-15 Kevin Greiner + + * legacy-gnus-agent.el + (gnus-agent-convert-to-compressed-agentview): Fixed typos with + help from Florian Weimer + +2004-04-15 Katsumi Yamaoka + + * nnmail.el (nnmail-cache-insert): Revert last change. + +2004-04-14 Katsumi Yamaoka + + * nnmail.el (nnmail-cache-insert): Always check whether + nnmail-cache-ignore-groups matches a group name. + +2004-04-13 Teodor Zlatanov + + * spam.el (spam-fetch-field-fast, spam-generate-fake-headers) + (spam-find-spam, spam-log-processing-to-registry) + (spam-log-registered-p, spam-log-unregistration-needed-p) + (spam-log-undo-registration): Use gnus-message instead of + gnus-error, none of these errors are fatal. + + * gnus-registry.el (gnus-registry-clean-empty-function) + (gnus-registry-clean-empty): Remove only empty entries without + extra data. + +2004-04-12 Teodor Zlatanov + + * spam-stat.el (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-change-to-non-spam): Change (error) to + (gnus-message 8) invocation. + +2004-04-12 Katsumi Yamaoka + + * nntp.el (nntp-via-netcat-command): New variable. + (nntp-via-netcat-switches): New variable. + (nntp-open-via-rlogin-and-netcat): New function. + (nntp-open-connection-function): Doc fix. + (nntp-telnet-command): Doc fix. + (nntp-end-of-line): Doc fix. + (nntp-via-rlogin-command): Doc fix. + (nntp-via-user-name): Doc fix. + (nntp-via-address): Doc fix. + +2004-04-09 Katsumi Yamaoka + + * mml2015.el (mml2015-use): Avoid the "Recursive load suspected" + error in Emacs 21.1. + +2004-04-08 Reiner Steib + + * gnus-start.el (gnus-get-unread-articles): Fix last commit. + +2004-04-07 Kevin Greiner + * gnus-agent.el (gnus-agent-total-fetched-hashtb): New variable. + (gnus-agent-with-refreshed-group): New macro. + (gnus-agent-rename-group): New function. + (gnus-agent-delete-group): New function. + (gnus-agent-save-group-info): Use gnus-command-method when + `method' parameter is nil. Don't write nil entries into the + active file. + (gnus-agent-get-group-info): New function. + (gnus-agent-fetch-articles): Use + gnus-agent-update-files-total-fetched-for to increment disk space + used. + (gnus-agent-fetch-headers, gnus-agent-save-alist): Use + gnus-agent-update-view-total-fetched-for to increment disk space + used. + (gnus-agent-get-local): Added optional parameters to avoid calling + gnus-group-real-name and gnus-find-method-for-group. + (gnus-agent-set-local): Delete stored entry if either min, or max, + are nil. + (gnus-agent-fetch-session): Reworded error/quit messages. On + quit, use gnus-agent-regenerate-group to record existance of any + articles fetched to disk before the quit occurred. + (gnus-agent-expire-group-1): Use gnus-agent-with-refreshed-group, + gnus-agent-update-view-total-fetched-for, and + gnus-agent-update-files-total-fetched-for to decrement disk space + used. + (gnus-agent-retrieve-headers): Use + gnus-agent-update-view-total-fetched-for to increment disk space + used. + (gnus-agent-regenerate-group): Replace gnus-group-update-group + with gnus-agent-update-files-total-fetched-for to decrement disk + space and fresh group buffer. + (gnus-agent-inhibit-update-total-fetched-for): New variable. + (gnus-agent-need-update-total-fetched-for): New variable. + (gnus-agent-update-files-total-fetched-for): New function. + (gnus-agent-update-view-total-fetched-for): New function. + (gnus-agent-total-fetched-for): New function. + + * gnus-cache.el (gnus-cache-save-buffers): Use + gnus-cache-update-overview-total-fetched-for to change disk space + used by this group. + (gnus-cache-possibly-enter-article): Use + gnus-cache-update-file-total-fetched-for to increment disk space + used by this group. + (gnus-cache-possibly-remove-article): Use + gnus-cache-update-file-total-fetched-for to decrement disk space + used by this group. + (gnus-cache-generate-nov-databases): Purge total fetched cache. + (gnus-cache-rename-group): New function. + (gnus-cache-delete-group): New function. + (gnus-cache-inhibit-update-total-fetched-for): New variable. + (gnus-cache-need-update-total-fetched-for): New variable. + (gnus-cache-with-refreshed-group): New macro. + (gnus-cache-update-file-total-fetched-for): New function. + (gnus-cache-update-overview-total-fetched-for): New function. + (gnus-cache-rename-group-total-fetched-for): New function. + (gnus-cache-delete-group-total-fetched-for): New function. + (gnus-cache-total-fetched-for): New function. + + * gnus-group.el: Require gnus-sum and autoload functions to + resolve warnings when gnus-group.el compiled alone. + (gnus-group-line-format): Documented new %F + (size of Fetched data) group line format; identifies disk space + used by agent and cache. + (gnus-group-line-format-alist): Defined new F format. + (gnus-total-fetched-for): New function. + (gnus-group-delete-group): No longer update + gnus-cache-active-altered as gnus-request-delete-group now keeps + the cache in sync. + (gnus-group-list-active): Let the agent store a server's active + list if currently plugged. + + * gnus-int.el (gnus-request-delete-group): Use + gnus-cache-delete-group and gnus-agent-delete-group to keep the + local disk in sync with the server. + (gnus-request-rename-group): Use + gnus-cache-rename-group and gnus-agent-rename-group to keep the + local disk in sync with the server. + + * gnus-start.el (gnus-get-unread-articles): Cosmetic + simplification to logic. + + * gnus-util.el (gnus-rename-file): New function. + +2004-04-07 Christian Neukirchen (tiny change) + + * mm-util.el (mm-image-load-path): Handle nil in load-path. + +2004-04-07 Jesper Harder + + * rfc2047.el (rfc2047-encoded-word-regexp): Remove unnecessary + '+'. Reported by Stefan Wiens . + +2004-04-06 Jesper Harder + + * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is + alive. Reported by Laurent Martelli . + +2004-04-03 Jesper Harder + + * gnus.el (gnus-getenv-nntpserver): Strip whitespace. + +2004-04-02 Teodor Zlatanov + + * spam.el (spam-set-difference): Add function to replace + gnus-set-difference in spam.el. + (spam-summary-prepare-exit): Use spam-set-difference. + +2004-03-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-cache-file): Update to use + gnus-dribble-directory OR gnus-home-directory OR ~. + (gnus-registry-split-fancy-with-parent): Fix doc. + +2004-03-27 Katsumi Yamaoka + + * message.el (message-exchange-point-and-mark): Use + message-mark-active-p. Suggested by Jesper Harder + . + +2004-03-26 Katsumi Yamaoka + + * message.el (message-exchange-point-and-mark): Don't activate + region if it was inactive. Suggested by Hiroshi Fujishima + . + +2004-03-25 Katsumi Yamaoka + + * gnus-art.el (article-display-face): Display Faces in the same + order as X-Faces. + +2004-03-24 Katsumi Yamaoka + + * nndoc.el (nndoc-forward-type-p): Recognize envelope From_. + +2004-03-23 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-recompute-hierarchical-structure): Remove. + (gnus-mime-multipart-functions): Revert 2004-03-19 change. + (gnus-article-mime-hierarchy): Remove. + (gnus-article-mime-hierarchy-next): Remove. + (gnus-article-mode): Revert 2004-03-19 change. + (gnus-article-setup-buffer): Revert 2004-03-19 change. + (gnus-insert-mime-button): Revert 2004-03-19 change. + (gnus-mime-accumulate-hierarchy): Remove. + (gnus-mime-enter-multipart): Remove. + (gnus-mime-leave-multipart): Remove, + (gnus-mime-display-part): Revert 2004-03-19 change. + (gnus-mime-display-alternative): Revert 2004-03-19 change. + + * mml.el (mml-preview): Revert 2004-03-19 change. + +2004-03-18 Helmut Waitzmann (tiny change) + + * gnus-sum.el (gnus-newsgroup-variables): Doc fix. + +2004-03-22 Katsumi Yamaoka + + * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to + t while entering a file name using the mm-with-multibyte macro. + Suggested by Hiroshi Fujishima . + + * mm-util.el (mm-with-multibyte): New macro. + +2004-03-19 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-recompute-hierarchical-structure): New + user option. + (gnus-mime-multipart-functions): Doc and customization fix. + (gnus-article-mime-hierarchy): New variable. + (gnus-article-mime-hierarchy-next): New variable. + (gnus-article-mode): Make gnus-article-mime-hierarchy buffer-local. + (gnus-article-setup-buffer): Set gnus-article-mime-hierarchy and + gnus-article-mime-hierarchy-next to nil. + (gnus-insert-mime-button): Show hierarchy numbers. + (gnus-mime-accumulate-hierarchy): New function. + (gnus-mime-enter-multipart): New function. + (gnus-mime-leave-multipart): New function. + (gnus-mime-display-part): Recompute hierarchical MIME structure. + (gnus-mime-display-alternative): Show hierarchy numbers. + + * mml.el (mml-preview): Set gnus-article-mime-hierarchy and + gnus-article-mime-hierarchy-next to nil. + +2004-03-19 Steve Youngs + + * dns.el: Don't require gnus-xmas. + +2004-03-17 Jesper Harder + + * mml.el (mml-generate-mime-1): Don't use format=flowed with + inline PGP. + (mml-menu): Disable mml-quote-region if mark is inactive. + +2004-03-17 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-regenerate-group): Activate the group + when the group's active is not available. + +2004-03-15 Katsumi Yamaoka + + * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to + error. + +2004-03-12 Reiner Steib + + * imap.el (imap-store-password): New variable. + (imap-interactive-login): Use it. + Suggested by Mark Plaksin . + +2004-03-12 Katsumi Yamaoka + + * gnus-art.el (gnus-article-read-summary-keys): Restore new + window-start and hscroll to summary window. + +2004-03-12 Kevin Greiner + + * gnus-start.el (gnus-convert-old-newsrc): Only write the + conversion message to newsrc-dribble when an actual conversion is + performed. + +2004-03-10 Malcolm Purvis (tiny change) + + * spam-stat.el (spam-stat-coding-system): Use mm-coding-system-p. + +2004-03-10 Katsumi Yamaoka + + * mm-decode.el (mm-complicated-handles): New function reviving + former definition of mm-multiple-handles. + + * gnus-art.el (gnus-mime-save-part-and-strip): Use it. + (gnus-mime-delete-part): Use it. + +2004-03-09 Kevin Greiner + + * gnus-agent.el (gnus-agent-read-local): Bind + nnheader-file-coding-system to gnus-agent-file-coding-system to + avoid the implicit assumption that they will always be equal. + (gnus-agent-save-local): Bind buffer-file-coding-system, not + coding-system-for-write, as the with-temp-file macro first prints + to a buffer then saves the buffer. + +2004-03-09 Katsumi Yamaoka + + * gnus-art.el (gnus-article-edit-part): New function. + (gnus-mime-save-part-and-strip): Use it; do query instead of + signaling an error; don't use mm-multiple-handles. + (gnus-mime-delete-part): Ditto. + +2004-03-08 Kevin Greiner + + * gnus-agent.el (gnus-agent-read-agentview): Removed support for + old file versions. + (gnus-group-prepare-hook): Removed function that converted list + form of gnus-agent-expire-days to group properties. + + * gnus-int.el: Autoload gnus-agent-regenerate-group. + (gnus-request-accept-article): Re-indented. + + * gnus-start.el (gnus-convert-old-newsrc): Registered new + converters to handle old agent file formats. Added logic for a + "backup before upgrading warning". + (gnus-convert-mark-converter-prompt): Developers can mark + functions as needing (default), or not needing, + gnus-convert-old-newsrc's "backup before upgrading warning". + (gnus-convert-converter-needs-prompt): Tests whether the user + should be protected from potentially irreversable changes by the + function. + + * legacy-gnus-agent.el (): New. Provides converters that are only + loaded when gnus-convert-old-newsrc needs to call them. + +2004-03-08 Katsumi Yamaoka + + * mail-source.el (mail-source-touch-pop): Doc fix. + + * message.el (message-smtpmail-send-it): Doc fix. 2004-03-05 Jesper Harder * sha1-el.el (sha1-maximum-internal-length): Doc fix. + * nnmail.el (nnmail-split-fancy): do. + + * gnus-kill.el (gnus-kill, gnus-execute): do. + +2004-03-05 Per Abrahamsen + + * gnus-sum.el (gnus-widget-reversible-match) + (gnus-widget-reversible-to-internal) + (gnus-widget-reversible-to-external): New functions. + (gnus-widget-reversible): New widget. + (gnus-article-sort-functions, gnus-thread-sort-functions): Use it. + +2004-03-05 Kai Grossjohann + + * gnus-sum.el (gnus-thread-sort-functions) + (gnus-article-sort-functions): Document `(not F)' items. + +2004-03-04 Teodor Zlatanov + + * spam.el (spam-use-gmane-xref): Add new backend. + (spam-gmane-xref-spam-group): Add variable to control the name of the + Gmane spam group. + (spam-blackhole-servers, spam-blackhole-good-server-regex) + (spam-regex-headers-spam, spam-regex-headers-ham) + (spam-regex-body-spam, spam-regex-body-ham): Clarify docs. + (spam-list-of-checks): Add spam-use-gmane-xref to list of + backends and checks. + (spam-check-gmane-xref): Add function for spam-use-gmane-xref. + + * gnus.el (spam-autodetect-methods): Add spam-use-gmane-xref as + an autodetect method. + +2004-03-04 Kevin Greiner + + * gnus-int.el (gnus-request-accept-article): Inform the agent that + articles are being added to a group. + (gnus-request-replace-article): Inform the agent that articles + need to be uncached as the cached contents are no longer valid. + 2004-03-04 Katsumi Yamaoka + * binhex.el: Don't autoload executable-find. + * canlock.el: Don't autoload mail-fetch-field. + * gnus-ems.el: Don't autoload appt-select-lowest-window. + + * gnus-msg.el: Don't autoload news-reply-mode, news-setup, + rmail-dont-reply-to and rmail-output. + + * gnus-score.el: Don't autoload ffap-string-at-point. + + * gnus-setup.el: Don't autoload sc-cite-original. + + * imap.el: Don't autoload base64-decode-string, + base64-encode-string and md5. + + * message.el: Autoload rmail-dont-reply-to, rmail-msg-is-pruned + and rmail-msg-restore-non-pruned-header. + + * mm-decode.el: Don't autoload executable-find. + + * mm-url.el: Don't autoload executable-find. + + * mm-view.el: Don't autoload diff-mode. + + * nndb.el: Don't autoload news-reply-mode, news-setup, + cancel-timer and telnet. + + * password.el: Don't autoload run-at-time for Emacs. + + * sha1-el.el: Don't autoload executable-find. + + * sieve-mode.el: Don't autoload c-mode. + + * uudecode.el: Don't autoload executable-find. + +2004-03-04 Kevin Greiner + + * gnus-agent.el (gnus-agent-file-header-cache): Removed. + (gnus-agent-possibly-alter-active): Avoid null in numeric + comparison. + (gnus-agent-set-local): Refuse to save null in local object table. + (gnus-agent-regenerate-group): The REREAD parameter can now be a + list of articles that will be marked as unread. + +2004-03-04 Katsumi Yamaoka + + * rfc2047.el (rfc2047-encoded-word-regexp): Mismatched paren. + +2004-03-04 Jesper Harder + + * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231 + language tags. + +2004-03-03 Per Abrahamsen + + * gnus-agent.el (gnus-agent-read-local, gnus-agent-save-local): + Don't bind "obarray". + + * gnus-sum.el (gnus-thread-sort-functions): Added + `gnus-thread-sort-by-most-recent-number' and + `gnus-thread-sort-by-most-recent-date'. + Reported by Kai Grossjohann . + +2004-03-03 Katsumi Yamaoka + + * gnus-cus.el (gnus-agent-customize-category): Mismatched paren. + +2004-03-02 Kevin Greiner + + * gnus-cus.el (gnus-agent-customize-category): Removed + ignore-errors macro reference that required cl to be loaded at + run-time. + + * gnus-range.el (gnus-sorted-range-intersection): Now accepts + single-interval range of the form (min . max). Previously the + range had to look like ((min . max)). Likewise, return + (min . max) rather than ((min . max)). + (gnus-range-map): Use gnus-range-normalize to accept + single-interval range. + + * gnus-sum.el (gnus-summary-highlight-line): Articles stored in + the cache, but not the agent, now appear with their usual face. + +2004-03-01 Katsumi Yamaoka + + * gnus-art.el (gnus-article-wash-html-with-w3m): Don't make the + w3m-safe-url-regexp variable buffer-local. + + * mm-view.el (mm-inline-text-html-render-with-w3m): Ditto. + +2004-02-27 Simon Josefsson + + * gnus-sum.el (gnus-move-group-prefix-function): Add, default to + gnus-group-real-prefix. + (gnus-summary-move-article): Use it, instead of + gnus-group-real-prefix. + +2004-02-27 Katsumi Yamaoka + + * gnus-art.el (gnus-article-wash-html-with-w3m): Make the + w3m-safe-url-regexp variable buffer-local and set it as the value + of mm-w3m-safe-url-regexp. + + * mm-view.el (mm-inline-text-html-render-with-w3m): Ditto. + + * gnus-msg.el (gnus-setup-message): Ignore an article copy while + parsing gnus-posting-styles when the message is not for replying. + + * nnrss.el (nnrss-opml-export): Use + mm-set-buffer-file-coding-system instead of + set-buffer-file-coding-system. + +2004-02-27 Jesper Harder + + * spam-stat.el: Pedantic docstring and whitespace fixes (courtesy + of checkdoc.el). + * nnrss.el: do. + * gnus-mlspl.el: do. + * gnus-ml.el: do. + * gnus-srvr.el: do. + + * nnrss.el (nnrss-opml-export): Turn on sgml-mode. + +2004-02-27 Kevin Ryde (tiny change) + + * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): + Corrections to custom-manual links. + + * gnus-art.el (gnus-article): Ditto. + + * mm-decode.el (mime-display, mime-security): Ditto. + +2004-02-26 Jesper Harder + + * flow-fill.el: Typo. + +2004-02-26 Andrew Cohen + + * spam-wash.el: New file. + +2004-02-26 Mark A. Hershberger + + * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions. + +2004-02-26 Teodor Zlatanov + + * spam.el (spam-summary-prepare-exit): Fix gnus-set-difference: needs + to be run with new-articles as LIST1, not LIST2. + (spam-registration-functions): Add spam-use-ham-copy as a nil + registration backend. + +2004-02-26 Jesper Harder + + * spam-stat.el (spam-stat-washing-hook): New option. + (spam-stat-buffer-words): Use it. + (spam-stat-process-directory, spam-stat-test-directory): Use + insert-file-contents-literally. + (spam-stat-coding-system): New variable. + (spam-stat-load, spam-stat-save): Use it. + +2004-02-25 Katsumi Yamaoka + + * spam-report.el (spam-report-plug-agent): Quote + spam-report-url-to-file and spam-report-url-ping-plain. + +2004-02-25 Reiner Steib + + * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow + / in mailto URLs. + +2004-02-24 Reiner Steib + + * spam-report.el (spam-report-process-queue): Fix interactive use. + (spam-report-url-ping-temp-agent-function, spam-report-plug-agent) + (spam-report-unplug-agent): Doc fixes. + (spam-report-url-ping-mm-url, spam-report-url-to-file) + (spam-report-agentize, spam-report-deagentize): Autoload + +2004-02-24 Katsumi Yamaoka + + * message.el (message-setup-fill-variables): Add mml tags to + paragraph-start and paragraph-separate. Suggested by Andrew Korty + . + (message-mode): Don't modify paragraph-separate there. + +2004-02-17 Katsumi Yamaoka + + * compface.el (uncompface-use-external): Default to undecided. + (uncompface-use-external-threshold): New variable. + (uncompface-float-time): New macro. + (uncompface): Determine whether to use the external decoder if + uncompface-use-external is undecided. + +2004-02-15 Lars Magne Ingebrigtsen + + * mm-view.el (mm-inline-image-emacs): Don't insert blank lines + after images. + + * gnus-art.el (gnus-mime-display-single): Remove dead code. + +2004-02-14 Jesper Harder + + * nnrss.el (nnrss-request-article, nnrss-find-el): Cleanup. + + * html2text.el (html2text-get-attr, html2text-fix-paragraph): do + + * gnus-sum.el (gnus-summary-limit-to-age) + (gnus-summary-limit-children): do. + + * gnus-int.el (gnus-request-scan): do. + + * gnus-group.el (gnus-group-suspend): do. + + * gnus-cus.el (gnus-agent-cat-prepare-category-field): do. + + * gnus-cite.el (gnus-cite-parse-attributions): do. + + * gnus-agent.el (gnus-summary-set-agent-mark) + (gnus-agent-regenerate-group): do. + + * deuglify.el (gnus-article-outlook-unwrap-lines): do. + + * binhex.el (binhex-decode-region-internal): do. + +2004-02-12 Katsumi Yamaoka + + * gnus-fun.el (gnus-face-properties-alist): New user option. + (gnus-display-x-face-in-from): Use it. + + * gnus-art.el (article-display-face): Ditto. + + * compface.el (uncompface-use-external): Default to nil. + +2004-02-12 Jesper Harder + + * nntp.el (nntp-erase-buffer): New function. + (nntp-retrieve-data, nntp-send-command) + (nntp-send-buffer, nntp-retrieve-groups, nntp-handle-authinfo) + (nntp-possibly-change-group): Use it. + + * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Use + with-current-buffer. + +2004-02-12 TAKAI Kousuke + + * compface.el: Merge the ELisp-based uncompface program. + (compface): New customization group. + (uncompface-use-external): New user option. + (uncompface): Call uncompface-internal if uncompface-use-external + is nil. + (uncompface-internal): New function. Note that there are also + some other functions and variables added for this function. + +2004-02-10 Jesper Harder + + * nnrss.el (nnrss-read-group-data): Initialize nnrss-group-hashtb + if necessary. + +2004-02-09 Teodor Zlatanov + + * spam-report.el (spam-report-unplug-agent) + (spam-report-plug-agent, spam-report-deagentize) + (spam-report-agentize, spam-report-url-ping-temp-agent-function): + Add support for the Agent in spam-report: when unplugged, report to a + file; when plugged, submit all the requests. + + * spam.el (spam-register-routine): Fix message about + registration. + +2004-02-09 Jesper Harder + + * rfc2047.el (rfc2047-qp-or-base64): New function to reduce + dependencies. + (rfc2047-encode): Use it. + + * gnus-art.el (gnus-button-marker-list): Move before first + reference. + + * imap.el (imap-parse-flag-list, imap-parse-body-extension) + (imap-parse-body): Fix format string mismatch. + + * gnus-score.el (gnus-summary-increase-score): do. + + * nnrss.el (nnrss-close): New function. + +2004-02-08 Jesper Harder + + * nnrss.el (nnrss-make-filename): New function. + (nnrss-request-delete-group, nnrss-read-server-data) + (nnrss-save-server-data, nnrss-read-group-data) + (nnrss-save-group-data): Use it. + (nnrss-save-server-data, nnrss-save-group-data): Use gnus-prin1. + (nnrss-read-server-data, nnrss-read-group-data): Use load. + (nnrss-group-hashtb): Make it a hash table rather than an obarray. + +2004-02-07 Jesper Harder + + * mml.el (mml-compute-boundary-1): Don't uncompress files. + +2004-02-06 Jesper Harder + + * mml.el (mml-mode, mml-x-dnd-attach-file): Attach drop and drag + files. + + * message.el (message-generate-headers-first): Don't quote nil + and t in docstrings. + + * imap.el (imap-id): do. + + * gnus-agent.el (gnus-agent-consider-all-articles) + (gnus-agent-queue-mail): do. + +2004-02-05 Reiner Steib + + * spam-report.el (spam-report-process-queue): New function. + Process requests from `spam-report-requests-file'. + (spam-report-process-queue): Doc fix. + +2004-02-05 Teodor Zlatanov + + * spam.el (spam-register-routine) + (spam-log-processing-to-registry, spam-log-registered-p) + (spam-log-unregistration-needed-p, spam-log-undo-registration): + Change "check" to "spam-check" for semi-clarity. + +2004-02-05 Jesper Harder + + * pop3.el: Require nnheader. + + * mml-smime.el: Require cl. Autoload message-fetch-field. + + * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus. + + * gnus-picon.el: Require cl. + + * gnus-fun.el: Require gnus-ems and gnus-util. + + * gnus.el (gnus-method-to-server): Move defsubst before first use. + + * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr + + * gnus-art.el (gnus-article-edit-mode): Define before first + reference. + +2004-02-04 Jesper Harder + + * gnus-uu.el (gnus-uu-check-correct-stripped-uucode): Simplify. + (gnus-uu-post-encoded): Use point-at-bol. + + * gnus-topic.el (gnus-group-active-topic-p): do. + + * gnus-start.el (gnus-newsrc-to-gnus-format): do. + + * gnus-group.el (gnus-group-kill-region): do. + + * gnus-art.el (article-date-ut): do. + + * message.el (message-fetch-field): Remove redundant + case-fold-search binding. + (message-narrow-to-field): Simplify. + +2004-02-03 Reiner Steib + + * spam.el (spam-directory): Derive from `gnus-directory'. + + * spam-report.el (spam-report-url-to-file) + (spam-report-requests-file): New function and variable for offline + reporting. + (spam-report-url-ping-function): Add `spam-report-url-to-file' + and user defined function. + (spam-report-url-ping-mm-url): Remove doubled slash. + +2004-02-03 Teodor Zlatanov + + * spam.el (spam-list-of-processors): Fix spamassassin variable names. + +2004-02-03 Jesper Harder + + * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Fix + format string mismatch. + + * sieve.el (sieve-deactivate-all): do. + + * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): do. + + * nnlistserv.el (nnlistserv-kk-wash-article): do. + + * nnml.el (nnml-request-set-mark, nnml-save-marks): do. + + * mm-bodies.el (mm-7bit-chars): Don't include \r. + +2004-02-02 Teodor Zlatanov + + * spam.el (spam-list-of-checks): Add spam-use-BBDB-eclusive to + the list of checks. + +2004-01-31 Jesper Harder + + * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid + padding. + +2004-01-27 Ralf Angeli + + * mm-view.el (mm-fill-flowed): New variable. + (mm-inline-text): Use it. + +2004-01-27 Teodor Zlatanov + + * spam.el (spam-spamassassin-register-ham-routine) + (spam-spamassassin-register-spam-routine): Fix function names. + +2004-01-27 Katsumi Yamaoka + + * gnus.el (gnus-tmp-grouplens): Remove. + (gnus-summary-line-format): Remove grouplens. + + * gnus-group.el (gnus-group-line-format): Ditto. + + * gnus-spec.el (gnus-format-specs): Ditto. + (gnus-update-format-specifications): Flush the group format spec + cache if there's the grouplens stuff. + (gnus-parse-simple-format): Replace %l with the empty string. + +2004-01-27 Jerry James (tiny change) + + * gnus-spec.el (gnus-parse-simple-format): Fix setq value + omission. + +2004-01-26 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-resend-message-edit): Call mime-to-mml. + Suggested by Hiroshi Fujishima . + +2004-01-25 Paul Jarc + + * nnmaildir.el (nnmaildir--num-file, nnmaildir--mkfile, + nnmaildir--emlink-p, nnmaildir--eexist-p, nnmaildir--new-number): + New macros and functions. + * nnmaildir.el (nnmaildir--group-maxnum, nnmaildir--update-nov): + Handle > NLINK_MAX messages. + * nnmaildir.el (nnmaildir-request-set-mark): Use + nnmaildir--emlink-p and nnmaildir--eexist-p. + +2004-01-25 Alex Schroeder + + * spam-stat.el (spam-stat-process-directory-age): New option. + (spam-stat-process-directory): Use it. + +2004-01-24 Hiroshi Fujishima (tiny change) + + * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty. + (spam-stat-save): Accept prefix argument. + +2004-01-23 Paul Jarc + + * nnmaildir.el (nnmaildir-request-set-mark): Handle the "too many + links" error. + +2004-01-23 Jesper Harder + + * gnus.el (gnus-tmp-grouplens): Define for the sake of backward + compatibility with old .newsrc.eld files. + + * gnus-sum.el (gnus-summary-line-format-alist): Remove grouplens. + + * gnus-start.el (gnus-1): do. + + * gnus-group.el (gnus-group-line-format-alist): do. + + * gnus.el (gnus-use-grouplens, gnus-visual): do. + + * gnus-gl.el: Remove. + +2004-01-23 Kevin Greiner + + * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of + marks consisting of a single range {for example, (3 . 5)} rather + than a list of a single range { ((3 . 5)) }. + +2004-01-23 Jesper Harder + + * spam-stat.el (spam-stat-store-gnus-article-buffer): Use + with-current-buffer. + (spam-stat-store-current-buffer): Use insert-buffer-substring to + avoid consing a string. + + * mm-util.el (mm-charset-synonym-alist): Add ks_c_5601-1987. + Remove obsolete entries for big5 and gb2312. + +2004-01-22 Kevin Greiner + + * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the + uncompressed list. + +2004-01-22 Jesper Harder + + * spam-stat.el (spam-stat-strip-xref): New function. + (spam-stat-process-directory): Use it. + + * gnus-util.el (gnus-fetch-field): Don't bind case-fold-search + here -- it's done in message-fetch-field. + +2004-01-21 Kevin Greiner + + * gnus-agent.el (gnus-agent-queue-mail, + gnus-agent-prompt-send-queue): New variables. + (gnus-agent-send-mail): Use gnus-agent-queue-mail. + * gnus-draft.el (gnus-group-send-queue): Pass the group name + "nndraft:queue" along to gnus-draft-send. Use + gnus-agent-prompt-send-queue. + (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group + is "nndraft:queue". Suggested by Gaute Strokkenes + + + * gnus-agent.el (agent-disable-undownloaded-faces): Removed + (agent-enable-undownloaded-faces): Added + (gnus-agent-cat-groups): Use eval-and-compile, not + eval-when-compile, to define gnus-agent-set-cat-groups as the setf + method of gnus-agent-cat-groups even when the buffer has been + evaled. + (gnus-agent-save-active,gnus-agent-save-active-1): Merged to + delete gnus-agent-save-active-1. + (gnus-agent-save-groups): Deleted. Identical to + gnus-agent-save-active. + (gnus-agent-write-active): No longer adjust agent's copy of active + file as agent's adjustments are now stored in their own + file. Removed optional parameter. + (gnus-agent-possibly-alter-active): Ignore groups of unagentized + servers. Add use of min/max range limits from server's local + file. + (gnus-agent-save-alist): Removed unused optional argument. + (gnus-agent-load-local,gnus-agent-read-and-cache-local), + (gnus-agent-read-local,gnus-agent-save-local,gnus-agent-get-local), + (gnus-agent-set-local): A per-server file that keeps min/max range + limits for articles known to the agent. Provides a fast mechanism + for altering many active ranges. + (gnus-agent-expire-group,gnus-agent-expire): No longer save the + active file (local makes it unnecessary). + (gnus-agent-regenerate-group): Fixed XEmacs compatibility. + + * gnus-cus.el (agent-disable-undownloaded-faces): Removed + (agent-enable-undownloaded-faces): Added + + * gnus-draft.el (gnus-draft-send): Bind gnus-agent-queue-mail to + disable it when sending to "nndraft:queue". + (gnus-group-send-queue): Add safety check to avoid sending queue + when unplugged. + + * gnus-group.el (gnus-group-catchup): Use new + gnus-sequence-of-unread-articles, not + gnus-list-of-unread-articles, to avoid exhausting memory with huge + numbers of articles. Use gnus-range-map to avoid having to + uncompress the unread list. + (gnus-group-archive-directory, + gnus-group-recent-archive-directory): Fixed invalid ange-ftp + reference. + + * gnus-range.el (gnus-range-map): Iterate over list or sequence. + (gnus-sorted-range-intersection): Intersection of two ranges + without requiring that they first be uncompressed. + + * gnus-start.el (gnus-activate-group): Unless blocked by the + caller, possibly expand the active range to include both cached + and agentized articles. + (gnus-convert-old-newsrc): Rewrote in anticipation of having + multiple version-dependent converters. + (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with + gnus-agent-save-active. + (gnus-save-newsrc-file): Save dirty agent range limits. + + * gnus-sum.el (gnus-select-newgroup): Replaced inline code with + gnus-agent-possibly-alter-active. + (gnus-adjust-marked-articles): Faster handling of simple lists + +2004-01-21 Jesper Harder + + * spam-stat.el (spam-stat-test-directory): New optional argument + displays a list of files detected. Suggested by Andrew Cohen + . + (spam-stat-buffer-words-with-scores): Don't narrow and change + syntax table here. Reported by Andrew Cohen . + +2004-01-20 Hubert Chan : + + * spam.el (spam-use-spamassassin, spam-use-spamassassin-headers) + (spam-install-hooks, spam-spamassassin, spam-spamassassin-path) + (spam-spamassassin-arguments) + (spam-spamassassin-spam-flag-header) + (spam-spamassassin-positive-spam-flag-header) + (spam-spamassassin-spam-status-header, spam-sa-learn-path) + (spam-sa-learn-rebuild, spam-sa-learn-spam-switch) + (spam-sa-learn-ham-switch, spam-sa-learn-unregister-switch) + (spam-list-of-processors, spam-list-of-checks) + (spam-list-of-statistical-checks, spam-registration-functions) + (spam-check-spamassassin-headers, spam-check-spamassassin) + (spam-spamassassin-score) + (spam-spamassassin-register-with-sa-learn) + (spam-spamassassin-register-spam-routine) + (spam-spamassassin-register-ham-routine) + (spam-assassin-register-spam-routine) + (spam-assassin-register-ham-routine): add SpamAssassin support + (spam-bogofilter-score): fix to show article before scoring + +2004-01-20 Teodor Zlatanov + + * spam.el (gnus-summary-mode-map): Make spam-generic-score the + default scoring function. + (spam-generic-score): Call spam-spamassassin-score if + spam-use-spamassassin or spam-use-spamassassin-headers is on; + spam-bogofilter-score otherwise. + + * gnus.el (spam-process, spam-autodetect-methods): Add + spamassassin and spamassassin-headers. + +2004-01-20 Nevin Kapur + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): + Suppress unnecessary messages. + +2004-01-20 Jesper Harder + + * spam-stat.el (spam-stat-to-hash-table): Use :size keyword in + make-hash-table. + 2004-01-19 Katsumi Yamaoka * canlock.el (base64-encode-string): Don't autoload it. +2004-01-16 Katsumi Yamaoka + + * run-at-time.el: Remove useless (require 'itimer), + eval-and-compile and (featurep 'xemacs). + +2004-01-16 Jesper Harder + + * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if + GROUP is a virtual group. + +2004-01-16 Steve Youngs + + * gnus.el: Autoload `message-y-or-n-p'. + +2004-01-15 Jesper Harder + + * pgg-parse.el: Remove unnecessary (require 'custom). + + * pgg-def.el: do. + + * nnmail.el: do. + + * gnus-undo.el: do. + + * gnus-picon.el: do. + + * gnus-util.el: do. + +2004-01-15 Reiner Steib + + * gnus-sum.el (gnus-pick-line-number): Add autoload. + +2004-01-15 Katsumi Yamaoka + + * mm-decode.el (mm-multiple-handles): Recognize a string as a mime + handle, as well as a list. + + * mm-view.el (mm-w3m-cid-retrieve-1): Call itself recursively. + Suggested by ARISAWA Akihiro . + (mm-w3m-cid-retrieve): Simplify. + +2004-01-14 Vasily Korytov + + * message.el (message-kill-to-signature): Allow prefix arg to + specify number of lines to keep before signature. + +2004-01-14 Kai Grossjohann + + (message-kill-to-signature): Change docstring. + 2004-01-14 Katsumi Yamaoka * canlock.el: Always require sha1-el. (canlock-sha1): Bind sha1-maximum-internal-length to nil. + * message.el: Autoload sha1 only when compiling. + 2004-01-13 Katsumi Yamaoka * message.el (message-canlock-generate): Require sha1-el. +2004-01-13 Jesper Harder + + * message.el (message-expand-name): Silence the byte compiler. + +2004-01-13 Simon Josefsson + + * gnus-score.el (gnus-score-edit-all-score): Fix prototype. + Invoke gnus-score-mode. Reported by + bojohan+news@dd.chalmers.se (Johan Bockg,Ae(Brd). + + * gnus-range.el (gnus-compress-sequence): Doc fix. Suggested by + Jim Blandy (tiny change). + +2004-01-12 Jesper Harder + + * gnus-srvr.el (gnus-browse-foreign-server): Reduce consing. + +2004-01-12 Teodor Zlatanov + + * spam.el (spam-get-article-as-string): Update to use + gnus-request-article-this-buffer, much simpler. + (spam-get-article-as-buffer): Remove. + +2004-01-12 Kai Grossjohann + + * message.el (message-expand-name): Use EUDC if the user uses + that. + +2004-01-12 Jesper Harder + + * rfc2047.el (rfc2047-parse-and-decode, rfc2047-decode): Use a + character for the encoding to avoid consing a string. + + * rfc2047.el (rfc2047-decode-string): Don't cons a string + unnecessarily. + + * mm-util.el (mm-replace-chars-in-string): Remove. + + * rfc2047.el (rfc2047-decode): Use mm-subst-char-in-string instead + of mm-replace-chars-in-string. + +2004-01-11 Jesper Harder + + * gnus.sum.el (gnus-remove-odd-characters): Don't cons two new + strings. + + * mm-util.el (mm-subst-char-in-string): Support inplace. + + * gnus-sum.el (gnus-summary-remove-list-identifiers): Don't cons + a new string in every iteration. Use shy groups. + +2004-01-10 Jesper Harder + + * gnus-start.el (gnus-subscribe-newsgroup, gnus-start-draft-setup) + (gnus-group-change-level, gnus-kill-newsgroup) + (gnus-check-bogus-newsgroups, gnus-get-unread-articles-in-group) + (gnus-get-unread-articles, gnus-make-articles-unread) + (gnus-make-ascending-articles-unread): Use accessor + macros (gnus-group-entry, gnus-group-unread, gnus-info-marks etc.) + to get group information for improved readability. + + * gnus-srvr.el (gnus-browse-unsubscribe-group): do. + + * gnus-soup.el (gnus-soup-group-brew): do. + + * gnus-msg.el (gnus-put-message): do. + + * gnus-move.el (gnus-group-move-group-to-server): do. + + * gnus-kill.el (gnus-batch-score): do. + + * gnus-group.el (gnus-group-prepare-flat, gnus-group-delete-group) + (gnus-group-update-group-line, gnus-group-insert-group-line-info) + (gnus-group-update-group, gnus-group-read-group) + (gnus-group-make-group, gnus-group-make-help-group) + (gnus-group-make-archive-group, gnus-group-make-directory-group) + (gnus-group-make-empty-virtual, gnus-group-sort-selected-flat) + (gnus-group-sort-by-unread, gnus-group-catchup) + (gnus-group-unsubscribe-group, gnus-group-kill-group) + (gnus-group-yank-group, gnus-group-set-info) + (gnus-group-list-groups): do. + + * gnus.el (gnus-generate-new-group-name): do. + + * gnus-delay.el (gnus-delay-send-queue): do. + + * nnvirtual.el (nnvirtual-catchup-group): do. + + * nnkiboze.el (nnkiboze-generate-group, nnkiboze-generate-group): + do. + + * gnus-topic.el (gnus-topic-find-groups, gnus-topic-clean-alist) + (gnus-group-prepare-topics, gnus-topic-check-topology): do. + + * gnus-sum.el (gnus-update-read-articles, gnus-select-newsgroup) + (gnus-mark-xrefs-as-read, gnus-compute-read-articles) + (gnus-summary-walk-group-buffer, gnus-summary-move-article) + (gnus-group-make-articles-read): do. + +2004-01-09 Jesper Harder + + * gnus-art.el (article-decode-mime-words, article-babel) + (gnus-article-highlight-signature, gnus-article-add-buttons) + (gnus-signature-toggle): Use gnus-with-article-buffer. + + * gnus-art.el (gnus-article-highlight-headers) + (gnus-article-add-buttons-to-head): Use gnus-with-article-headers. + + * gnus-art.el (gnus-mm-display-part, gnus-article-wash-status) + (gnus-article-set-globals, gnus-request-article-this-buffer) + (gnus-button-message-id, gnus-article-maybe-hide-headers) + (gnus-mime-view-part-externally, gnus-mime-view-part-internally) + (gnus-mime-display-alternative): Use with-current-buffer. + +2004-01-09 Teodor Zlatanov + + * spam.el (spam-generate-fake-headers): Rewrite to be simpler, + also under 80 char limit, and call gnus-error if needed. + (spam-fetch-article-header): Fix - it was a + buffer-local variable (gnus-newsgroup-data). + (spam-find-spam): Use spam-generate-fake-headers, forget about + spam-insert-fake-headers. + (spam-insert-fake-headers): Remove. + +2004-01-09 Jesper Harder + + * deuglify.el (gnus-article-outlook-unwrap-lines) + (gnus-outlook-rearrange-article) + (gnus-outlook-repair-attribution-outlook) + (gnus-outlook-repair-attribution-block) + (gnus-outlook-repair-attribution-other): Remove redundant + save-excursion. + +2004-01-09 Teodor Zlatanov + + * spam.el (spam-fetch-field-fast, spam-fetch-field-from-fast) + (spam-fetch-field-subject-fast) + (spam-fetch-field-message-id-fast, spam-generate-fake-headers) + (spam-fetch-article-header): Add functions to deal with Gnus + internals for fast retrieval of article header data. + (spam-initialize): Put spam-find-spam in the gnus-summary-prepared-hook. + +2004-01-09 Jesper Harder + + * pop3.el (pop3-md5): Remove. + (pop3-apop): Replace pop3-md5 with md5. + + * mm-bodies.el: base64 is always built-in. + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use + with-current-buffer. + 2004-01-08 Katsumi Yamaoka * canlock.el (canlock-insert-header): Remove excessive grouping in regexp. + * gnus-sum.el (gnus-summary-read-document): Ditto. + + * gnus-uu.el (gnus-uu-part-number): Ditto. + + * html2text.el (html2text-remove-tags): Ditto. + (html2text-format-tags): Ditto. + (html2text-format-single-elements): Ditto. + + * mml.el (mml-parse-1): Ditto. + +2004-01-08 Jesper Harder + + * gnus-sum.el (gnus-summary-update-mark): Revert previous change. + + * gnus-group.el (gnus-group-mark-group): Fix for multibyte marks. + + * gnus-sum.el (gnus-summary-update-mark): Fix for multibyte marks. + + * gnus-util.el (gnus-replace-in-string): Remove Emacs 20 code. + +2003-11-15 Simon Josefsson + + * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys) + (pgg-gpg-lookup-key): Use regexp match instead of + split-string (split-string is different between emacs 21.2 and + 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith). + +2004-01-08 Jesper Harder + + * gnus-art.el (gnus-mime-view-all-parts) + (gnus-article-part-wrapper, gnus-article-view-part): Use + with-current-buffer. + +2004-01-07 Teodor Zlatanov + + * spam.el (spam-disable-spam-split-during-ham-respool) + (spam-spamoracle-database, spam-cache-lookups) + (spam-split-last-successful-check, spam-clear-cache, spam-xor) + (spam-group-ham-mark-p, spam-group-spam-mark-p) + (spam-group-ham-marks, spam-group-spam-marks) + (spam-group-spam-contents-p, spam-group-ham-contents-p) + (spam-list-of-processors, spam-list-of-statistical-checks): Fix doc, + also add spam-use-blackholes to the statistical checks. + (spam-fetch-field-fast): Add interface to fetching fields, may + become a macro. + (spam-fetch-field-from-fast, spam-fetch-field-subject-fast) + (spam-fetch-field-message-id-fast): Use spam-fetch-field-fast. + (spam-insert-fake-headers): Fake an article when needed. + (spam-find-spam): Fake article when possible. + (spam-check-blackholes, spam-check-BBDB, spam-from-listed-p) + (spam-check-bogofilter-headers): Use message-fetch-field instead + of nnmail-fetch-field. + +2004-01-07 Reiner Steib + + * gnus-score.el (gnus-score-find-trace): Add `k' (kill-buffer). + +2004-01-07 Teodor Zlatanov + + * spam.el (spam-split): Do not require spam-use-CHECK to be + enabled if that check is passed to spam-split explicitly; also + fix so 'spam doesn't get converted to spam-split-group when + spam-split-symbolic-return is t. + (spam-find-spam): Find registrations of the article and use those + instead of re-running spam-split to find the spam/ham + classification of the article. + (spam-log-processing-to-registry, spam-log-registered-p) + (spam-log-unregistration-needed-p, spam-log-undo-registration): + Use gnus-error instead of gnus-message. + (spam-log-registration-type): Add function to determine the + classification of a message based on registry entries; will + return nil if both 'spam and 'ham are found. + (spam-check-BBDB): Expand all the BBDB macros here so we can have + a reasonably fast local cache without the loading errors. + (spam-cache-lookups): Set to t by default. + (spam-find-spam): Don't try to guess spam-cache-lookups. + (spam-enter-whitelist, spam-enter-blacklist): Clear the + spam-caches entry. + (spam-filelist-build-cache, spam-filelist-check-cache): Fix + caching of whitelist/blacklist entries. + (spam-check-whitelist, spam-check-blacklist): Invoke + spam-from-listed-p with a type, not a cache variable. + (spam-from-listed-p): Wrap around spam-filelist-check-cache. + +2004-01-07 Jesper Harder + + * message.el (message-cite-prefix-regexp): Use with-syntax-table. + + * nnmail.el (nnmail-split-fancy): do. + + * mml.el (mml-parse): do. + + * gnus-score.el (gnus-enter-score-words-into-hashtb) + (gnus-score-adaptive): do. + 2004-01-07 Katsumi Yamaoka + * gnus-art.el (gnus-treat-emphasize): Ignore Emacs version number. + (gnus-mime-button-map): Don't set keymap parent. + (gnus-button-ctan-directory-regexp): Use shy grouping. + (gnus-prev-page-map): Don't set keymap parent. + (gnus-prev-page-map): Remove duplicated one. + (gnus-next-page-map): Don't set keymap parent. + (gnus-mime-security-button-map): Ditto. + + * nnheader.el (nnheader-directory-files-is-safe): Ignore Emacs + version number. + * sha1-el.el (sha1-string-external): Use with-temp-buffer. 2004-01-07 Katsumi Yamaoka @@ -4782,275 +10725,346 @@ (sha1-string): Ditto. (sha1): Ditto. -2003-11-15 Simon Josefsson - - * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys) - (pgg-gpg-lookup-key): Use regexp match instead of - split-string (split-string is different between emacs 21.2 and - 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith). - -2004-07-28 Simon Josefsson - - * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign - parameter (but don't use it, for now). - -2004-02-03 Jesper Harder - - * sieve.el (sieve-deactivate-all): Fix format string mismatch. - -2004-08-30 Andreas Schwab - - * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for - ?* and ?\;. - - * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\; - and ?\' to symbol instead of whitespace. - -2004-08-31 Jesper Harder - - * message.el (message-idna-to-ascii-rhs-1): Don't choke on - invalid addresses. - -2004-08-31 Reiner Steib - - * message.el (message-idna-to-ascii-rhs-1): Fix typo. - -2004-08-31 Lars Magne Ingebrigtsen - - * message.el (message-idna-to-ascii-rhs-1): Don't use equalp. - -2004-08-31 Lars Magne Ingebrigtsen - - * gnus-art.el (article-decode-idna-rhs): Don't use - message-idna-inside-rhs-p. - -2004-08-31 Lars Magne Ingebrigtsen - - * message.el (message-idna-inside-rhs-p): Remove. - (message-idna-to-ascii-rhs-1): Use proper address parsing. - -2004-08-31 Katsumi Yamaoka - - * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. - -2004-08-30 Helmut Waitzmann (tiny change) - - * gnus-sum.el (gnus-newsgroup-variables): Doc fix. - -2004-08-26 YAGI Tatsuya (tiny change) - - * gnus-art.el (gnus-article-next-page): Fix the way to find a real - end-of-buffer. - -2004-08-26 Stefan Wiens (tiny change) - - * gnus-sum.el (gnus-read-header): Don't remove a header for the - parent article of a sparse article in the thread hashtb. - -2004-08-26 David Hedbor (tiny change) - - * nnmail.el (nnmail-split-lowercase-expanded): New user option. - (nnmail-expand-newtext): Lowercase expanded entries if - nnmail-split-lowercase-expanded is non-nil. - - * gnus-agent.el (gnus-agent-regenerate-group): Activate the group - when the group's active is not available. - - * gnus-art.el (article-hide-headers): Refer to the values for - gnus-ignored-headers and gnus-visible-headers in the summary - buffer since a user may have set them as group parameters. - (gnus-article-read-summary-keys): Restore new window-start and - hscroll to summary window. - (gnus-prev-page-map): Remove duplicated one. - - * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option. - (gnus-cite-parse): Ignore quoted envelope From_. Suggested by - Karl Chen and Reiner Steib - . - - * gnus-cus.el (gnus-agent-cat-prepare-category-field): - Replace pp-to-string with gnus-pp-to-string. - - * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp. - - * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with - gnus-pp. - - * gnus-msg.el (gnus-setup-message): Ignore an article copy while - parsing gnus-posting-styles when the message is not for replying. - (gnus-summary-resend-message-edit): Call mime-to-mml. - Suggested by Hiroshi Fujishima . - (gnus-debug): Replace pp with gnus-pp. - - * gnus-score.el (gnus-score-save): Replace pp with gnus-pp. - - * gnus-spec.el (gnus-update-format): Replace pp-to-string with - gnus-pp-to-string. - - * gnus-util.el (gnus-bind-print-variables): New macro. - (gnus-prin1): Use it. - (gnus-prin1-to-string): Use it. - (gnus-pp): New function. - (gnus-pp-to-string): New function. +2004-01-07 Lars Magne Ingebrigtsen + + * spam.el (spam-report-articles-gmane): New command. + +2004-01-07 Katsumi Yamaoka * gnus.el: Don't make unnecessary *Group* buffer when loading. - * mail-source.el (mail-source-touch-pop): Doc fix. - - * message.el (message-mode): Don't modify paragraph-separate there. - (message-setup-fill-variables): Add mml tags to paragraph-start - and paragraph-separate. Suggested by Andrew Korty . - (message-smtpmail-send-it): Doc fix. - (message-exchange-point-and-mark): Don't activate region if it was - inactive. Suggested by Hiroshi Fujishima - and Jesper Harder . - - * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to - t while entering a file name using the mm-with-multibyte macro. - Suggested by Hiroshi Fujishima . - - * mm-encode.el (mm-content-transfer-encoding-defaults): - Use qp-or-base64 for the application/* types. - (mm-safer-encoding): Consider 7bit is safe. - - * mm-util.el (mm-with-multibyte-buffer): New macro. - (mm-with-multibyte): New macro. - - * mm-view.el (mm-inline-render-with-function): Use multibyte - buffer; decode html source by charset. - - * nndoc.el (nndoc-type-alist): Improve regexp for article-begin, - add generate-head-function and generate-article-function to the - rfc822-forward entry. - (nndoc-forward-type-p): Recognize envelope From_. - (nndoc-rfc822-forward-generate-article): New function. - (nndoc-rfc822-forward-generate-head): New function. - - * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp. - - * webmail.el (webmail-debug): Replace pp with gnus-pp. - - * gnus-art.el (gnus-article-wash-html-with-w3m): - Bind w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp; - use w3m-minor-mode-map instead of mm-w3m-local-map-property. - (gnus-mime-save-part-and-strip): Use mm-complicated-handles - instead of mm-multiple-handles. - (gnus-mime-delete-part): Ditto. - - * mm-decode.el (mm-multiple-handles): Recognize a string as a mime - handle, as well as a list. - (mm-complicated-handles): Former definition of mm-multiple-handles. + * run-at-time.el (run-at-time-saved): Remove. + (run-at-time): Doc fix. + +2004-01-07 Jesper Harder + + * gnus-sum.el (gnus-summary-limit-to-replied): New command. + (gnus-summary-limit-map): Add it. + (gnus-summary-make-menu-bar): do. + +2004-01-06 Teodor Zlatanov + + * spam.el (spam-cache-lookups, spam-caches, spam-clear-cache): + Make attempt at some caching support (done for BBDB only now). + (spam-find-spam): Set spam-cache-lookups if there are more than 2 + addresses to be checked. + (spam-clear-cache-BBDB): Add function, to be invoked by + bbdb-change-hook, and triggering spam-clear-cache of 'spam-use-BBDB. + (spam-check-BBDB): Check and use the caches, if + spam-cache-lookups is on, remove superfluous (provide). + +2004-01-06 Reiner Steib + + * gnus-art.el (gnus-treat-ansi-sequences): Changed default. + +2004-01-07 Steve Youngs + + * run-at-time.el (run-at-time-saved): Move to after the definition + of `run-at-time'. + +2004-01-06 Katsumi Yamaoka + + * gnus-art.el (gnus-article-wash-html-with-w3m): Don't use + mm-w3m-local-map-property. * mm-view.el (mm-w3m-mode-map): Remove. (mm-w3m-local-map-property): Remove. - (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by - ARISAWA Akihiro . - (mm-w3m-cid-retrieve): Simplify. - (mm-inline-text-html-render-with-w3m): Decode html source by - charset; check META tags only when charsets are not specified in - headers; specify charset to w3m-region; use w3m-minor-mode-map - instead of mm-w3m-local-map-property. - -2004-08-30 Juanma Barranquero - - * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant. - -2004-08-30 Andreas Schwab - - * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting. - - * gnus-score.el (gnus-summary-increase-score): Fix format string. - -2004-08-30 Stefan Monnier - - * nnimap.el (nnimap-demule): Avoid string-as-multibyte. - -2004-08-30 Kim F. Storm - - * nntp.el (nntp-authinfo-file): Add :group 'nntp. - - * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache): - Add :group 'nnimap. - -2004-08-23 Reiner Steib - - * mm-decode.el (mime-display, mime-security): Fix custom-manual - entries. - - * gnus-art.el (gnus-article): Ditto. - -2004-08-23 Katsumi Yamaoka - - * gnus-art.el (article-hide-list-identifiers): - Bind inhibit-read-only as t. - -2004-08-22 Reiner Steib - - * gnus-mlspl.el (gnus-group-split-update): Fix docstring. - -2004-08-22 Stefan Monnier - - * gnus-art.el: Use inhibit-read-only instead of buffer-read-only. - (gnus-narrow-to-page): Don't assume point-min == 1. - (gnus-article-edit-mode): Derive from message-mode. - - * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume - point-min == 1. - - * imap.el (imap-parse-address-list, imap-parse-body-ext): - Disable incorrect use of `assert'. - - * message.el (message-mode): Set comment-start-skip. - -2004-08-22 Sam Steingold - - * pop3.el (pop3-leave-mail-on-server): New user variable. - (pop3-movemail): Delete mail only when it is nil. - -2004-08-17 Reiner Steib - - * netrc.el, tls.el: Removed; use files from ../net instead. - -2004-08-16 Reiner Steib - - * gnus-mule.el, smiley-ems.el: Removed obsolete files. - - * mailcap.el (mailcap-mime-data): Mark as risky. - - * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): - Fix custom-manual entries. - - * time-date.el: Removed. Merged into ../calendar/time-date.el. - -2004-08-02 Reiner Steib - - * blink.pbm, blink.xpm, braindamaged.xpm, cry.xpm, dead.xpm, - evil.xpm, forced.xpm, frown.xpm, grin.xpm, indifferent.xpm, - reverse-smile.xpm, sad.pbm, sad.xpm, smile.xpm, time-date.el, - wry.xpm: Added new files from the v5_10 branch of Gnus. - -2004-07-22 Andreas Schwab - - Import Gnus 5.10 from the v5_10 branch of the Gnus repository. - -2004-05-23 Katsumi Yamaoka - - * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in - addition to emacs-w3m. - -2004-05-19 Reiner Steib - - * gnus-msg.el (gnus-summary-followup-with-original): - Document yanking of region when active. - -2004-04-13 Kevin Greiner - - * gnus-agent.el: Merged 7.3 through 7.7 updates into branch. - Revision 7.2 changes excluded to maintain compatibility with all - targeted emacs versions. - - * gnus-cus.el: Merged revisions 7.2 through 7.5 into branch to support - gnus-agent.el update and incorporate bug fixes. + (mm-inline-text-html-render-with-w3m): Don't use + mm-w3m-local-map-property. + +2004-01-06 Lars Magne Ingebrigtsen + + * run-at-time.el: New file. + + * gnus.el ((fboundp 'gnus-set-text-properties)): Remove definition + of gnus-set-text-properties. + + * gnus-uu.el (gnus-uu-save-article): Ditto. + + * gnus-salt.el (gnus-carpal-setup-buffer): Ditto. + + * gnus-cite.el (gnus-cite-parse): Ditto. + + * gnus-art.el (gnus-button-push): Use set-text-properties instead + of gnus-. + + * gnus.el: Changed calls to nnheader-run-at-time and + password-run-at-time throughout to use run-at-time directly. + + * password.el: Removed definition of run-at-time. + +2004-01-05 Karl Pfl,Ad(Bsterer (tiny change) + + * mml.el (mml-minibuffer-read-disposition): Show attachment type + in prompt. + +2004-01-06 Steve Youngs + + * gnus-ems.el (gnus-mode-line-modified): Don't conditionalise on + XEmacs version. + + * dns.el (dns-make-network-process): Use `open-network-stream' + instead of `gnus-xmas-open-network-stream'. + + * .cvsignore: Add auto-autoloads.el, custom-load.el. + +2004-01-06 Jesper Harder + + * gnus-art.el (gnus-mime-display-alternative) + (gnus-insert-mime-button, gnus-insert-mime-security-button) + (gnus-insert-prev-page-button, gnus-insert-next-page-button): + Don't use gnus-local-map-property. + + * gnus-util.el (gnus-local-map-property): Remove. + + * mm-view.el (mm-view-pkcs7-decrypt): Replace + gnus-completing-read-maybe-default with completing-read. + + * gnus-util.el (gnus-completing-read): do. + (gnus-completing-read-maybe-default): Remove. + +2004-01-06 Steve Youngs + + * password.el: Only autoload `run-at-time' if not XEmacs. + Only autoload the itimer functions if XEmacs. + +2004-01-06 Jesper Harder + + * gnus-art.el (gnus-read-string): Remove. + (gnus-summary-pipe-to-muttprint): Replace gnus-read-string with + read-string. + +2004-01-05 Teodor Zlatanov + + * netrc.el: Autoload password-read. + (netrc): Add configuration group. + (netrc-encoding-method, netrc-openssl-path): Add + variables for encoding and decoding of files with symmetric + ciphers. + (netrc-encode): Add assistant function to encode a file with + netrc-encoding-method. + (netrc-parse): Add interactive parameter, added optional + decoding if netrc-encoding-method is non-nil but otherwise + behavior is standard. + (netrc-encrypting-method, netrc-encrypt, netrc-parse): + Do s/encode/encrypt/ everywhere. + + * spam.el: Remove executable-find autoload. + +2004-01-05 Jesper Harder + + * gnus-registry.el: Remove Emacs 20 hash table compatibility code. + + * gnus-uu.el (gnus-uu-post-encoded): bury-buffer is always fbound. + +2004-01-05 Reiner Steib + + * gnus-art.el (gnus-treat-ansi-sequences, + article-treat-ansi-sequences): New variable and function. + Suggested by Dan Jacobson . + + * gnus-sum.el (gnus-summary-wash-map, gnus-summary-make-menu-bar): + Use it. + +2004-01-05 Jesper Harder + + * mm-util.el (mm-quote-arg): Remove. + + * mm-decode.el (mm-mailcap-command): Replace mm-quote-arg with + shell-quote-argument. + + * gnus-uu.el (gnus-uu-command): do. + + * gnus-sum.el (gnus-summary-insert-pseudos): do. + + * ietf-drums.el (ietf-drums-token-to-list): Replace mm-make-char + with make-char. + + * mm-util.el (mm-make-char): Remove. + + * mml.el (mml-mode): Replace gnus-add-minor-mode with + add-minor-mode. + + * gnus-undo.el (gnus-undo-mode): do. + + * gnus-topic.el (gnus-topic-mode): do. + + * gnus-sum.el (gnus-dead-summary-mode): do. + + * gnus-start.el (gnus-slave-mode): do. + + * gnus-salt.el (gnus-binary-mode, gnus-pick-mode): do. + + * gnus-ml.el (gnus-mailing-list-mode): do. + + * gnus-gl.el (gnus-grouplens-mode): do. + + * gnus-draft.el (gnus-draft-mode): do. + + * gnus-dired.el (gnus-dired-mode): do. + + * gnus-ems.el (gnus-add-minor-mode): Remove. + + * gnus-spec.el (gnus-correct-length, gnus-correct-substring): + Replace gnus-char-width with char-width. + + * gnus-ems.el (gnus-char-width): Remove. + + * gnus-spec.el (gnus-correct-length, gnus-correct-substring): + Replace gnus-char-width with char-width. + + * gnus-ems.el (gnus-char-width): Remove. + + * spam-stat.el (with-syntax-table): Remove with-syntax-table + definition. + Remove Emacs 20 hash table compatibility code. + + * rfc2047.el (with-syntax-table): Remove with-syntax-table Emacs + 20 compatibility code. + + * spam.el (spam-point-at-eol): Replace with point-at-eol. + + * smime.el (smime-point-at-eol): Replace with point-at-eol. + + * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): Replace + with point-at-{eol,bol}. + + * netrc.el (netrc-point-at-eol): Replace with point-at-eol. + + * imap.el (imap-point-at-eol): Replace with point-at-eol. + + * flow-fill.el (fill-flowed-point-at-bol, + fill-flowed-point-at-eol): Replace with point-at-{eol,bol}. + + * gnus-util.el (gnus-point-at-bol, gnus-point-at-eol): Remove. + Replace with point-at-{eol,bol} throughout all files. + +2004-01-05 Katsumi Yamaoka + + * ntlm.el (ntlm-string-as-unibyte): New macro. + (ntlm-build-auth-response): Use it. + + Remove Emacs 20 stuff: + * gnus-msg.el (gnus-summary-news-other-window): Use remove instead + of delq and copy-sequence. + * gnus-art.el (popup-menu): Remove the compiler macro. + * nnmail.el (nnmail-split-fancy): Don't support customizing with + Emacs 20. + +2004-01-05 Simon Josefsson + + * ntlm.el: Fix namespace. Change smb-passwd-hash into + ntlm-smb-passwd-hash, smb-owf-encrypt into ntlm-smb-owf-encrypt, + smb-passwd-hash into ntlm-smb-passwd-hash, smbdes-e-p16 into + ntlm-smb-des-e-p16, smbdes-e-p24 into ntlm-smb-des-e-p24, smbhash + into ntlm-smb-hash, smb-sp8 into ntlm-smb-sp8, smb-str-to-key into + ntlm-smb-str-to-key, smb-dohash into ntlm-smb-dohash, smb-perm1 + into ntlm-smb-perm1, smb-perm2 into ntlm-smb-perm2, smb-perm3 into + ntlm-smb-perm3, smb-perm4 into ntlm-smb-perm4, smb-perm5 into + ntlm-smb-perm5, smb-perm6 into ntlm-smb-perm6, smb-sc into + ntlm-smb-sc, smb-sbox into ntlm-smb-sbox, string-permute into + ntlm-string-permute, string-lshift into ntlm-string-lshift, + string-xor into ntlm-string-xor. Suggested by + Jesper Harder . + + * ntlm.el: Don't include poem. + + * md4.el (print-int32, print-string-hexa): Remove. Suggested by + Jesper Harder . + + * sasl-ntlm.el, ntlm.el, md4.el: New files. + + * hmac-md5.el (md5-binary): Fix byte compile warning. (This + probably breaks emacs with DL patch, but do we care? Is anyone + still using the DL stuff?) + + * sieve-manage.el: Use the password package. + (sieve-manage-read-passwd): Remove. + (sieve-manage-interactive-login): Use password. Re-add + condition-case around loop. + + * pgg.el (pgg-passphrase-cache, pgg-run-at-time): Remove. + (pgg-add-passphrase-cache, pgg-remove-passphrase-cache): Use + the password package. + +2003-02-19 Simon Josefsson + + * sieve-manage.el (sieve-sasl-auth): Quote optional initial SASL + token. + +2002-08-07 Simon Josefsson + + * sieve-manage.el (require): Use SASL, not RFC2104/MD5. + (sieve-manage-authenticators): + (sieve-manage-authenticator-alist): Add some SASL mechs. + (sieve-sasl-auth): New function. + (sieve-manage-cram-md5-auth): + (sieve-manage-plain-auth): Rewrite using SASL library. + (sieve-manage-digest-md5-p, sieve-manage-digest-md5-auth) + (sieve-manage-scram-md5-p, sieve-manage-scram-md5-auth) + (sieve-manage-ntlm-p, sieve-manage-ntlm-auth) + (sieve-manage-login-p, sieve-manage-login-auth): Add wrappers. + +2004-01-05 Simon Josefsson + + * sasl.el, sasl-cram.el, sasl-digest.el, hmac-md5.el, hmac-def.el: + New files. + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus-group.el (gnus-no-groups-message): Update. + + * gnus-sum.el (gnus-summary-insert-new-articles): Remove . + +2003-11-09 Simon Josefsson + + * imap.el: Support for ID IMAP extension (RFC 2971). + (imap-local-variables): Add imap-id. + (imap-id): New variable. + (imap-id): New function. + (imap-parse-response): Parse untagged ID response. + * nnimap.el (nnimap-id): New variable. + (nnimap-open-connection): Use it. + +2003-12-28 Simon Josefsson + + * gnus-score.el (gnus-score-edit-all-score): New. + * gnus-group.el (gnus-group-score-map): Bind it to W e. + +2004-01-04 Simon Josefsson + + * password.el: Add. + +2004-01-04 Mario Lang + + * dns.el: Add support for AAAA records (see RFC 3596) + + * Fix typo PRT -> PTR + + * Parse MX, PTR and SOA replies (see RFC 1035) + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus.el (gnus-logo-color-style): Changed colors to `no'. + + * Moved to Changelog.2. + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump version. + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.1 is released. + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus.el: No Gnus v0.0 is released. + +2004-01-04 Lars Magne Ingebrigtsen + + * gnus.el (gnus-version-number): Bump. + (gnus-version): No. See ChangeLog.2 for earlier changes. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/assistant.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/assistant.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,487 @@ +;;; assistant.el --- guiding users through Emacs setup +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: util + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'widget) +(require 'wid-edit) + +(autoload 'gnus-error "gnus-util") +(autoload 'netrc-get "netrc") +(autoload 'netrc-machine "netrc") +(autoload 'netrc-parse "netrc") + +(defvar assistant-readers + '(("variable" assistant-variable-reader) + ("validate" assistant-sexp-reader) + ("result" assistant-list-reader) + ("next" assistant-list-reader) + ("text" assistant-text-reader))) + +(defface assistant-field '((t (:bold t))) + "Face used for editable fields." + :group 'gnus-article-emphasis) +;; backward-compatibility alias +(put 'assistant-field-face 'face-alias 'assistant-field) + +;;; Internal variables + +(defvar assistant-data nil) +(defvar assistant-current-node nil) +(defvar assistant-previous-nodes nil) +(defvar assistant-widgets nil) + +(defun assistant-parse-buffer () + (let (results command value) + (goto-char (point-min)) + (while (search-forward "@" nil t) + (if (not (looking-at "[^ \t\n]+")) + (error "Dangling @") + (setq command (downcase (match-string 0))) + (goto-char (match-end 0))) + (setq value + (if (looking-at "[ \t]*\n") + (let (start) + (forward-line 1) + (setq start (point)) + (unless (re-search-forward (concat "^@end " command) nil t) + (error "No @end %s found" command)) + (beginning-of-line) + (prog1 + (buffer-substring start (point)) + (forward-line 1))) + (skip-chars-forward " \t") + (prog1 + (buffer-substring (point) (point-at-eol)) + (forward-line 1)))) + (push (list command (assistant-reader command value)) + results)) + (assistant-segment (nreverse results)))) + +(defun assistant-text-reader (text) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (let ((start (point)) + (sections nil)) + (while (re-search-forward "@\\([^{]+\\){\\([^}]+\\)}" nil t) + (push (buffer-substring start (match-beginning 0)) + sections) + (push (list (match-string 1) (match-string 2)) + sections) + (setq start (point))) + (push (buffer-substring start (point-max)) + sections) + (nreverse sections)))) + +;; Segment the raw assistant data into a list of nodes. +(defun assistant-segment (list) + (let ((ast nil) + (node nil) + (title (pop list))) + (dolist (elem list) + (when (and (equal (car elem) "node") + node) + (push (list "save" nil) node) + (push (nreverse node) ast) + (setq node nil)) + (push elem node)) + (when node + (push (list "save" nil) node) + (push (nreverse node) ast)) + (cons title (nreverse ast)))) + +(defun assistant-reader (command value) + (let ((formatter (cadr (assoc command assistant-readers)))) + (if (not formatter) + value + (funcall formatter value)))) + +(defun assistant-list-reader (value) + (car (read-from-string (concat "(" value ")")))) + +(defun assistant-variable-reader (value) + (let ((section (car (read-from-string (concat "(" value ")"))))) + (append section (list 'default)))) + +(defun assistant-sexp-reader (value) + (if (zerop (length value)) + nil + (car (read-from-string value)))) + +(defun assistant-buffer-name (title) + (format "*Assistant %s*" title)) + +(defun assistant-get (ast command) + (cadr (assoc command ast))) + +(defun assistant-set (ast command value) + (let ((elem (assoc command ast))) + (when elem + (setcar (cdr elem) value)))) + +(defun assistant-get-list (ast command) + (let ((result nil)) + (dolist (elem ast) + (when (equal (car elem) command) + (push elem result))) + (nreverse result))) + +;;;###autoload +(defun assistant (file) + "Assist setting up Emacs based on FILE." + (interactive "fAssistant file name: ") + (let ((ast + (with-temp-buffer + (insert-file-contents file) + (assistant-parse-buffer)))) + (pop-to-buffer (assistant-buffer-name (assistant-get ast "title"))) + (assistant-render ast))) + +(defun assistant-render (ast) + (let ((first-node (assistant-get (nth 1 ast) "node"))) + (set (make-local-variable 'assistant-data) ast) + (set (make-local-variable 'assistant-current-node) nil) + (set (make-local-variable 'assistant-previous-nodes) nil) + (assistant-render-node first-node))) + +(defun assistant-find-node (node-name) + (let ((ast (cdr assistant-data))) + (while (and ast + (not (string= node-name (assistant-get (car ast) "node")))) + (pop ast)) + (car ast))) + +(defun assistant-node-name (node) + (assistant-get node "node")) + +(defun assistant-previous-node-text (node) + (format "<< Go back to %s" node)) + +(defun assistant-next-node-text (node) + (if (and node + (not (eq node 'finish))) + (format "Proceed to %s >>" node) + "Finish")) + +(defun assistant-set-defaults (node &optional forcep) + (dolist (variable (assistant-get-list node "variable")) + (setq variable (cadr variable)) + (when (or (eq (nth 3 variable) 'default) + forcep) + (setcar (nthcdr 3 variable) + (assistant-eval (nth 2 variable)))))) + +(defun assistant-get-variable (node variable &optional type raw) + (let ((variables (assistant-get-list node "variable")) + (result nil) + elem) + (while (and (setq elem (pop variables)) + (not result)) + (setq elem (cadr elem)) + (when (eq (intern variable) (car elem)) + (if type + (setq result (nth 1 elem)) + (setq result (if raw (nth 3 elem) + (format "%s" (nth 3 elem))))))) + result)) + +(defun assistant-set-variable (node variable value) + (let ((variables (assistant-get-list node "variable")) + elem) + (while (setq elem (pop variables)) + (setq elem (cadr elem)) + (when (eq (intern variable) (car elem)) + (setcar (nthcdr 3 elem) value))))) + +(defun assistant-render-text (text node) + (unless (and text node) + (gnus-error + 5 + "The assistant was asked to render invalid text or node data")) + (dolist (elem text) + (if (stringp elem) + ;; Ordinary text + (insert elem) + ;; A variable to be inserted as a widget. + (let* ((start (point)) + (variable (cadr elem)) + (type (assistant-get-variable node variable 'type))) + (cond + ((eq (car-safe type) :radio) + (push + (apply + #'widget-create + 'radio-button-choice + :assistant-variable variable + :assistant-node node + :value (assistant-get-variable node variable) + :notify (lambda (widget &rest ignore) + (assistant-set-variable + (widget-get widget :assistant-node) + (widget-get widget :assistant-variable) + (widget-value widget)) + (assistant-render-node + (assistant-get + (widget-get widget :assistant-node) + "node"))) + (cadr type)) + assistant-widgets)) + ((eq (car-safe type) :set) + (push + (apply + #'widget-create + 'set + :assistant-variable variable + :assistant-node node + :value (assistant-get-variable node variable nil t) + :notify (lambda (widget &rest ignore) + (assistant-set-variable + (widget-get widget :assistant-node) + (widget-get widget :assistant-variable) + (widget-value widget)) + (assistant-render-node + (assistant-get + (widget-get widget :assistant-node) + "node"))) + (cadr type)) + assistant-widgets)) + (t + (push + (widget-create + 'editable-field + :value-face 'assistant-field + :assistant-variable variable + (assistant-get-variable node variable)) + assistant-widgets) + ;; The editable-field widget apparently inserts a newline; + ;; remove it. + (delete-char -1) + (add-text-properties start (point) + (list + 'bold t + 'face 'assistant-field + 'not-read-only t)))))))) + +(defun assistant-render-node (node-name) + (let ((node (assistant-find-node node-name)) + (inhibit-read-only t) + (previous assistant-current-node) + (buffer-read-only nil)) + (unless node + (gnus-error 5 "The node for %s could not be found" node-name)) + (set (make-local-variable 'assistant-widgets) nil) + (assistant-set-defaults node) + (if (equal (assistant-get node "type") "interstitial") + (assistant-render-node (nth 0 (assistant-find-next-nodes node-name))) + (setq assistant-current-node node-name) + (when previous + (push previous assistant-previous-nodes)) + (erase-buffer) + (insert (cadar assistant-data) "\n\n") + (insert node-name "\n\n") + (assistant-render-text (assistant-get node "text") node) + (insert "\n\n") + (when assistant-previous-nodes + (assistant-node-button 'previous (car assistant-previous-nodes))) + (widget-create + 'push-button + :assistant-node node-name + :notify (lambda (widget &rest ignore) + (let* ((node (widget-get widget :assistant-node))) + (assistant-set-defaults (assistant-find-node node) 'force) + (assistant-render-node node))) + "Reset") + (insert "\n") + (dolist (nnode (assistant-find-next-nodes)) + (assistant-node-button 'next nnode) + (insert "\n")) + + (goto-char (point-min)) + (assistant-make-read-only)))) + +(defun assistant-make-read-only () + (let ((start (point-min)) + end) + (while (setq end (text-property-any start (point-max) 'not-read-only t)) + (put-text-property start end 'read-only t) + (put-text-property start end 'rear-nonsticky t) + (while (get-text-property end 'not-read-only) + (incf end)) + (setq start end)) + (put-text-property start (point-max) 'read-only t))) + +(defun assistant-node-button (type node) + (let ((text (if (eq type 'next) + (assistant-next-node-text node) + (assistant-previous-node-text node)))) + (widget-create + 'push-button + :assistant-node node + :assistant-type type + :notify (lambda (widget &rest ignore) + (let* ((node (widget-get widget :assistant-node)) + (type (widget-get widget :assistant-type))) + (if (eq type 'previous) + (progn + (setq assistant-current-node nil) + (pop assistant-previous-nodes)) + (assistant-get-widget-values) + (assistant-validate)) + (if (null node) + (assistant-finish) + (assistant-render-node node)))) + text) + (use-local-map widget-keymap))) + +(defun assistant-validate-types (node) + (dolist (variable (assistant-get-list node "variable")) + (setq variable (cadr variable)) + (let ((type (nth 1 variable)) + (value (nth 3 variable))) + (when + (cond + ((eq type :number) + (string-match "[^0-9]" value)) + (t + nil)) + (error "%s is not of type %s: %s" + (car variable) type value))))) + +(defun assistant-get-widget-values () + (let ((node (assistant-find-node assistant-current-node))) + (dolist (widget assistant-widgets) + (assistant-set-variable + node (widget-get widget :assistant-variable) + (widget-value widget))))) + +(defun assistant-validate () + (let* ((node (assistant-find-node assistant-current-node)) + (validation (assistant-get node "validate")) + result) + (assistant-validate-types node) + (when validation + (when (setq result (assistant-eval validation)) + (unless (y-or-n-p (format "Error: %s. Continue? " result)) + (error "%s" result)))) + (assistant-set node "save" t))) + +;; (defun assistant-find-next-node (&optional node) +;; (let* ((node (assistant-find-node (or node assistant-current-node))) +;; (node-name (assistant-node-name node)) +;; (nexts (assistant-get-list node "next")) +;; next elem applicable) + +;; (while (setq elem (pop nexts)) +;; (when (assistant-eval (car (cadr elem))) +;; (setq applicable (cons elem applicable)))) + +;; ;; return the first thing we can +;; (cadr (cadr (pop applicable))))) + +(defun assistant-find-next-nodes (&optional node) + (let* ((node (assistant-find-node (or node assistant-current-node))) + (nexts (assistant-get-list node "next")) + next elem applicable return) + + (while (setq elem (pop nexts)) + (when (assistant-eval (car (cadr elem))) + (setq applicable (cons elem applicable)))) + + ;; return the first thing we can + + (while (setq elem (pop applicable)) + (push (cadr (cadr elem)) return)) + + return)) + +(defun assistant-get-all-variables () + (let ((variables nil)) + (dolist (node (cdr assistant-data)) + (setq variables + (append (assistant-get-list node "variable") + variables))) + variables)) + +(defun assistant-eval (form) + (let ((bindings nil)) + (dolist (variable (assistant-get-all-variables)) + (setq variable (cadr variable)) + (push (list (car variable) + (if (eq (nth 3 variable) 'default) + nil + (if (listp (nth 3 variable)) + `(list ,@(nth 3 variable)) + (nth 3 variable)))) + bindings)) + (eval + `(let ,bindings + ,form)))) + +(defun assistant-finish () + (let ((results nil) + result) + (dolist (node (cdr assistant-data)) + (when (assistant-get node "save") + (setq result (assistant-get node "result")) + (push (list (car result) + (assistant-eval (cadr result))) + results))) + (message "Results: %s" + (nreverse results)))) + +;;; Validation functions. + +(defun assistant-validate-connect-to-server (server port) + (let* ((error nil) + (stream + (condition-case err + (open-network-stream "nntpd" nil server port) + (error (setq error err))))) + (if (and (processp stream) + (memq (process-status stream) '(open run))) + (progn + (delete-process stream) + nil) + error))) + +(defun assistant-authinfo-data (server port type) + (when (file-exists-p "~/.authinfo") + (netrc-get (netrc-machine (netrc-parse "~/.authinfo") + server port) + (if (eq type 'user) + "login" + "password")))) + +(defun assistant-password-required-p () + nil) + +(provide 'assistant) + +;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b +;;; assistant.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/binhex.el --- a/lisp/gnus/binhex.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/binhex.el Sun Oct 28 09:18:39 2007 +0000 @@ -27,8 +27,6 @@ ;;; Code: -(autoload 'executable-find "executable") - (eval-when-compile (require 'cl)) (eval-and-compile @@ -246,14 +244,13 @@ (setq file-name-length (char-after (point-min)) data-fork-start (+ (point-min) file-name-length 22)))) - (if (and (null header) - (with-current-buffer work-buffer - (>= (buffer-size) data-fork-start))) - (progn - (binhex-verify-crc work-buffer - (point-min) data-fork-start) - (setq header (binhex-header work-buffer)) - (if header-only (setq tmp nil counter 0)))) + (when (and (null header) + (with-current-buffer work-buffer + (>= (buffer-size) data-fork-start))) + (binhex-verify-crc work-buffer + (point-min) data-fork-start) + (setq header (binhex-header work-buffer)) + (when header-only (setq tmp nil counter 0))) (setq tmp (and tmp (not (eq inputpos end))))) (cond ((= counter 3) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/deuglify.el --- a/lisp/gnus/deuglify.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/deuglify.el Sun Oct 28 09:18:39 2007 +0000 @@ -315,71 +315,77 @@ indicating the minimum and maximum length of an unwrapped citation line. If NODISPLAY is non-nil, don't redisplay the article buffer." (interactive "P") - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks) - (no-wrap gnus-outlook-deuglify-no-wrap-chars) - (stop-chars gnus-outlook-deuglify-unwrap-stop-chars)) - (gnus-with-article-buffer - (article-goto-body) - (while (re-search-forward - (concat - "^\\([ \t" cite-marks "]*\\)" - "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n" - "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$") + (let ((case-fold-search nil) + (inhibit-read-only t) + (cite-marks gnus-outlook-deuglify-cite-marks) + (no-wrap gnus-outlook-deuglify-no-wrap-chars) + (stop-chars gnus-outlook-deuglify-unwrap-stop-chars)) + (gnus-with-article-buffer + (article-goto-body) + (while (re-search-forward + (concat + "^\\([ \t" cite-marks "]*\\)" + "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n" + "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$") nil t) - (let ((len12 (- (match-end 2) (match-beginning 1))) + (let ((len12 (- (match-end 2) (match-beginning 1))) (len3 (- (match-end 3) (match-beginning 3)))) - (if (and (> len12 gnus-outlook-deuglify-unwrap-min) + (when (and (> len12 gnus-outlook-deuglify-unwrap-min) (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max)) - (progn - (replace-match "\\1\\2 \\3") - (goto-char (match-beginning 0))))))))) + (replace-match "\\1\\2 \\3") + (goto-char (match-beginning 0))))))) (unless nodisplay (gnus-outlook-display-article-buffer))) (defun gnus-outlook-rearrange-article (attr-start) "Put the text from ATTR-START to the end of buffer at the top of the article buffer." - (save-excursion - (let ((inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - ;; article does not start with attribution - (unless (= (point) attr-start) - (gnus-kill-all-overlays) - (let ((cur (point)) - ;; before signature or end of buffer - (to (if (gnus-article-search-signature) - (point) - (point-max)))) - ;; handle the case where the full quote is below the - ;; signature - (if (< to attr-start) - (setq to (point-max))) - (transpose-regions cur attr-start attr-start to))))))) + ;; FIXME: 1. (*) text/plain ( ) text/html + (let ((inhibit-read-only t) + (cite-marks gnus-outlook-deuglify-cite-marks)) + (gnus-with-article-buffer + (article-goto-body) + ;; article does not start with attribution + (unless (= (point) attr-start) + (gnus-kill-all-overlays) + (let ((cur (point)) + ;; before signature or end of buffer + (to (if (gnus-article-search-signature) + (point) + (point-max)))) + ;; handle the case where the full quote is below the + ;; signature + (when (< to attr-start) + (setq to (point-max))) + (save-excursion + (narrow-to-region attr-start to) + (goto-char attr-start) + (forward-line) + (unless (looking-at ">") + (message-indent-citation (point) (point-max) 'yank-only) + (goto-char (point-max)) + (newline) + (setq to (point-max))) + (widen)) + (transpose-regions cur attr-start attr-start to)))))) ;; John Doe wrote in message ;; news:a87usw8$dklsssa$2@some.news.server... (defun gnus-outlook-repair-attribution-outlook () "Repair a broken attribution line (Outlook)." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward + (let ((case-fold-search nil) + (inhibit-read-only t) + (cite-marks gnus-outlook-deuglify-cite-marks)) + (gnus-with-article-buffer + (article-goto-body) + (when (re-search-forward (concat "^\\([^" cite-marks "].+\\)" "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)" "\\(.*\n?[^\n" cite-marks "].*\\)?" "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\1\\2\\4") - (match-beginning 0))))))) + (gnus-kill-all-overlays) + (replace-match "\\1\\2\\4") + (match-beginning 0))))) ;; ----- Original Message ----- @@ -390,42 +396,38 @@ (defun gnus-outlook-repair-attribution-block () "Repair a big broken attribution block." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward - (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n" + (let ((case-fold-search nil) + (inhibit-read-only t) + (cite-marks gnus-outlook-deuglify-cite-marks)) + (gnus-with-article-buffer + (article-goto-body) + (when (re-search-forward + (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n" "[^\n:]+:[ \t]*\\([^\n]+\\)\n" "\\([^\n:]+:[ \t]*[^\n]+\n\\)+") nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\1 wrote:\n") - (match-beginning 0))))))) + (gnus-kill-all-overlays) + (replace-match "\\1 wrote:\n") + (match-beginning 0))))) ;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe wrote: (defun gnus-outlook-repair-attribution-other () "Repair a broken attribution line (other user agents than Outlook)." - (save-excursion - (let ((case-fold-search nil) - (inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) - (gnus-with-article-buffer - (article-goto-body) - (if (re-search-forward + (let ((case-fold-search nil) + (inhibit-read-only t) + (cite-marks gnus-outlook-deuglify-cite-marks)) + (gnus-with-article-buffer + (article-goto-body) + (when (re-search-forward (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?" "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?" "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*" "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$") nil t) - (progn - (gnus-kill-all-overlays) - (replace-match "\\4 \\5\\6\\7") - (match-beginning 0))))))) + (gnus-kill-all-overlays) + (replace-match "\\4 \\5\\6\\7") + (match-beginning 0))))) ;;;###autoload (defun gnus-article-outlook-repair-attribution (&optional nodisplay) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/dns.el --- a/lisp/gnus/dns.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/dns.el Sun Oct 28 09:18:39 2007 +0000 @@ -51,11 +51,13 @@ (MR 9) (NULL 10) (WKS 11) - (PRT 12) + (PTR 12) (HINFO 13) (MINFO 14) (MX 15) (TXT 16) + (AAAA 28) ; RFC3596 + (SRV 33) ; RFC2782 (AXFR 252) (MAILB 253) (MAILA 254) @@ -252,6 +254,12 @@ (push (list slot qs) spec))) (nreverse spec)))) +(defun dns-read-int32 () + ;; Full 32 bit Integers can't be handled by Emacs. If we use + ;; floats, it works. + (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0) + (dns-read-bytes 3)))) + (defun dns-read-type (string type) (let ((buffer (current-buffer)) (point (point))) @@ -265,9 +273,27 @@ (dotimes (i 4) (push (dns-read-bytes 1) bytes)) (mapconcat 'number-to-string (nreverse bytes) "."))) - ((eq type 'NS) - (dns-read-string-name string buffer)) - ((eq type 'CNAME) + ((eq type 'AAAA) + (let (hextets) + (dotimes (i 8) + (push (dns-read-bytes 2) hextets)) + (mapconcat (lambda (n) (format "%x" n)) (nreverse hextets) ":"))) + ((eq type 'SOA) + (list (list 'mname (dns-read-name buffer)) + (list 'rname (dns-read-name buffer)) + (list 'serial (dns-read-int32)) + (list 'refresh (dns-read-int32)) + (list 'retry (dns-read-int32)) + (list 'expire (dns-read-int32)) + (list 'minimum (dns-read-int32)))) + ((eq type 'SRV) + (list (list 'priority (dns-read-bytes 2)) + (list 'weight (dns-read-bytes 2)) + (list 'port (dns-read-bytes 2)) + (list 'target (dns-read-name buffer)))) + ((eq type 'MX) + (cons (dns-read-bytes 2) (dns-read-name buffer))) + ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR)) (dns-read-string-name string buffer)) (t string))) (goto-char point)))) @@ -281,17 +307,32 @@ (push (match-string 1) dns-servers)) (setq dns-servers (nreverse dns-servers))))) +(defun dns-read-txt (string) + (if (> (length string) 1) + (substring string 1) + string)) + +(defun dns-get-txt-answer (answers) + (let ((result "") + (do-next nil)) + (dolist (answer answers) + (dolist (elem answer) + (when (consp elem) + (cond + ((eq (car elem) 'type) + (setq do-next (eq (cadr elem) 'TXT))) + ((eq (car elem) 'data) + (when do-next + (setq result (concat result (dns-read-txt (cadr elem)))))))))) + result)) + ;;; Interface functions. -(eval-when-compile - (when (featurep 'xemacs) - (require 'gnus-xmas))) - (defmacro dns-make-network-process (server) (if (featurep 'xemacs) `(let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) - (gnus-xmas-open-network-stream "dns" (current-buffer) - ,server "domain" 'udp)) + (open-network-stream "dns" (current-buffer) + ,server "domain" 'udp)) `(let ((server ,server) (coding-system-for-read 'binary) (coding-system-for-write 'binary)) @@ -308,13 +349,32 @@ ;; connection to the DNS server. (open-network-stream "dns" (current-buffer) server "domain"))))) -(defun query-dns (name &optional type fullp) +(defvar dns-cache (make-vector 4096 0)) + +(defun query-dns-cached (name &optional type fullp reversep) + (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) + (sym (intern-soft key dns-cache))) + (if (and sym + (boundp sym)) + (symbol-value sym) + (let ((result (query-dns name type fullp reversep))) + (set (intern key dns-cache) result) + result)))) + +(defun query-dns (name &optional type fullp reversep) "Query a DNS server for NAME of TYPE. -If FULLP, return the entire record returned." +If FULLP, return the entire record returned. +If REVERSEP, look up an IP address." (setq type (or type 'A)) (unless dns-servers (dns-parse-resolv-conf)) + (when reversep + (setq name (concat + (mapconcat 'identity (nreverse (split-string name "\\.")) ".") + ".in-addr.arpa") + type 'PTR)) + (if (not dns-servers) (message "No DNS server configuration found") (mm-with-unibyte-buffer @@ -339,6 +399,7 @@ tcp-p)) (while (and (zerop (buffer-size)) (> times 0)) + (sit-for (/ step 1000.0)) (accept-process-output process 0 step) (decf times step)) (ignore-errors @@ -347,13 +408,17 @@ (>= (buffer-size) 2)) (goto-char (point-min)) (delete-region (point) (+ (point) 2))) - (when (>= (buffer-size) 2) + (when (and (>= (buffer-size) 2) + ;; We had a time-out. + (> times 0)) (let ((result (dns-read (buffer-string)))) (if fullp result (let ((answer (car (dns-get 'answers result)))) (when (eq type (dns-get 'type answer)) - (dns-get 'data answer))))))))))) + (if (eq type 'TXT) + (dns-get-txt-answer (dns-get 'answers result)) + (dns-get 'data answer)))))))))))) (provide 'dns) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/ecomplete.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/ecomplete.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,152 @@ +;;; ecomplete.el --- electric completion of addresses and the like +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defgroup ecomplete nil + "Electric completion of email addresses and the like." + :group 'mail) + +(defcustom ecomplete-database-file "~/.ecompleterc" + "*The name of the file to store the ecomplete data." + :group 'ecomplete + :type 'file) + +(defcustom ecomplete-database-file-coding-system 'iso-2022-7bit + "Coding system used for writing the ecomplete database file." + :type '(symbol :tag "Coding system") + :group 'ecomplete) + +;;; Internal variables. + +(defvar ecomplete-database nil) + +;;;###autoload +(defun ecomplete-setup () + (when (file-exists-p ecomplete-database-file) + (with-temp-buffer + (let ((coding-system-for-read ecomplete-database-file-coding-system)) + (insert-file-contents ecomplete-database-file) + (setq ecomplete-database (read (current-buffer))))))) + +(defun ecomplete-add-item (type key text) + (let ((elems (assq type ecomplete-database)) + (now (string-to-number + (format "%.0f" (time-to-seconds (current-time))))) + entry) + (unless elems + (push (setq elems (list type)) ecomplete-database)) + (if (setq entry (assoc key (cdr elems))) + (setcdr entry (list (1+ (cadr entry)) now text)) + (nconc elems (list (list key 1 now text)))))) + +(defun ecomplete-get-item (type key) + (assoc key (cdr (assq type ecomplete-database)))) + +(defun ecomplete-save () + (with-temp-buffer + (let ((coding-system-for-write ecomplete-database-file-coding-system)) + (insert "(") + (loop for (type . elems) in ecomplete-database + do + (insert (format "(%s\n" type)) + (dolist (entry elems) + (prin1 entry (current-buffer)) + (insert "\n")) + (insert ")\n")) + (insert ")") + (write-region (point-min) (point-max) + ecomplete-database-file nil 'silent)))) + +(defun ecomplete-get-matches (type match) + (let* ((elems (cdr (assq type ecomplete-database))) + (match (regexp-quote match)) + (candidates + (sort + (loop for (key count time text) in elems + when (string-match match text) + collect (list count time text)) + (lambda (l1 l2) + (> (car l1) (car l2)))))) + (when (> (length candidates) 10) + (setcdr (nthcdr 10 candidates) nil)) + (unless (zerop (length candidates)) + (with-temp-buffer + (dolist (candidate candidates) + (insert (caddr candidate) "\n")) + (goto-char (point-min)) + (put-text-property (point) (1+ (point)) 'ecomplete t) + (while (re-search-forward match nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'isearch)) + (buffer-string))))) + +(defun ecomplete-display-matches (type word &optional choose) + (let* ((matches (ecomplete-get-matches type word)) + (line 0) + (max-lines (when matches (- (length (split-string matches "\n")) 2))) + (message-log-max nil) + command highlight) + (if (not matches) + (progn + (message "No ecomplete matches") + nil) + (if (not choose) + (progn + (message matches) + nil) + (setq highlight (ecomplete-highlight-match-line matches line)) + (while (not (memq (setq command (read-event highlight)) '(? return))) + (cond + ((eq command ?\M-n) + (setq line (min (1+ line) max-lines))) + ((eq command ?\M-p) + (setq line (max (1- line) 0)))) + (setq highlight (ecomplete-highlight-match-line matches line))) + (when (eq command 'return) + (nth line (split-string matches "\n"))))))) + +(defun ecomplete-highlight-match-line (matches line) + (with-temp-buffer + (insert matches) + (goto-char (point-min)) + (forward-line line) + (save-restriction + (narrow-to-region (point) (point-at-eol)) + (while (not (eobp)) + ;; Put the 'region face on any charactes on this line that + ;; aren't already highlighted. + (unless (get-text-property (point) 'face) + (put-text-property (point) (1+ (point)) 'face 'highlight)) + (forward-char 1))) + (buffer-string))) + +(provide 'ecomplete) + +;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72 +;;; ecomplete.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/encrypt.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/encrypt.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,296 @@ +;;; encrypt.el --- file encryption routines +;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + +;; Author: Teodor Zlatanov +;; Created: 2003/01/24 +;; Keywords: files + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; This module addresses data encryption. Page breaks are used for +;;; grouping declarations and documentation relating to each +;;; particular aspect. + +;;; Use in Gnus like this: +;;; (setq +;;; nnimap-authinfo-file "~/.authinfo.enc" +;;; nntp-authinfo-file "~/.authinfo.enc" +;;; smtpmail-auth-credentials "~/.authinfo.enc" +;;; ;; using the AES256 cipher, feel free to use your own favorite +;;; encrypt-file-alist (quote (("~/.authinfo.enc" (gpg "AES256")))) +;;; password-cache-expiry 600) + +;;; Then write ~/.authinfo.enc: + +;;; 1) open the old authinfo +;;; C-x C-f ~/.authinfo + +;;; 2) write the new authinfo.enc +;;; M-x encrypt-file-contents ~/.authinfo.enc + +;;; 3) verify the new authinfo is correct (this will show the contents in the minibuffer) +;;; M-: (encrypt-get-file-contents "~/.authinfo.enc") + + +;;; Code: + +;; autoload password +(eval-and-compile + (autoload 'password-read "password")) + +(defgroup encrypt '((password-cache custom-variable) + (password-cache-expiry custom-variable)) + "File encryption configuration." + :group 'applications) + +(defcustom encrypt-file-alist nil + "List of file names or regexes matched with encryptions. +Format example: + '((\"beta\" + (gpg \"AES\")) + (\"/home/tzz/alpha\" + (encrypt-xor \"Semi-Secret\")))" + + :type '(repeat + (list :tag "Encryption entry" + (radio :tag "What to encrypt" + (file :tag "Filename") + (regexp :tag "Regular expression match")) + (radio :tag "How to encrypt it" + (list + :tag "GPG Encryption" + (const :tag "GPG Program" gpg) + (radio :tag "Choose a cipher" + (const :tag "3DES Encryption" "3DES") + (const :tag "CAST5 Encryption" "CAST5") + (const :tag "Blowfish Encryption" "BLOWFISH") + (const :tag "AES Encryption" "AES") + (const :tag "AES192 Encryption" "AES192") + (const :tag "AES256 Encryption" "AES256") + (const :tag "Twofish Encryption" "TWOFISH") + (string :tag "Cipher Name"))) + (list + :tag "Built-in simple XOR" + (const :tag "XOR Encryption" encrypt-xor) + (string :tag "XOR Cipher Value (seed value)"))))) + :group 'encrypt) + +;; TODO: now, load gencrypt.el and if successful, modify the +;; custom-type of encrypt-file-alist to add the gencrypt.el options + +;; (plist-get (symbol-plist 'encrypt-file-alist) 'custom-type) +;; then use plist-put + +(defcustom encrypt-gpg-path (executable-find "gpg") + "Path to the GPG program." + :type '(radio + (file :tag "Location of the GPG executable") + (const :tag "GPG is not installed" nil)) + :group 'encrypt) + +(defvar encrypt-temp-prefix "encrypt" + "Prefix for temporary filenames") + +;;;###autoload +(defun encrypt-find-model (filename) + "Given a filename, find a encrypt-file-alist entry" + (dolist (entry encrypt-file-alist) + (let ((match (nth 0 entry)) + (model (nth 1 entry))) + (when (or (eq match filename) + (string-match match filename)) + (return model))))) + +;;;###autoload +(defun encrypt-insert-file-contents (file &optional model) + "Decrypt FILE into the current buffer." + (interactive "fFile to insert: ") + (let* ((model (or model (encrypt-find-model file))) + (method (nth 0 model)) + (cipher (nth 1 model)) + (password-key (format "encrypt-password-%s-%s %s" + (symbol-name method) cipher file)) + (passphrase + (password-read-and-add + (format "%s password for cipher %s (file %s)? " + file (symbol-name method) cipher) + password-key)) + (buffer-file-coding-system 'binary) + (coding-system-for-read 'binary) + outdata) + + ;; note we only insert-file-contents if the method is known to be valid + (cond + ((eq method 'gpg) + (insert-file-contents file) + (setq outdata (encrypt-gpg-decode-buffer passphrase cipher))) + ((eq method 'encrypt-xor) + (insert-file-contents file) + (setq outdata (encrypt-xor-decode-buffer passphrase cipher)))) + + (if outdata + (progn + (message "%s was decrypted with %s (cipher %s)" + file (symbol-name method) cipher) + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (insert outdata)) + ;; the decryption failed, alas + (password-cache-remove password-key) + (gnus-error 5 "%s was NOT decrypted with %s (cipher %s)" + file (symbol-name method) cipher)))) + +(defun encrypt-get-file-contents (file &optional model) + "Decrypt FILE and return the contents." + (interactive "fFile to decrypt: ") + (with-temp-buffer + (encrypt-insert-file-contents file model) + (buffer-string))) + +(defun encrypt-put-file-contents (file data &optional model) + "Encrypt the DATA to FILE, then continue normally." + (with-temp-buffer + (insert data) + (encrypt-write-file-contents file model))) + +(defun encrypt-write-file-contents (file &optional model) + "Encrypt the current buffer to FILE, then continue normally." + (interactive "sFile to write: ") + (setq model (or model (encrypt-find-model file))) + (if model + (let* ((method (nth 0 model)) + (cipher (nth 1 model)) + (password-key (format "encrypt-password-%s-%s %s" + (symbol-name method) cipher file)) + (passphrase + (password-read + (format "%s password for cipher %s? " + (symbol-name method) cipher) + password-key)) + outdata) + + (cond + ((eq method 'gpg) + (setq outdata (encrypt-gpg-encode-buffer passphrase cipher))) + ((eq method 'encrypt-xor) + (setq outdata (encrypt-xor-encode-buffer passphrase cipher)))) + + (if outdata + (progn + (message "%s was encrypted with %s (cipher %s)" + file (symbol-name method) cipher) + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (insert outdata) + ;; do not confirm overwrites + (write-file file nil)) + ;; the decryption failed, alas + (password-cache-remove password-key) + (gnus-error 5 "%s was NOT encrypted with %s (cipher %s)" + file (symbol-name method) cipher))) + (gnus-error 1 "%s has no associated encryption model! See encrypt-file-alist." file))) + +(defun encrypt-xor-encode-buffer (passphrase cipher) + (encrypt-xor-process-buffer passphrase cipher t)) + +(defun encrypt-xor-decode-buffer (passphrase cipher) + (encrypt-xor-process-buffer passphrase cipher nil)) + +(defun encrypt-xor-process-buffer (passphrase + cipher + &optional encode) + "Given PASSPHRASE, xor-encode or decode the contents of the current buffer." + (let* ((bs (buffer-substring-no-properties (point-min) (point-max))) + ;; passphrase-sum is a simple additive checksum of the + ;; passphrase and the cipher + (passphrase-sum + (when (stringp passphrase) + (apply '+ (append cipher passphrase nil)))) + new-list) + + (with-temp-buffer + (if encode + (progn + (dolist (x (append bs nil)) + (setq new-list (cons (logxor x passphrase-sum) new-list))) + + (dolist (x new-list) + (insert (format "%d " x)))) + (progn + (setq new-list (reverse (split-string bs))) + (dolist (x new-list) + (setq x (string-to-number x)) + (insert (format "%c" (logxor x passphrase-sum)))))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun encrypt-gpg-encode-buffer (passphrase cipher) + (encrypt-gpg-process-buffer passphrase cipher t)) + +(defun encrypt-gpg-decode-buffer (passphrase cipher) + (encrypt-gpg-process-buffer passphrase cipher nil)) + +(defun encrypt-gpg-process-buffer (passphrase + cipher + &optional encode) + "With PASSPHRASE, use GPG to encode or decode the current buffer." + (let* ((program encrypt-gpg-path) + (input (buffer-substring-no-properties (point-min) (point-max))) + (temp-maker (if (fboundp 'make-temp-file) + 'make-temp-file + 'make-temp-name)) + (temp-file (funcall temp-maker encrypt-temp-prefix)) + (default-enable-multibyte-characters nil) + (args `("--cipher-algo" ,cipher + "--status-fd" "2" + "--logger-fd" "2" + "--passphrase-fd" "0" + "--no-tty")) + exit-status exit-data) + + (when encode + (setq args + (append args + '("--symmetric" + "--armor")))) + + (if program + (with-temp-buffer + (when passphrase + (insert passphrase "\n")) + (insert input) + (setq exit-status + (apply #'call-process-region (point-min) (point-max) program + t `(t ,temp-file) nil args)) + (if (equal exit-status 0) + (setq exit-data + (buffer-substring-no-properties (point-min) (point-max))) + (with-temp-buffer + (when (file-exists-p temp-file) + (insert-file-contents temp-file)) + (gnus-error 5 (format "%s exited abnormally: '%s' [%s]" + program exit-status (buffer-string))))) + (delete-file temp-file)) + (gnus-error 5 "GPG is not installed.")) + exit-data)) + +(provide 'encrypt) +;;; encrypt.el ends here + +;; arch-tag: d907e4f1-71b5-42b1-a180-fc7b84ff0648 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/flow-fill.el --- a/lisp/gnus/flow-fill.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/flow-fill.el Sun Oct 28 09:18:39 2007 +0000 @@ -75,17 +75,6 @@ (sexp) (integer))) -(eval-and-compile - (defalias 'fill-flowed-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - - (defalias 'fill-flowed-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - ;;;###autoload (defun fill-flowed-encode (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -109,7 +98,7 @@ t))) ;;;###autoload -(defun fill-flowed (&optional buffer) +(defun fill-flowed (&optional buffer delete-space) (save-excursion (set-buffer (or (current-buffer) buffer)) (goto-char (point-min)) @@ -119,6 +108,8 @@ (forward-line 1)) (goto-char (point-min)) (while (re-search-forward " $" nil t) + (when delete-space + (delete-char -1)) (when (save-excursion (beginning-of-line) (looking-at "^\\(>*\\)\\( ?\\)")) @@ -153,8 +144,8 @@ (fill-column (eval fill-flowed-display-column)) filladapt-mode adaptive-fill-mode) - (fill-region (fill-flowed-point-at-bol) - (min (1+ (fill-flowed-point-at-eol)) + (fill-region (point-at-bol) + (min (1+ (point-at-eol)) (point-max)) 'left 'nosqueeze)) (error diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/format-spec.el --- a/lisp/gnus/format-spec.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/format-spec.el Sun Oct 28 09:18:39 2007 +0000 @@ -49,7 +49,7 @@ (spec (string-to-char (match-string 2))) (val (cdr (assq spec specification)))) (unless val - (error "Invalid format character: %s" spec)) + (error "Invalid format character: `%%%c'" spec)) ;; Pad result to desired length. (let ((text (format (concat "%" num "s") val))) ;; Insert first, to preserve text properties. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gmm-utils.el --- a/lisp/gnus/gmm-utils.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gmm-utils.el Sun Oct 28 09:18:39 2007 +0000 @@ -50,6 +50,19 @@ :group 'gmm) ;;;###autoload +(defun gmm-regexp-concat (regexp) + "Potentially concat a list of regexps into a single one. +The concatenation is done with logical ORs." + (cond ((null regexp) + nil) + ((stringp regexp) + regexp) + ((listp regexp) + (mapconcat (lambda (elt) (concat "\\(" elt "\\)")) + regexp + "\\|")))) + +;;;###autoload (defun gmm-message (level &rest args) "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-agent.el --- a/lisp/gnus/gnus-agent.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-agent.el Sun Oct 28 09:18:39 2007 +0000 @@ -115,7 +115,7 @@ :group 'gnus-agent :type 'function) -(defcustom gnus-agent-synchronize-flags t +(defcustom gnus-agent-synchronize-flags nil "Indicate if flags are synchronized when you plug in. If this is `ask' the hook will query the user." ;; If the default switches to something else than nil, then the function @@ -251,11 +251,24 @@ (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) +(defvar gnus-agent-inhibit-update-total-fetched-for nil) +(defvar gnus-agent-need-update-total-fetched-for nil) ;; Dynamic variables (defvar gnus-headers) (defvar gnus-score) +;; Added to support XEmacs +(eval-and-compile + (unless (fboundp 'directory-files-and-attributes) + (defun directory-files-and-attributes (directory + &optional full match nosort) + (let (result) + (dolist (file (directory-files directory full match nosort)) + (push (cons file (file-attributes file)) result)) + (nreverse result))))) + ;;; ;;; Setup ;;; @@ -290,6 +303,17 @@ ;;; Utility functions ;;; +(defmacro gnus-agent-with-refreshed-group (group &rest body) + "Performs the body then updates the group's line in the group +buffer. Automatically blocks multiple updates due to recursion." +`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) + (when (and gnus-agent-need-update-total-fetched-for + (not gnus-agent-inhibit-update-total-fetched-for)) + (save-excursion + (set-buffer gnus-group-buffer) + (setq gnus-agent-need-update-total-fetched-for nil) + (gnus-group-update-group ,group t))))) + (defun gnus-agent-read-file (file) "Load FILE and do a `read' there." (with-temp-buffer @@ -345,8 +369,8 @@ (let* ((--category--temp-- (make-symbol "--category--")) (--value--temp-- (make-symbol "--value--"))) (list (list --category--temp--) ; temporary-variables - (list category) ; value-forms - (list --value--temp--) ; store-variables + (list category) ; value-forms + (list --value--temp--) ; store-variables (let* ((category --category--temp--) ; store-form (value --value--temp--)) (list (quote gnus-agent-cat-set-property) @@ -435,6 +459,16 @@ (defsubst gnus-agent-cat-make (name &optional default-agent-predicate) (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) +(defun gnus-agent-read-group () + "Read a group name in the minibuffer, with completion." + (let ((def (or (gnus-group-group-name) gnus-newsgroup-name))) + (when def + (setq def (gnus-group-decoded-name def))) + (gnus-group-completing-read (if def + (concat "Group Name (" def "): ") + "Group Name: ") + nil nil t nil nil def))) + ;;; Fetching setup functions. (defun gnus-agent-start-fetch () @@ -892,7 +926,8 @@ (new-command-method (gnus-find-method-for-group new-group)) (new-path (directory-file-name (let (gnus-command-method new-command-method) - (gnus-agent-group-pathname new-group))))) + (gnus-agent-group-pathname new-group)))) + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-rename-file old-path new-path t) (let* ((old-real-group (gnus-group-real-name old-group)) @@ -920,7 +955,8 @@ (let* ((command-method (gnus-find-method-for-group group)) (path (directory-file-name (let (gnus-command-method command-method) - (gnus-agent-group-pathname group))))) + (gnus-agent-group-pathname group)))) + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-delete-directory path) (let* ((real-group (gnus-group-real-name group))) @@ -1285,7 +1321,8 @@ (gnus-active-to-gnus-format nil new) (gnus-agent-write-active file new) (erase-buffer) - (nnheader-insert-file-contents file)))) + (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))))) (defun gnus-agent-write-active (file new) (gnus-make-directory (file-name-directory file)) @@ -1398,6 +1435,18 @@ oactive-min (read (current-buffer))) ;; min (cons oactive-min oactive-max)))))))) +(defvar gnus-agent-decoded-group-names nil + "Alist of non-ASCII group names and decoded ones.") + +(defun gnus-agent-decoded-group-name (group) + "Return a decoded group name of GROUP." + (or (cdr (assoc group gnus-agent-decoded-group-names)) + (if (string-match "[^\000-\177]" group) + (let ((decoded (gnus-group-decoded-name group))) + (push (cons group decoded) gnus-agent-decoded-group-names) + decoded) + group))) + (defun gnus-agent-group-path (group) "Translate GROUP into a file name." @@ -1409,26 +1458,25 @@ (nnheader-translate-file-chars (nnheader-replace-duplicate-chars-in-string (nnheader-replace-chars-in-string - (gnus-group-real-name (gnus-group-decoded-name group)) + (gnus-group-real-name (gnus-agent-decoded-group-name group)) ?/ ?_) ?. ?_))) (if (or nnmail-use-long-file-names (file-directory-p (expand-file-name group (gnus-agent-directory)))) group - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system))) + (nnheader-replace-chars-in-string group ?. ?/))) (defun gnus-agent-group-pathname (group) "Translate GROUP into a file name." ;; nnagent uses nnmail-group-pathname to read articles while ;; unplugged. The agent must, therefore, use the same directory ;; while plugged. - (let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group)))) - (nnmail-group-pathname (gnus-group-real-name - (gnus-group-decoded-name group)) - (gnus-agent-directory)))) + (nnmail-group-pathname + (gnus-group-real-name (gnus-agent-decoded-group-name group)) + (if gnus-command-method + (gnus-agent-directory) + (let ((gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-directory))))) (defun gnus-agent-get-function (method) (if (gnus-online method) @@ -1532,7 +1580,8 @@ (dir (gnus-agent-group-pathname group)) (date (time-to-days (current-time))) (case-fold-search t) - pos crosses id) + pos crosses id + (file-name-coding-system nnmail-pathname-coding-system)) (setcar selected-sets (nreverse (car selected-sets))) (setq selected-sets (nreverse selected-sets)) @@ -1601,33 +1650,46 @@ (setq pos (cdr pos))))) (gnus-agent-save-alist group (cdr fetched-articles) date) + (gnus-agent-update-files-total-fetched-for group (cdr fetched-articles)) + (gnus-message 7 "")) (cdr fetched-articles)))))) (defun gnus-agent-unfetch-articles (group articles) "Delete ARTICLES that were fetched from GROUP into the agent." (when articles - (gnus-agent-load-alist group) - (let* ((alist (cons nil gnus-agent-article-alist)) - (articles (sort articles #'<)) - (next-possibility alist) - (delete-this (pop articles))) - (while (and (cdr next-possibility) delete-this) - (let ((have-this (caar (cdr next-possibility)))) - (cond ((< delete-this have-this) - (setq delete-this (pop articles))) - ((= delete-this have-this) - (let ((timestamp (cdar (cdr next-possibility)))) - (when timestamp - (let* ((file-name (concat (gnus-agent-group-pathname group) - (number-to-string have-this)))) - (delete-file file-name)))) - - (setcdr next-possibility (cddr next-possibility))) - (t - (setq next-possibility (cdr next-possibility)))))) - (setq gnus-agent-article-alist (cdr alist)) - (gnus-agent-save-alist group)))) + (gnus-agent-with-refreshed-group + group + (gnus-agent-load-alist group) + (let* ((alist (cons nil gnus-agent-article-alist)) + (articles (sort articles #'<)) + (next-possibility alist) + (delete-this (pop articles))) + (while (and (cdr next-possibility) delete-this) + (let ((have-this (caar (cdr next-possibility)))) + (cond + ((< delete-this have-this) + (setq delete-this (pop articles))) + ((= delete-this have-this) + (let ((timestamp (cdar (cdr next-possibility)))) + (when timestamp + (let* ((file-name (concat (gnus-agent-group-pathname group) + (number-to-string have-this))) + (size-file + (float (or (and gnus-agent-total-fetched-hashtb + (nth 7 (file-attributes file-name))) + 0))) + (file-name-coding-system + nnmail-pathname-coding-system)) + (delete-file file-name) + (gnus-agent-update-files-total-fetched-for + group (- size-file))))) + + (setcdr next-possibility (cddr next-possibility))) + (t + (setq next-possibility (cdr next-possibility)))))) + (setq gnus-agent-article-alist (cdr alist)) + (gnus-agent-save-alist group))))) (defun gnus-agent-crosspost (crosses article &optional date) (setq date (or date t)) @@ -1651,8 +1713,9 @@ (when (= (point-max) (point-min)) (push (cons group (current-buffer)) gnus-agent-buffer-alist) (ignore-errors - (nnheader-insert-file-contents - (gnus-agent-article-name ".overview" group)))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (nnheader-insert-file-contents + (gnus-agent-article-name ".overview" group))))) (nnheader-find-nov-line (string-to-number (cdar crosses))) (insert (string-to-number (cdar crosses))) (insert-buffer-substring gnus-agent-overview-buffer beg end) @@ -1663,7 +1726,8 @@ (when gnus-newsgroup-name (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name)) (cnt 0) - name) + name + (file-name-coding-system nnmail-pathname-coding-system)) (while (file-exists-p (setq name (concat root "~" (int-to-string (setq cnt (1+ cnt))) "~")))) @@ -1697,7 +1761,7 @@ (gnus-message 1 "Overview buffer contains garbage '%s'." (buffer-substring - p (gnus-point-at-eol)))) + p (point-at-eol)))) ((= cur prev-num) (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) @@ -1715,25 +1779,71 @@ (setq prev-num cur))) (forward-line 1))))))) +(defun gnus-agent-flush-server (&optional server-or-method) + "Flush all agent index files for every subscribed group within + the given SERVER-OR-METHOD. When called with nil, the current + value of gnus-command-method identifies the server." + (let* ((gnus-command-method (if server-or-method + (gnus-server-to-method server-or-method) + gnus-command-method)) + (alist gnus-newsrc-alist)) + (while alist + (let ((entry (pop alist))) + (when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry)) + (gnus-agent-flush-group (gnus-info-group entry))))))) + +(defun gnus-agent-flush-group (group) + "Flush the agent's index files such that the GROUP no longer +appears to have any local content. The actual content, the +article files, may then be deleted using gnus-agent-expire-group. +If flushing was a mistake, the gnus-agent-regenerate-group method +provides an undo mechanism by reconstructing the index files from +the article files." + (interactive (list (gnus-agent-read-group))) + + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (overview (gnus-agent-article-name ".overview" group)) + (agentview (gnus-agent-article-name ".agentview" group)) + (file-name-coding-system nnmail-pathname-coding-system)) + + (if (file-exists-p overview) + (delete-file overview)) + (if (file-exists-p agentview) + (delete-file agentview)) + + (gnus-agent-update-view-total-fetched-for group nil gnus-command-method) + (gnus-agent-update-view-total-fetched-for group t gnus-command-method) + + ;(gnus-agent-set-local group nil nil) + ;(gnus-agent-save-local t) + (gnus-agent-save-group-info nil group nil))) + (defun gnus-agent-flush-cache () + "Flush the agent's index files such that the group no longer +appears to have any local content. The actual content, the +article files, is then deleted using gnus-agent-expire-group. The +gnus-agent-regenerate-group method provides an undo mechanism by +reconstructing the index files from the article files." + (interactive) (save-excursion - (while gnus-agent-buffer-alist - (set-buffer (cdar gnus-agent-buffer-alist)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) - (gnus-agent-article-name ".overview" - (caar gnus-agent-buffer-alist)) - nil 'silent)) - (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) - (while gnus-agent-group-alist - (with-temp-file (gnus-agent-article-name - ".agentview" (caar gnus-agent-group-alist)) - (princ (cdar gnus-agent-group-alist)) - (insert "\n") - (princ 1 (current-buffer)) - (insert "\n")) - (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (while gnus-agent-buffer-alist + (set-buffer (cdar gnus-agent-buffer-alist)) + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) + (gnus-agent-article-name ".overview" + (caar gnus-agent-buffer-alist)) + nil 'silent)) + (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist))) + (while gnus-agent-group-alist + (with-temp-file (gnus-agent-article-name + ".agentview" (caar gnus-agent-group-alist)) + (princ (cdar gnus-agent-group-alist)) + (insert "\n") + (princ 1 (current-buffer)) + (insert "\n")) + (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))) ;;;###autoload (defun gnus-agent-find-parameter (group symbol) @@ -1777,7 +1887,8 @@ (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) - (file (gnus-agent-article-name ".overview" group))) + (file (gnus-agent-article-name ".overview" group)) + (file-name-coding-system nnmail-pathname-coding-system)) (unless fetch-all ;; Add articles with marks to the list of article headers we want to @@ -1857,6 +1968,7 @@ gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) (write-region (point-min) (point-max) file nil 'silent)) + (gnus-agent-update-view-total-fetched-for group t) (gnus-agent-save-alist group articles nil) articles) (ignore-errors @@ -1926,21 +2038,21 @@ (gnus-agent-copy-nov-line (pop articles)) (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) + (while articles + (while (let ((art (read (current-buffer)))) + (cond ((< art (car articles)) + (forward-line 1) + t) + ((= art (car articles)) + (beginning-of-line) + (delete-region + (point) (progn (forward-line 1) (point))) + nil) + (t + (beginning-of-line) + nil)))) + + (gnus-agent-copy-nov-line (pop articles))))) (goto-char (point-max)) @@ -1957,26 +2069,26 @@ (setq last (or last -134217728)) (while (catch 'problems - (let (sort art) - (while (not (eobp)) - (setq art (gnus-agent-read-article-number)) - (cond ((not art) - ;; Bad art num - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ((< art last) - ;; Art num out of order - enable sort - (setq sort t) - (forward-line 1)) + (let (sort art) + (while (not (eobp)) + (setq art (gnus-agent-read-article-number)) + (cond ((not art) + ;; Bad art num - delete this line + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ((< art last) + ;; Art num out of order - enable sort + (setq sort t) + (forward-line 1)) ((= art last) ;; Bad repeat of art number - delete this line (beginning-of-line) (delete-region (point) (progn (forward-line 1) (point)))) - (t - ;; Good art num - (setq last art) - (forward-line 1)))) - (when sort + (t + ;; Good art num + (setq last art) + (forward-line 1)))) + (when sort ;; something is seriously wrong as we simply shouldn't see out-of-order data. ;; First, we'll fix the sort. (sort-numeric-fields 1 (point-min) (point-max)) @@ -1998,7 +2110,8 @@ (defun gnus-agent-load-alist (group) "Load the article-state alist for GROUP." ;; Bind free variable that's used in `gnus-agent-read-agentview'. - (let ((gnus-agent-read-agentview group)) + (let ((gnus-agent-read-agentview group) + (file-name-coding-system nnmail-pathname-coding-system)) (setq gnus-agent-article-alist (gnus-cache-file-contents (gnus-agent-article-name ".agentview" group) @@ -2009,52 +2122,63 @@ "Load FILE and do a `read' there." (with-temp-buffer (condition-case nil - (progn - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version) - - (cond - ((= version 0) - (let ((inhibit-quit t) - entry) - (gnus-agent-open-history) - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (match-string 2) - gnus-agent-read-agentview) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (gnus-agent-close-history) - (setq changed-version t))) - ((= version 1) - (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) - ((= version 2) - (let (uncomp) - (mapcar - (lambda (comp-list) - (let ((state (car comp-list)) - (sequence (inline - (gnus-uncompress-range - (cdr comp-list))))) - (mapcar (lambda (article-id) - (setq uncomp (cons (cons article-id state) uncomp))) - sequence))) - alist) + (progn + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let ((alist (read (current-buffer))) + (version (condition-case nil (read (current-buffer)) + (end-of-file 0))) + changed-version) + + (cond + ((= version 0) + (let ((inhibit-quit t) + entry) + (gnus-agent-open-history) + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (if (and (looking-at + "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") + (string= (match-string 2) + gnus-agent-read-agentview) + (setq entry (assoc (string-to-number (match-string 3)) alist))) + (setcdr entry (string-to-number (match-string 1)))) + (forward-line 1)) + (gnus-agent-close-history) + (setq changed-version t))) + ((= version 1) + (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) + ((= version 2) + (let (state sequence uncomp) + (while alist + (setq state (caar alist) + sequence (inline (gnus-uncompress-range (cdar alist))) + alist (cdr alist)) + (while sequence + (push (cons (pop sequence) state) uncomp))) (setq alist (sort uncomp 'car-less-than-car))) (setq changed-version (not (= 2 gnus-agent-article-alist-save-format))))) - (when changed-version - (let ((gnus-agent-article-alist alist)) - (gnus-agent-save-alist gnus-agent-read-agentview))) - alist)) - (file-error nil)))) + (when changed-version + (let ((gnus-agent-article-alist alist)) + (gnus-agent-save-alist gnus-agent-read-agentview))) + alist)) + ((end-of-file file-error) + ;; The agentview file is missing. + (condition-case nil + ;; If the agent directory exists, attempt to perform a brute-force + ;; reconstruction of its contents. + (let* (alist + (file-name-coding-system nnmail-pathname-coding-system) + (file-attributes (directory-files-and-attributes + (gnus-agent-article-name "" + gnus-agent-read-agentview) nil "^[0-9]+$" t))) + (while file-attributes + (let ((fa (pop file-attributes))) + (unless (nth 1 fa) + (push (cons (string-to-number (nth 0 fa)) (time-to-days (nth 5 fa))) alist)))) + alist) + (file-error nil)))))) (defun gnus-agent-save-alist (group &optional articles state) "Save the article-state alist for GROUP." @@ -2085,27 +2209,27 @@ (cond ((eq gnus-agent-article-alist-save-format 1) (princ gnus-agent-article-alist (current-buffer))) ((eq gnus-agent-article-alist-save-format 2) - (let ((compressed nil)) - (mapcar (lambda (pair) - (let* ((article-id (car pair)) - (day-of-download (cdr pair)) - (comp-list (assq day-of-download compressed))) - (if comp-list - (setcdr comp-list - (cons article-id (cdr comp-list))) - (setq compressed - (cons (list day-of-download article-id) - compressed))) - nil)) gnus-agent-article-alist) - (mapcar (lambda (comp-list) - (setcdr comp-list - (gnus-compress-sequence - (nreverse (cdr comp-list))))) - compressed) + (let ((alist gnus-agent-article-alist) + article-id day-of-download comp-list compressed) + (while alist + (setq article-id (caar alist) + day-of-download (cdar alist) + comp-list (assq day-of-download compressed) + alist (cdr alist)) + (if comp-list + (setcdr comp-list (cons article-id (cdr comp-list))) + (push (list day-of-download article-id) compressed))) + (setq alist compressed) + (while alist + (setq comp-list (pop alist)) + (setcdr comp-list + (gnus-compress-sequence (nreverse (cdr comp-list))))) (princ compressed (current-buffer))))) (insert "\n") (princ gnus-agent-article-alist-save-format (current-buffer)) - (insert "\n")))) + (insert "\n")) + + (gnus-agent-update-view-total-fetched-for group nil))) (defvar gnus-agent-article-local nil) (defvar gnus-agent-file-loading-local nil) @@ -2183,10 +2307,10 @@ (dest (gnus-agent-lib-file "local"))) (gnus-make-directory (gnus-agent-lib-file "")) - (let ((buffer-file-coding-system gnus-agent-file-coding-system)) + (let ((coding-system-for-write gnus-agent-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file dest (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - (file-name-coding-system nnmail-pathname-coding-system) print-level print-length item article (standard-output (current-buffer))) (mapatoms (lambda (symbol) @@ -2197,11 +2321,11 @@ (t (let ((range (symbol-value symbol))) (when range - (prin1 symbol) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) + (prin1 symbol) + (princ " ") + (princ (car range)) + (princ " ") + (princ (cdr range)) (princ "\n")))))) my-obarray)))))))) @@ -2462,8 +2586,8 @@ (when gnus-agent-mark-unread-after-downloaded (setq gnus-newsgroup-downloadable (delq article gnus-newsgroup-downloadable)) - (gnus-summary-mark-article - article gnus-unread-mark)) + (gnus-summary-mark-article + article gnus-unread-mark)) (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-download-mark article))) (dolist (article unfetched-articles) @@ -2654,7 +2778,7 @@ (gnus-category-position-point))) (defun gnus-category-name () - (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category)) + (or (intern (get-text-property (point-at-bol) 'gnus-category)) (error "No category on the current line"))) (defun gnus-category-read () @@ -2975,22 +3099,12 @@ if ARTICLES is t, all articles. if ARTICLES is a list, just those articles. FORCE is equivalent to setting the expiration predicates to true." - (interactive - (list (let ((def (or (gnus-group-group-name) - gnus-newsgroup-name))) - (let ((select (read-string (if def - (concat "Group Name (" - def "): ") - "Group Name: ")))) - (if (and (equal "" select) - def) - def - select))))) + (interactive (list (gnus-agent-read-group))) (if (not group) (gnus-agent-expire articles group force) (let ( ;; Bind gnus-agent-expire-stats to enable tracking of - ;; expiration statistics of this single group + ;; expiration statistics of this single group (gnus-agent-expire-stats (list 0 0 0.0))) (if (or (not (eq articles t)) (yes-or-no-p @@ -3020,337 +3134,375 @@ ;; gnus-command-method, initialized overview buffer, and to have ;; provided a non-nil active - (let ((dir (gnus-agent-group-pathname group))) - (when (boundp 'gnus-agent-expire-current-dirs) - (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) - - (if (and (not force) - (eq 'DISABLE (gnus-agent-find-parameter group - 'agent-enable-expiration))) - (gnus-message 5 "Expiry skipping over %s" group) - (gnus-message 5 "Expiring articles in %s" group) - (gnus-agent-load-alist group) - (let* ((bytes-freed 0) - (files-deleted 0) - (nov-entries-deleted 0) - (info (gnus-get-info group)) - (alist gnus-agent-article-alist) - (day (- (time-to-days (current-time)) - (gnus-agent-find-parameter group 'agent-days-until-old))) - (specials (if (and alist - (not force)) - ;; This could be a bit of a problem. I need to - ;; keep the last article to avoid refetching - ;; headers when using nntp in the backend. At - ;; the same time, if someone uses a backend - ;; that supports article moving then I may have - ;; to remove the last article to complete the - ;; move. Right now, I'm going to assume that - ;; FORCE overrides specials. - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function - ;; parameter - nil) - ((not articles) - ;; Unread articles are marked protected from - ;; expiration Don't call - ;; gnus-list-of-unread-articles as it returns - ;; articles that have not been fetched into the - ;; agent. - (ignore-errors - (gnus-agent-unread-articles group))) - (t - ;; All articles EXCEPT those named by the caller - ;; are protected from expiration - (gnus-sorted-difference - (gnus-uncompress-range - (cons (caar alist) - (caar (last alist)))) - (sort articles '<))))) - (marked ;; More articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function - ;; parameter - nil) - (articles - ;; All articles may as well be unmarked as the - ;; unreads list already names the articles we are - ;; going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded - ;; from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precidence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) - - (set-buffer overview) - (erase-buffer) - (buffer-disable-undo) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) - - (let (p) - (while (< (setq p (point)) (point-max)) - (condition-case nil - ;; If I successfully read an integer (the plus zero - ;; ensures a numeric type), prepend a marker entry - ;; to the list - (push (list (+ 0 (read (current-buffer))) nil nil - (set-marker (make-marker) p)) - dlist) - (error - (gnus-message 1 "gnus-agent-expire: read error \ + (let ((dir (gnus-agent-group-pathname group)) + (file-name-coding-system nnmail-pathname-coding-system) + (decoded (gnus-agent-decoded-group-name group))) + (gnus-agent-with-refreshed-group + group + (when (boundp 'gnus-agent-expire-current-dirs) + (set 'gnus-agent-expire-current-dirs + (cons dir + (symbol-value 'gnus-agent-expire-current-dirs)))) + + (if (and (not force) + (eq 'DISABLE (gnus-agent-find-parameter group + 'agent-enable-expiration))) + (gnus-message 5 "Expiry skipping over %s" decoded) + (gnus-message 5 "Expiring articles in %s" decoded) + (gnus-agent-load-alist group) + (let* ((bytes-freed 0) + (size-files-deleted 0.0) + (files-deleted 0) + (nov-entries-deleted 0) + (info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (day (- (time-to-days (current-time)) + (gnus-agent-find-parameter group 'agent-days-until-old))) + (specials (if (and alist + (not force)) + ;; This could be a bit of a problem. I need to + ;; keep the last article to avoid refetching + ;; headers when using nntp in the backend. At + ;; the same time, if someone uses a backend + ;; that supports article moving then I may have + ;; to remove the last article to complete the + ;; move. Right now, I'm going to assume that + ;; FORCE overrides specials. + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function + ;; parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call + ;; gnus-list-of-unread-articles as it returns + ;; articles that have not been fetched into the + ;; agent. + (ignore-errors + (gnus-agent-unread-articles group))) + (t + ;; All articles EXCEPT those named by the caller + ;; are protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) + (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function + ;; parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded + ;; from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + dlist + type) + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse + ;; the process to generate the expired article alist. + + ;; Convert the alist elements to (article# fetch_date nil + ;; nil). + (setq dlist (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) alist)) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precidence of the + ;; keep_flag. + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'special nil)) + specials))) + + (set-buffer overview) + (erase-buffer) + (buffer-disable-undo) + (when (file-exists-p nov-file) + (gnus-message 7 "gnus-agent-expire: Loading overview...") + (nnheader-insert-file-contents nov-file) + (goto-char (point-min)) + + (let (p) + (while (< (setq p (point)) (point-max)) + (condition-case nil + ;; If I successfully read an integer (the plus zero + ;; ensures a numeric type), append the position + ;; to the list + (push (list (+ 0 (read (current-buffer))) nil nil + p) + dlist) + (error + (gnus-message 1 "gnus-agent-expire: read error \ occurred when reading expression at %s in %s. Skipping to next \ line." (point) nov-file))) - ;; Whether I succeeded, or failed, it doesn't matter. - ;; Move to the next line then try again. - (forward-line 1))) - - (gnus-message - 7 "gnus-agent-expire: Loading overview... Done")) - (set-buffer-modified-p nil) - - ;; At this point, all of the information is in dlist. The - ;; only problem is that much of it is spread across multiple - ;; entries. Sort then MERGE!! - (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same article-number then sort by - ;; ascending keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) - 3)) - (b (or (symbol-value (nth 2 b)) - 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) - (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 - (/ (setq cnt (1+ cnt)) - len)))) - message-log-max) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 7 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (gnus-agent-message 10 - "gnus-agent-expire: %s:%d: Kept %s article%s." - group article-number keep (if fetch-date " and file" "")) - (when fetch-date - (unless (file-exists-p - (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-agent-message 3 "gnus-agent-expire cleared \ + ;; Whether I succeeded, or failed, it doesn't matter. + ;; Move to the next line then try again. + (forward-line 1))) + + (gnus-message + 7 "gnus-agent-expire: Loading overview... Done")) + (set-buffer-modified-p nil) + + ;; At this point, all of the information is in dlist. The + ;; only problem is that much of it is spread across multiple + ;; entries. Sort then MERGE!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same article-number then sort by + ;; ascending keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) + 3)) + (b (or (symbol-value (nth 2 b)) + 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) + (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; NOV_entry_position + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + + ;; Check the order of the entry positions. They should be in + ;; ascending order. If they aren't, the positions must be + ;; converted to markers. + (when (catch 'sort-results + (let ((dlist dlist) + (prev-pos -1) + pos) + (while dlist + (if (setq pos (nth 3 (pop dlist))) + (if (< pos prev-pos) + (throw 'sort-results 'unsorted) + (setq prev-pos pos)))))) + (gnus-message 7 "gnus-agent-expire: Unsorted overview; inserting markers to compensate.") + (mapc (lambda (entry) + (let ((pos (nth 3 entry))) + (if pos + (setf (nth 3 entry) + (set-marker (make-marker) + pos))))) + dlist)) + + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist) + (position-offset 0) + ) + + (while dlist + (let ((new-completed (truncate (* 100.0 + (/ (setq cnt (1+ cnt)) + len)))) + message-log-max) + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 7 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (gnus-agent-message 10 + "gnus-agent-expire: %s:%d: Kept %s article%s." + decoded article-number keep (if fetch-date " and file" "")) + (when fetch-date + (unless (file-exists-p + (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-agent-message 3 "gnus-agent-expire cleared \ download flag on %s:%d as the cached article file is missing." - group (caar dlist))) - (unless marker - (gnus-message 1 "gnus-agent-expire detected a \ + decoded (caar dlist))) + (unless marker + (gnus-message 1 "gnus-agent-expire detected a \ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) - (gnus-agent-append-to-list - tail-alist - (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and - ;; ORDINARY. See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) + (gnus-agent-append-to-list + tail-alist + (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and + ;; ORDINARY. See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) 'read) ;; never fetched article (may expire - ;; right now) - ((not (file-exists-p - (concat dir (number-to-string - article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached - ;; article. Handle case - ;; as though this article - ;; was never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (let* ((file-name (nnheader-concat dir (number-to-string - article-number))) - (size (float (nth 7 (file-attributes file-name))))) - (incf bytes-freed size) - (incf files-deleted) - (delete-file file-name)) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil) - ) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - - (incf nov-entries-deleted) - - (let ((from (gnus-point-at-bol)) - (to (progn (forward-line 1) (point)))) - (incf bytes-freed (- to from)) - (delete-region from to))) - - ;; If considering all articles is set, I can only - ;; expire article IDs that are no longer in the - ;; active range (That is, articles that preceed the - ;; first article in the new alist). - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date)) - (push (format "Removed %s article number from \ + ;; right now) + ((not (file-exists-p + (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case + ;; as though this article + ;; was never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (let* ((file-name (nnheader-concat dir (number-to-string + article-number))) + (size (float (nth 7 (file-attributes file-name))))) + (incf bytes-freed size) + (incf size-files-deleted size) + (incf files-deleted) + (delete-file file-name)) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + + (goto-char (if (markerp marker) + marker + (- marker position-offset))) + + (incf nov-entries-deleted) + + (let* ((from (point-at-bol)) + (to (progn (forward-line 1) (point))) + (freed (- to from))) + (incf bytes-freed freed) + (incf position-offset freed) + (delete-region from to))) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range (That is, articles that preceed the + ;; first article in the new alist). + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date)) + (push (format "Removed %s article number from \ article alist" type) actions)) - (when actions - (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" - group article-number - (mapconcat 'identity actions ", "))))) - (t - (gnus-agent-message - 10 "gnus-agent-expire: %s:%d: Article kept as \ -expiration tests failed." group article-number) - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer - ;; over several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil - 'silent) - ;; clear the modified flag as that I'm not confused by - ;; its status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info)))) - - (when (boundp 'gnus-agent-expire-stats) - (let ((stats (symbol-value 'gnus-agent-expire-stats))) - (incf (nth 2 stats) bytes-freed) - (incf (nth 1 stats) files-deleted) - (incf (nth 0 stats) nov-entries-deleted))) - )))) + (when actions + (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" + decoded article-number + (mapconcat 'identity actions ", "))))) + (t + (gnus-agent-message + 10 "gnus-agent-expire: %s:%d: Article kept as \ +expiration tests failed." decoded article-number) + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date))) + ) + + ;; Remove markers as I intend to reuse this buffer again. + (when (and marker + (markerp marker)) + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist group)) + + (when (buffer-modified-p) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (gnus-make-directory dir) + (write-region (point-min) (point-max) nov-file nil + 'silent) + ;; clear the modified flag as that I'm not confused by + ;; its status on the next pass through this routine. + (set-buffer-modified-p nil) + (gnus-agent-update-view-total-fetched-for group t))) + + (when (eq articles t) + (gnus-summary-update-info)))) + + (when (boundp 'gnus-agent-expire-stats) + (let ((stats (symbol-value 'gnus-agent-expire-stats))) + (incf (nth 2 stats) bytes-freed) + (incf (nth 1 stats) files-deleted) + (incf (nth 0 stats) nov-entries-deleted))) + + (gnus-agent-update-files-total-fetched-for group (- size-files-deleted))))))) (defun gnus-agent-expire (&optional articles group force) "Expire all old articles. @@ -3428,7 +3580,8 @@ ;; compiler will not complain about free references. (gnus-agent-expire-current-dirs (symbol-value 'gnus-agent-expire-current-dirs)) - dir) + dir + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-sethash gnus-agent-directory t keep) (while gnus-agent-expire-current-dirs @@ -3485,6 +3638,7 @@ (let ((dir (pop to-remove))) (if (gnus-y-or-n-p (format "Delete %s? " dir)) (let* (delete-recursive + files f (delete-recursive (function (lambda (f-or-d) @@ -3493,12 +3647,13 @@ (condition-case nil (delete-directory f-or-d) (file-error - (mapcar (lambda (f) - (or (member f '("." "..")) - (funcall delete-recursive - (nnheader-concat - f-or-d f)))) - (directory-files f-or-d)) + (setq files (directory-files f-or-d)) + (while files + (setq f (pop files)) + (or (member f '("." "..")) + (funcall delete-recursive + (nnheader-concat + f-or-d f)))) (delete-directory f-or-d))) (delete-file f-or-d))))))) (funcall delete-recursive dir)))))))))) @@ -3582,7 +3737,8 @@ (let ((gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) (file (gnus-agent-article-name ".overview" group)) - cached-articles uncached-articles) + cached-articles uncached-articles + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file) t)) @@ -3685,6 +3841,8 @@ (gnus-agent-check-overview-buffer) (write-region (point-min) (point-max) file nil 'silent)) + (gnus-agent-update-view-total-fetched-for group t) + ;; Update the group's article alist to include the newly ;; fetched articles. (gnus-agent-load-alist group) @@ -3715,7 +3873,8 @@ (numberp article)) (let* ((gnus-command-method (gnus-find-method-for-group group)) (file (gnus-agent-article-name (number-to-string article) group)) - (buffer-read-only nil)) + (buffer-read-only nil) + (file-name-coding-system nnmail-pathname-coding-system)) (when (and (file-exists-p file) (> (nth 7 (file-attributes file)) 0)) (erase-buffer) @@ -3732,16 +3891,7 @@ the articles' current headers. If REREAD is not nil, downloaded articles are marked as unread." (interactive - (list (let ((def (or (gnus-group-group-name) - gnus-newsgroup-name))) - (let ((select (read-string (if def - (concat "Group Name (" - def "): ") - "Group Name: ")))) - (if (and (equal "" select) - def) - def - select))) + (list (gnus-agent-read-group) (catch 'mark (while (let (c (cursor-in-echo-area t) @@ -3759,199 +3909,200 @@ (sit-for 1) t))))) (when group - (gnus-message 5 "Regenerating in %s" group) - (let* ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group))) - (file (gnus-agent-article-name ".overview" group)) - (dir (file-name-directory file)) - point - (downloaded (if (file-exists-p dir) + (gnus-message 5 "Regenerating in %s" group) + (let* ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (file (gnus-agent-article-name ".overview" group)) + (dir (file-name-directory file)) + point + (file-name-coding-system nnmail-pathname-coding-system) + (downloaded (if (file-exists-p dir) (sort (delq nil (mapcar (lambda (name) (and (not (file-directory-p (nnheader-concat dir name))) (string-to-number name))) (directory-files dir nil "^[0-9]+$" t))) - '>) - (progn (gnus-make-directory dir) nil))) - dl nov-arts - alist header - regenerated) - - (mm-with-unibyte-buffer - (if (file-exists-p file) - (let ((nnheader-file-coding-system - gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file))) - (set-buffer-modified-p nil) - - ;; Load the article IDs found in the overview file. As a - ;; side-effect, validate the file contents. - (let ((load t)) - (while load - (setq load nil) - (goto-char (point-min)) - (while (< (point) (point-max)) - (cond ((and (looking-at "[0-9]+\t") - (<= (- (match-end 0) (match-beginning 0)) 9)) - (push (read (current-buffer)) nov-arts) - (forward-line 1) - (let ((l1 (car nov-arts)) - (l2 (cadr nov-arts))) - (cond ((and (listp reread) (memq l1 reread)) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + '>) + (progn (gnus-make-directory dir) nil))) + dl nov-arts + alist header + regenerated) + + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((nnheader-file-coding-system + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (set-buffer-modified-p nil) + + ;; Load the article IDs found in the overview file. As a + ;; side-effect, validate the file contents. + (let ((load t)) + (while load + (setq load nil) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond ((and (looking-at "[0-9]+\t") + (<= (- (match-end 0) (match-beginning 0)) 9)) + (push (read (current-buffer)) nov-arts) + (forward-line 1) + (let ((l1 (car nov-arts)) + (l2 (cadr nov-arts))) + (cond ((and (listp reread) (memq l1 reread)) + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ entry of article %s deleted." l1)) - ((not l2) - nil) - ((< l1 l2) - (gnus-message 3 "gnus-agent-regenerate-group: NOV\ + ((not l2) + nil) + ((< l1 l2) + (gnus-message 3 "gnus-agent-regenerate-group: NOV\ entries are NOT in ascending order.") - ;; Don't sort now as I haven't verified - ;; that every line begins with a number - (setq load t)) - ((= l1 l2) - (forward-line -1) - (gnus-message 4 "gnus-agent-regenerate-group: NOV\ - entries contained duplicate of article %s. Duplicate deleted." l1) - (gnus-delete-line) - (setq nov-arts (cdr nov-arts)))))) - (t - (gnus-message 1 "gnus-agent-regenerate-group: NOV\ + ;; Don't sort now as I haven't verified + ;; that every line begins with a number + (setq load t)) + ((= l1 l2) + (forward-line -1) + (gnus-message 4 "gnus-agent-regenerate-group: NOV\ + entries contained duplicate of article %s. Duplicate deleted." l1) + (gnus-delete-line) + (setq nov-arts (cdr nov-arts)))))) + (t + (gnus-message 1 "gnus-agent-regenerate-group: NOV\ entries contained line that did not begin with an article number. Deleted\ line.") - (gnus-delete-line)))) - (when load - (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ + (gnus-delete-line)))) + (when load + (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\ entries into ascending order.") - (sort-numeric-fields 1 (point-min) (point-max)) - (setq nov-arts nil)))) - (gnus-agent-check-overview-buffer) - - ;; Construct a new article alist whose nodes match every header - ;; in the .overview file. As a side-effect, missing headers are - ;; reconstructed from the downloaded article file. - (while (or downloaded nov-arts) - (cond ((and downloaded - (or (not nov-arts) - (> (car downloaded) (car nov-arts)))) - ;; This entry is missing from the overview file - (gnus-message 3 "Regenerating NOV %s %d..." group - (car downloaded)) - (let ((file (concat dir (number-to-string (car downloaded))))) - (mm-with-unibyte-buffer - (nnheader-insert-file-contents file) - (nnheader-remove-body) - (setq header (nnheader-parse-naked-head))) - (mail-header-set-number header (car downloaded)) - (if nov-arts - (let ((key (concat "^" (int-to-string (car nov-arts)) - "\t"))) - (or (re-search-backward key nil t) - (re-search-forward key)) - (forward-line 1)) - (goto-char (point-min))) - (nnheader-insert-nov header)) - (setq nov-arts (cons (car downloaded) nov-arts))) - ((eq (car downloaded) (car nov-arts)) - ;; This entry in the overview has been downloaded - (push (cons (car downloaded) - (time-to-days - (nth 5 (file-attributes - (concat dir (number-to-string - (car downloaded))))))) alist) - (setq downloaded (cdr downloaded)) - (setq nov-arts (cdr nov-arts))) - (t - ;; This entry in the overview has not been downloaded - (push (cons (car nov-arts) nil) alist) - (setq nov-arts (cdr nov-arts))))) - - ;; When gnus-agent-consider-all-articles is set, - ;; gnus-agent-regenerate-group should NOT remove article IDs from - ;; the alist. Those IDs serve as markers to indicate that an - ;; attempt has been made to fetch that article's header. - - ;; When gnus-agent-consider-all-articles is NOT set, - ;; gnus-agent-regenerate-group can remove the article ID of every - ;; article (with the exception of the last ID in the list - it's - ;; special) that no longer appears in the overview. In this - ;; situtation, the last article ID in the list implies that it, - ;; and every article ID preceeding it, have been fetched from the - ;; server. - - (if gnus-agent-consider-all-articles - ;; Restore all article IDs that were not found in the overview file. - (let* ((n (cons nil alist)) - (merged n) - (o (gnus-agent-load-alist group))) - (while o - (let ((nID (caadr n)) - (oID (caar o))) - (cond ((not nID) - (setq n (setcdr n (list (list oID)))) - (setq o (cdr o))) - ((< oID nID) - (setcdr n (cons (list oID) (cdr n))) - (setq o (cdr o))) - ((= oID nID) - (setq o (cdr o)) - (setq n (cdr n))) - (t - (setq n (cdr n)))))) - (setq alist (cdr merged))) - ;; Restore the last article ID if it is not already in the new alist - (let ((n (last alist)) - (o (last (gnus-agent-load-alist group)))) - (cond ((not o) - nil) - ((not n) - (push (cons (caar o) nil) alist)) - ((< (caar n) (caar o)) - (setcdr n (list (car o))))))) - - (let ((inhibit-quit t)) - (if (setq regenerated (buffer-modified-p)) - (let ((coding-system-for-write gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) file nil 'silent))) - - (setq regenerated (or regenerated - (and reread gnus-agent-article-alist) - (not (equal alist gnus-agent-article-alist)))) - - (setq gnus-agent-article-alist alist) - - (when regenerated - (gnus-agent-save-alist group) - - ;; I have to alter the group's active range NOW as - ;; gnus-make-ascending-articles-unread will use it to - ;; recalculate the number of unread articles in the group - - (let ((group (gnus-group-real-name group)) - (group-active (or (gnus-active group) - (gnus-activate-group group)))) - (gnus-agent-possibly-alter-active group group-active))))) - - (when (and reread gnus-agent-article-alist) + (sort-numeric-fields 1 (point-min) (point-max)) + (setq nov-arts nil)))) + (gnus-agent-check-overview-buffer) + + ;; Construct a new article alist whose nodes match every header + ;; in the .overview file. As a side-effect, missing headers are + ;; reconstructed from the downloaded article file. + (while (or downloaded nov-arts) + (cond ((and downloaded + (or (not nov-arts) + (> (car downloaded) (car nov-arts)))) + ;; This entry is missing from the overview file + (gnus-message 3 "Regenerating NOV %s %d..." group + (car downloaded)) + (let ((file (concat dir (number-to-string (car downloaded))))) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (nnheader-remove-body) + (setq header (nnheader-parse-naked-head))) + (mail-header-set-number header (car downloaded)) + (if nov-arts + (let ((key (concat "^" (int-to-string (car nov-arts)) + "\t"))) + (or (re-search-backward key nil t) + (re-search-forward key)) + (forward-line 1)) + (goto-char (point-min))) + (nnheader-insert-nov header)) + (setq nov-arts (cons (car downloaded) nov-arts))) + ((eq (car downloaded) (car nov-arts)) + ;; This entry in the overview has been downloaded + (push (cons (car downloaded) + (time-to-days + (nth 5 (file-attributes + (concat dir (number-to-string + (car downloaded))))))) alist) + (setq downloaded (cdr downloaded)) + (setq nov-arts (cdr nov-arts))) + (t + ;; This entry in the overview has not been downloaded + (push (cons (car nov-arts) nil) alist) + (setq nov-arts (cdr nov-arts))))) + + ;; When gnus-agent-consider-all-articles is set, + ;; gnus-agent-regenerate-group should NOT remove article IDs from + ;; the alist. Those IDs serve as markers to indicate that an + ;; attempt has been made to fetch that article's header. + + ;; When gnus-agent-consider-all-articles is NOT set, + ;; gnus-agent-regenerate-group can remove the article ID of every + ;; article (with the exception of the last ID in the list - it's + ;; special) that no longer appears in the overview. In this + ;; situtation, the last article ID in the list implies that it, + ;; and every article ID preceeding it, have been fetched from the + ;; server. + + (if gnus-agent-consider-all-articles + ;; Restore all article IDs that were not found in the overview file. + (let* ((n (cons nil alist)) + (merged n) + (o (gnus-agent-load-alist group))) + (while o + (let ((nID (caadr n)) + (oID (caar o))) + (cond ((not nID) + (setq n (setcdr n (list (list oID)))) + (setq o (cdr o))) + ((< oID nID) + (setcdr n (cons (list oID) (cdr n))) + (setq o (cdr o))) + ((= oID nID) + (setq o (cdr o)) + (setq n (cdr n))) + (t + (setq n (cdr n)))))) + (setq alist (cdr merged))) + ;; Restore the last article ID if it is not already in the new alist + (let ((n (last alist)) + (o (last (gnus-agent-load-alist group)))) + (cond ((not o) + nil) + ((not n) + (push (cons (caar o) nil) alist)) + ((< (caar n) (caar o)) + (setcdr n (list (car o))))))) + + (let ((inhibit-quit t)) + (if (setq regenerated (buffer-modified-p)) + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent))) + + (setq regenerated (or regenerated + (and reread gnus-agent-article-alist) + (not (equal alist gnus-agent-article-alist)))) + + (setq gnus-agent-article-alist alist) + + (when regenerated + (gnus-agent-save-alist group) + + ;; I have to alter the group's active range NOW as + ;; gnus-make-ascending-articles-unread will use it to + ;; recalculate the number of unread articles in the group + + (let ((group (gnus-group-real-name group)) + (group-active (or (gnus-active group) + (gnus-activate-group group)))) + (gnus-agent-possibly-alter-active group group-active))))) + + (when (and reread gnus-agent-article-alist) (gnus-agent-synchronize-group-flags - group + group (list (list - (if (listp reread) - reread - (delq nil (mapcar (function (lambda (c) - (cond ((eq reread t) - (car c)) - ((cdr c) - (car c))))) + (if (listp reread) + reread + (delq nil (mapcar (function (lambda (c) + (cond ((eq reread t) + (car c)) + ((cdr c) + (car c))))) gnus-agent-article-alist))) 'del '(read))) gnus-command-method) - (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t))) - - (gnus-message 5 "") - regenerated))) + (when regenerated + (gnus-agent-update-files-total-fetched-for group nil))) + + (gnus-message 5 "") + regenerated))) ;;;###autoload (defun gnus-agent-regenerate (&optional clean reread) @@ -3996,6 +4147,84 @@ (defun gnus-agent-group-covered-p (group) (gnus-agent-method-p (gnus-group-method group))) +(defun gnus-agent-update-files-total-fetched-for + (group delta &optional method path) + "Update, or set, the total disk space used by the articles that the +agent has fetched." + (when gnus-agent-total-fetched-hashtb + (gnus-agent-with-refreshed-group + group + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (or path (gnus-agent-group-pathname group))) + (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) + (gnus-sethash path (make-list 3 0) + gnus-agent-total-fetched-hashtb))) + (file-name-coding-system nnmail-pathname-coding-system)) + (when (listp delta) + (if delta + (let ((sum 0.0) + file) + (while (setq file (pop delta)) + (incf sum (float (or (nth 7 (file-attributes + (nnheader-concat + path + (if (numberp file) + (number-to-string file) + file)))) 0)))) + (setq delta sum)) + (let ((sum (- (nth 2 entry))) + (info (directory-files-and-attributes path nil "^-?[0-9]+$" t)) + file) + (while (setq file (pop info)) + (incf sum (float (or (nth 8 file) 0)))) + (setq delta sum)))) + + (setq gnus-agent-need-update-total-fetched-for t) + (incf (nth 2 entry) delta))))) + +(defun gnus-agent-update-view-total-fetched-for + (group agent-over &optional method path) + "Update, or set, the total disk space used by the .agentview and +.overview files. These files are calculated separately as they can be +modified." + (when gnus-agent-total-fetched-hashtb + (gnus-agent-with-refreshed-group + group + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (or path (gnus-agent-group-pathname group))) + (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) + (gnus-sethash path (make-list 3 0) + gnus-agent-total-fetched-hashtb))) + (file-name-coding-system nnmail-pathname-coding-system) + (size (or (nth 7 (file-attributes + (nnheader-concat + path (if agent-over + ".overview" + ".agentview")))) + 0))) + (setq gnus-agent-need-update-total-fetched-for t) + (setf (nth (if agent-over 1 0) entry) size))))) + +(defun gnus-agent-total-fetched-for (group &optional method no-inhibit) + "Get the total disk space used by the specified GROUP." + (unless (equal group "dummy.group") + (unless gnus-agent-total-fetched-hashtb + (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024))) + + ;; if null, gnus-agent-group-pathname will calc method. + (let* ((gnus-command-method method) + (path (gnus-agent-group-pathname group)) + (entry (gnus-gethash path gnus-agent-total-fetched-hashtb))) + (if entry + (apply '+ entry) + (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit))) + (+ + (gnus-agent-update-view-total-fetched-for group nil method path) + (gnus-agent-update-view-total-fetched-for group t method path) + (gnus-agent-update-files-total-fetched-for group nil method path))))))) + (provide 'gnus-agent) ;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-art.el Sun Oct 28 09:18:39 2007 +0000 @@ -33,7 +33,10 @@ (defvar w3m-minor-mode-map)) (require 'gnus) -(require 'gnus-sum) +;; Avoid the "Recursive load suspected" error in Emacs 21.1. +(eval-and-compile + (let ((recursive-load-depth-limit 100)) + (require 'gnus-sum))) (require 'gnus-spec) (require 'gnus-int) (require 'gnus-win) @@ -49,6 +52,8 @@ (autoload 'gnus-button-mailto "gnus-msg") (autoload 'gnus-button-reply "gnus-msg" nil t) (autoload 'parse-time-string "parse-time" nil nil) +(autoload 'ansi-color-apply-on-region "ansi-color") +(autoload 'mm-url-insert-file-contents-external "mm-url") (autoload 'mm-extern-cache-contents "mm-extern") (defgroup gnus-article nil @@ -153,7 +158,10 @@ "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" - "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) + "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer" + "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane" + "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At" + "Envelope-Sender" "Envelope-Recipients")) "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -238,7 +246,9 @@ longer (in lines) than that number. If it is a function, the function will be called without any parameters, and if it returns nil, there is no signature in the buffer. If it is a string, it will be used as a -regexp. If it matches, the text in question is not a signature." +regexp. If it matches, the text in question is not a signature. + +This can also be a list of the above values." :type '(choice (const nil) (integer :value 200) (number :value 4.0) @@ -412,7 +422,7 @@ (widget-group-value-create widget)) regexp (integer :format "Match group: %v") - (integer :format "Emphasize group: %v") + (integer :format "Emphasize group: %v") face) (group :tag "Simple" :value (("_" . "_") nil default) @@ -480,14 +490,14 @@ "Face used for displaying highlighted words." :group 'gnus-article-emphasis) -(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" +(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z" "Format for display of Date headers in article bodies. See `format-time-string' for the possible values. The variable can also be function, which should return a complete Date header. The function is called with one argument, the time, which can be fed to `format-time-string'." - :type '(choice string symbol) + :type '(choice string function) :link '(custom-manual "(gnus)Article Date") :group 'gnus-article-washing) @@ -645,17 +655,18 @@ '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. +This variable is an alist where the key is the match and the +value is a list of possible files to save in if the match is +non-nil. If the match is a string, it is used as a regexp match on the article. If the match is a symbol, that symbol will be funcalled from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evalled in the same buffer. - -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names." +parameter. If it is a list, it will be evaled in the same buffer. + +If this form or function returns a string, this string will be used as a +possible file name; and if it returns a non-nil list, that list will be +used as possible file names." :group 'gnus-article-saving :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) @@ -701,10 +712,22 @@ :type 'hook :group 'gnus-article-various) +(defcustom gnus-copy-article-ignored-headers nil + "List of headers to be removed when copying an article. +Each element is a regular expression." + :version "23.0" ;; No Gnus + :type '(repeat regexp) + :group 'gnus-article-various) + (make-obsolete-variable 'gnus-article-hide-pgp-hook "This variable is obsolete in Gnus 5.10.") -(defcustom gnus-article-button-face 'bold +(defface gnus-button + '((t (:weight bold))) + "Face used for highlighting a button in the article buffer." + :group 'gnus-article-buttons) + +(defcustom gnus-article-button-face 'gnus-button "Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing @@ -739,7 +762,7 @@ (defface gnus-header-from '((((class color) (background dark)) - (:foreground "spring green")) + (:foreground "PaleGreen1")) (((class color) (background light)) (:foreground "red3")) @@ -754,7 +777,7 @@ (defface gnus-header-subject '((((class color) (background dark)) - (:foreground "SeaGreen3")) + (:foreground "SeaGreen1")) (((class color) (background light)) (:foreground "red4")) @@ -786,7 +809,7 @@ (defface gnus-header-name '((((class color) (background dark)) - (:foreground "SeaGreen")) + (:foreground "SpringGreen2")) (((class color) (background light)) (:foreground "maroon")) @@ -801,7 +824,7 @@ (defface gnus-header-content '((((class color) (background dark)) - (:foreground "forest green" :italic t)) + (:foreground "SpringGreen1" :italic t)) (((class color) (background light)) (:foreground "indianred4" :italic t)) @@ -838,6 +861,31 @@ (item :tag "skip" nil) (face :value default))))) +(defcustom gnus-face-properties-alist (if (featurep 'xemacs) + '((xface . (:face gnus-x-face))) + '((pbm . (:face gnus-x-face)) + (png . nil))) + "Alist of image types and properties applied to Face and X-Face images. +Here are examples: + +;; Specify the altitude of Face images in the From header. +\(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :ascent 80)) + (png . (:ascent 80)))) + +;; Show Face images as pressed buttons. +\(setq gnus-face-properties-alist + '((pbm . (:face gnus-x-face :relief -2)) + (png . (:relief -2)))) + +See the manual for the valid properties for various image types. +Currently, `pbm' is used for X-Face images and `png' is used for Face +images in Emacs. Only the `:face' property is effective on the `xface' +image type in XEmacs if it is built with the libcompface library." + :version "23.0" ;; No Gnus + :group 'gnus-article-headers + :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) + (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-encoded-words article-decode-group-name article-decode-idna-rhs) @@ -954,7 +1002,7 @@ "An alist of MIME types to functions to display them." :version "21.1" :group 'gnus-article-mime - :type 'alist) + :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) (defcustom gnus-article-date-lapsed-new-header nil "Whether the X-Sent and Date headers can coexist. @@ -985,6 +1033,7 @@ (defcustom gnus-mime-action-alist '(("save to file" . gnus-mime-save-part) ("save and strip" . gnus-mime-save-part-and-strip) + ("replace with file" . gnus-mime-replace-part) ("delete part" . gnus-mime-delete-part) ("display as text" . gnus-mime-inline-part) ("view the part" . gnus-mime-view-part) @@ -999,6 +1048,19 @@ :type '(repeat (cons (string :tag "name") (function)))) +(defcustom gnus-auto-select-part 1 + "Advance to next MIME part when deleting or stripping parts. + +When 0, point will be placed on the same part as before. When +positive (negative), move point forward (backwards) this many +parts. When nil, redisplay article." + :version "23.0" ;; No Gnus + :group 'gnus-article-mime + :type '(choice (const nil :tag "Redisplay article.") + (const 1 :tag "Next part.") + (const 0 :tag "Current part.") + integer)) + ;;; ;;; The treatment variables ;;; @@ -1010,6 +1072,7 @@ '(choice (const :tag "Off" nil) (const :tag "On" t) (const :tag "Header" head) + (const :tag "First" first) (const :tag "Last" last) (integer :tag "Less") (repeat :tag "Groups" regexp) @@ -1019,7 +1082,8 @@ '(choice (const :tag "Off" nil) (const :tag "Header" head))) -(defvar gnus-article-treat-types '("text/plain") +(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim" + "text/x-patch") "Parts to treat.") (defvar gnus-inhibit-treatment nil @@ -1027,8 +1091,8 @@ (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) "Highlight the signature. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles'." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1036,8 +1100,8 @@ (defcustom gnus-treat-buttonize 100000 "Add buttons. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles'." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1045,8 +1109,8 @@ (defcustom gnus-treat-buttonize-head 'head "Add buttons to the head. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) @@ -1054,12 +1118,11 @@ (defcustom gnus-treat-emphasize (and (or window-system - (featurep 'xemacs) - (>= (string-to-number emacs-version) 21)) + (featurep 'xemacs)) 50000) "Emphasize text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1067,8 +1130,8 @@ (defcustom gnus-treat-strip-cr nil "Remove carriage returns. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1076,8 +1139,8 @@ (defcustom gnus-treat-unsplit-urls nil "Remove newlines from within URLs. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1085,8 +1148,8 @@ (defcustom gnus-treat-leading-whitespace nil "Remove leading whitespace in headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1094,56 +1157,56 @@ (defcustom gnus-treat-hide-headers 'head "Hide headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-boring-headers nil "Hide boring headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-signature nil "Hide the signature. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-fill-article nil "Fill the article. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation nil "Hide cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation-maybe nil "Hide cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-list-identifiers 'head "Strip list identifiers from `gnus-list-identifiers`. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1154,8 +1217,8 @@ (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1163,16 +1226,16 @@ (defcustom gnus-treat-strip-banner t "Strip banners from articles. The banner to be stripped is specified in the `banner' group parameter. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-highlight-headers 'head "Highlight the headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) @@ -1180,8 +1243,8 @@ (defcustom gnus-treat-highlight-citation t "Highlight cited text. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) @@ -1189,24 +1252,24 @@ (defcustom gnus-treat-date-ut nil "Display the Date in UT (GMT). -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-local nil "Display the Date in the local timezone. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-english nil "Display the Date in a format that can be read aloud in English. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1214,24 +1277,24 @@ (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-original nil "Display the date in the original timezone. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-iso8601 nil "Display the date in the ISO8601 format. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1240,16 +1303,16 @@ (defcustom gnus-treat-date-user-defined nil "Display the date in a user-defined format. The format is defined by the `gnus-article-time-format' variable. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-strip-headers-in-body t "Strip the X-No-Archive header line from the beginning of the body. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1257,8 +1320,8 @@ (defcustom gnus-treat-strip-trailing-blank-lines nil "Strip trailing blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'. When set to t, it also strips trailing blanks in all MIME parts. Consider to use `last' instead." @@ -1268,8 +1331,8 @@ (defcustom gnus-treat-strip-leading-blank-lines nil "Strip leading blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'. When set to t, it also strips trailing blanks in all MIME parts." :group 'gnus-article-treat @@ -1278,25 +1341,37 @@ (defcustom gnus-treat-strip-multiple-blank-lines nil "Strip multiple blank lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-unfold-headers 'head "Unfold folded header lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) +(defcustom gnus-article-unfold-long-headers nil + "If non-nil, allow unfolding headers even if the header is long. +If it is a regexp, only long headers matching this regexp are unfolded. +If it is t, all long headers are unfolded. + +This variable has no effect if `gnus-treat-unfold-headers' is nil." + :version "23.0" ;; No Gnus + :group 'gnus-article-treat + :type '(choice (const nil) + (const :tag "all" t) + (regexp))) + (defcustom gnus-treat-fold-headers nil "Fold headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1304,8 +1379,8 @@ (defcustom gnus-treat-fold-newsgroups 'head "Fold the Newsgroups and Followup-To headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1313,13 +1388,21 @@ (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) +(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t) + "Treat ANSI SGR control sequences. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + (make-obsolete-variable 'gnus-treat-display-xface 'gnus-treat-display-x-face) @@ -1364,9 +1447,9 @@ (gnus-image-type-available-p 'png) 'head) "Display Face headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)X-Face' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)X-Face' for details." :group 'gnus-article-treat :version "22.1" :link '(custom-manual "(gnus)Customizing Articles") @@ -1376,9 +1459,9 @@ (defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm) "Display smileys. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Smileys' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Smileys' for details." :group 'gnus-article-treat :version "21.1" :link '(custom-manual "(gnus)Customizing Articles") @@ -1391,9 +1474,9 @@ (gnus-picons-installed-p)) 'head nil) "Display picons in the From header. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Picons' for details." :version "22.1" :group 'gnus-article-treat :group 'gnus-picon @@ -1407,9 +1490,9 @@ (gnus-picons-installed-p)) 'head nil) "Display picons in To and Cc headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Picons' for details." :version "22.1" :group 'gnus-article-treat :group 'gnus-picon @@ -1423,9 +1506,9 @@ (gnus-picons-installed-p)) 'head nil) "Display picons in the Newsgroups and Followup-To headers. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' and Info node -`(gnus)Picons' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Picons' for details." :version "22.1" :group 'gnus-article-treat :group 'gnus-picon @@ -1435,9 +1518,10 @@ (put 'gnus-treat-newsgroups-picon 'highlight t) (defcustom gnus-treat-body-boundary - (if (or gnus-treat-newsgroups-picon - gnus-treat-mail-picon - gnus-treat-from-picon) + (if (and (eq window-system 'x) + (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon)) 'head nil) "Draw a boundary at the end of the headers. Valid values are nil and `head'. @@ -1449,8 +1533,8 @@ (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1458,8 +1542,8 @@ (defcustom gnus-treat-wash-html nil "Format as HTML. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1467,16 +1551,16 @@ (defcustom gnus-treat-fill-long-lines nil "Fill long lines. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-play-sounds nil "Play sounds. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1484,8 +1568,8 @@ (defcustom gnus-treat-translate nil "Translate articles from one language to another. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") @@ -1494,8 +1578,8 @@ (defcustom gnus-treat-x-pgp-sig nil "Verify X-PGP-Sig. To automatically treat X-PGP-Sig, set it to head. -Valid values are nil, t, `head', `last', an integer or a predicate. -See Info node `(gnus)Customizing Articles' for details." +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." :version "22.1" :group 'gnus-article-treat :group 'mime-security @@ -1581,9 +1665,10 @@ (gnus-treat-strip-multiple-blank-lines gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) + (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences) (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) + (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-fold-headers gnus-article-treat-fold-headers) - (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) @@ -1814,12 +1899,9 @@ (save-excursion (save-restriction (let ((inhibit-read-only t) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) + (inhibit-point-motion-hooks t)) (article-narrow-to-head) - (while list - (setq elem (pop list)) + (dolist (elem gnus-boring-article-headers) (goto-char (point-min)) (cond ;; Hide empty headers. @@ -1827,7 +1909,7 @@ (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (gnus-point-at-bol) + (point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1957,7 +2039,7 @@ (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (gnus-point-at-bol) + (point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1978,7 +2060,7 @@ (article-narrow-to-head) (while (not (eobp)) (cond - ((< (setq column (- (gnus-point-at-eol) (point))) + ((< (setq column (- (point-at-eol) (point))) gnus-article-normalized-header-length) (end-of-line) (insert (make-string @@ -1989,7 +2071,7 @@ (progn (forward-char gnus-article-normalized-header-length) (point)) - (gnus-point-at-eol) + (point-at-eol) 'invisible t)) (t ;; Do nothing. @@ -2031,9 +2113,8 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (save-excursion (when (article-goto-body) - (let ((inhibit-read-only t) - elem) - (while (setq elem (pop map)) + (let ((inhibit-read-only t)) + (dolist (elem map) (save-excursion (while (search-forward (car elem) nil t) (replace-match (cadr elem))))))))) @@ -2064,6 +2145,14 @@ (put-text-property (point) (1+ (point)) 'face 'underline))))))))) +(defun article-treat-ansi-sequences () + "Translate ANSI SGR control sequences into overlays or extents." + (interactive) + (save-excursion + (when (article-goto-body) + (let ((inhibit-read-only t)) + (ansi-color-apply-on-region (point) (point-max)))))) + (defun gnus-article-treat-unfold-headers () "Unfold folded message headers. Only the headers that fit into the current window width will be @@ -2074,16 +2163,21 @@ (while (not (eobp)) (save-restriction (mail-header-narrow-to-field) - (let ((header (buffer-string))) + (let* ((header (buffer-string)) + (unfoldable + (or (equal gnus-article-unfold-long-headers t) + (and (stringp gnus-article-unfold-long-headers) + (string-match gnus-article-unfold-long-headers header))))) (with-temp-buffer (insert header) (goto-char (point-min)) (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) - (setq length (- (point-max) (point-min) 1))) - (when (< length (window-width)) - (while (re-search-forward "\n[\t ]" nil t) - (replace-match " " t t))) + (setq length (- (point-max) (point-min) 1)) + (when (or unfoldable + (< length (window-width))) + (while (re-search-forward "\n[\t ]" nil t) + (replace-match " " t t)))) (goto-char (point-max))))))) (defun gnus-article-treat-fold-headers () @@ -2130,6 +2224,39 @@ (mail-header-fold-field) (goto-char (point-max)))))) +(defcustom gnus-article-truncate-lines default-truncate-lines + "Value of `truncate-lines' in Gnus Article buffer. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles'." + :version "23.0" ;; No Gnus + :group 'gnus-article + ;; :link '(custom-manual "(gnus)Customizing Articles") + :type 'boolean) + +(defun gnus-article-toggle-truncate-lines (&optional arg) + "Toggle whether to fold or truncate long lines in article the buffer. +If ARG is non-nil and not a number, toggle +`gnus-article-truncate-lines' too. If ARG is a number, truncate +long lines iff arg is positive." + (interactive "P") + (cond + ((and (numberp arg) (> arg 0)) + (setq gnus-article-truncate-lines t)) + ((numberp arg) + (setq gnus-article-truncate-lines nil)) + (arg + (setq gnus-article-truncate-lines + (not gnus-article-truncate-lines)))) + (gnus-with-article-buffer + (cond + ((and (numberp arg) (> arg 0)) + (setq truncate-lines nil)) + ((numberp arg) + (setq truncate-lines t))) + ;; In versions of Emacs 22 (CVS) before 2006-05-26, + ;; `toggle-truncate-lines' needs an argument. + (toggle-truncate-lines))) + (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." (interactive) @@ -2160,7 +2287,7 @@ (end-of-line) (when (>= (current-column) (min fill-column width)) (narrow-to-region (min (1+ (point)) (point-max)) - (gnus-point-at-bol)) + (point-at-bol)) (let ((goback (point-marker))) (fill-paragraph nil) (goto-char (marker-position goback))) @@ -2202,11 +2329,14 @@ (while (and (not (bobp)) (looking-at "^[ \t]*$") (not (gnus-annotation-in-region-p - (point) (gnus-point-at-eol)))) + (point) (point-at-eol)))) (forward-line -1)) (forward-line 1) (point)))))) +(eval-when-compile + (defvar gnus-face-properties-alist)) + (defun article-display-face () "Display any Face headers in the header." (interactive) @@ -2239,7 +2369,9 @@ (insert "[no `from' set]\n")) (while faces (when (setq png (gnus-convert-face-to-png (pop faces))) - (setq image (gnus-create-image png 'png t)) + (setq image + (apply 'gnus-create-image png 'png t + (cdr (assq 'png gnus-face-properties-alist)))) (goto-char from) (gnus-add-wash-type 'face) (gnus-add-image 'face image) @@ -2311,14 +2443,12 @@ (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) + (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) - (inhibit-read-only t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (mail-decode-encoded-word-region (point-min) (point-max))))) (defun article-decode-charset (&optional prompt) @@ -2395,44 +2525,31 @@ (goto-char (setq end start))))) (defun article-decode-group-name () - "Decode group names in `Newsgroups:'." + "Decode group names in Newsgroups, Followup-To and Xref headers." (let ((inhibit-point-motion-hooks t) (inhibit-read-only t) - (method (gnus-find-method-for-group gnus-newsgroup-name))) + (method (gnus-find-method-for-group gnus-newsgroup-name)) + regexp) (when (and (or gnus-group-name-charset-method-alist gnus-group-name-charset-group-alist) (gnus-buffer-live-p gnus-original-article-buffer)) (save-restriction (article-narrow-to-head) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)) - (goto-char (point-min)) - (with-current-buffer gnus-original-article-buffer - (goto-char (point-min))) - (while (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) - (replace-match (save-match-data - (gnus-decode-newsgroups - ;; XXX how to use data in article buffer? - (with-current-buffer gnus-original-article-buffer - (re-search-forward - "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" - nil t) - (match-string 1)) - gnus-newsgroup-name method)) - t t nil 1)))))) + (dolist (header '("Newsgroups" "Followup-To" "Xref")) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (setq regexp (concat "^" header + ":\\([^\n]*\\(?:\n[\t ]+[^\n]+\\)*\\)\n")) + (while (re-search-forward regexp nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward regexp nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)) + (goto-char (point-min))))))) (autoload 'idna-to-unicode "idna") @@ -2628,6 +2745,104 @@ "-I" (symbol-name charset) "-O" (symbol-name charset)))) (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html"))) +(defvar gnus-article-browse-html-temp-list nil + "List of temporary files created by `gnus-article-browse-html-parts'. +Internal variable.") + +(defcustom gnus-article-browse-delete-temp 'ask + "What to do with temporary files from `gnus-article-browse-html-parts'. +If nil, don't delete temporary files. If it is t, delete them on +exit from the summary buffer. If it is the symbol `file', query +on each file, if it is `ask' ask once when exiting from the +summary buffer." + :group 'gnus-article + :version "23.0" ;; No Gnus + :type '(choice (const :tag "Don't delete" nil) + (const :tag "Don't ask" t) + (const :tag "Ask" ask) + (const :tag "Ask for each file" file))) + +;; Cf. mm-postponed-undisplay-list / mm-destroy-postponed-undisplay-list. + +(defun gnus-article-browse-delete-temp-files (&optional how) + "Delete temp-files created by `gnus-article-browse-html-parts'." + (when (and gnus-article-browse-html-temp-list + (or how + (setq how gnus-article-browse-delete-temp))) + (when (and (eq how 'ask) + (y-or-n-p (format + "Delete all %s temporary HTML file(s)? " + (length gnus-article-browse-html-temp-list))) + (setq how t))) + (dolist (file gnus-article-browse-html-temp-list) + (when (and (file-exists-p file) + (or (eq how t) + ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'): + (gnus-y-or-n-p + (format "Delete temporary HTML file `%s'? " file)))) + (delete-file file))) + ;; Also remove file from the list when not deleted or if file doesn't + ;; exist anymore. + (setq gnus-article-browse-html-temp-list nil)) + gnus-article-browse-html-temp-list) + +(defun gnus-article-browse-html-parts (list) + "View all \"text/html\" parts from LIST. +Recurse into multiparts." + ;; Internal function used by `gnus-article-browse-html-article'. + (let ((showed)) + ;; Find and show the html-parts. + (dolist (handle list) + ;; If HTML, show it: + (when (listp handle) + (cond ((and (bufferp (car handle)) + (string-match "text/html" (car (mm-handle-type handle)))) + (let ((tmp-file (mm-make-temp-file + ;; Do we need to care for 8.3 filenames? + "mm-" nil ".html"))) + (mm-save-part-to-file handle tmp-file) + (add-to-list 'gnus-article-browse-html-temp-list tmp-file) + (add-hook 'gnus-summary-prepare-exit-hook + 'gnus-article-browse-delete-temp-files) + (add-hook 'gnus-exit-gnus-hook + (lambda () + (gnus-article-browse-delete-temp-files t))) + ;; FIXME: Warn if there's an tag? + (browse-url-of-file tmp-file) + (setq showed t))) + ;; If multipart, recurse + ((and (stringp (car handle)) + (string-match "^multipart/" (car handle)) + (setq showed + (or showed + (gnus-article-browse-html-parts handle)))))))) + showed)) + +;; FIXME: Documentation in texi/gnus.texi missing. +(defun gnus-article-browse-html-article () + "View \"text/html\" parts of the current article with a WWW browser. + +Warning: Spammers use links to images in HTML articles to verify +whether you have read the message. As +`gnus-article-browse-html-article' passes the unmodified HTML +content to the browser without eliminating these \"web bugs\" you +should only use it for mails from trusted senders." + ;; Cf. `mm-w3m-safe-url-regexp' + (interactive) + (save-window-excursion + ;; Open raw article and select the buffer + (gnus-summary-show-article t) + (gnus-summary-select-article-buffer) + (let ((parts (mm-dissect-buffer t t))) + ;; If singlepart, enforce a list. + (when (and (bufferp (car parts)) + (stringp (car (mm-handle-type parts)))) + (setq parts (list parts))) + ;; Process the list + (unless (gnus-article-browse-html-parts parts) + (gnus-error 3 "Mail doesn't contain a \"text/html\" part!")) + (gnus-summary-show-article)))) + (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." @@ -2732,11 +2947,9 @@ "Translate article using an online translation service." (interactive) (require 'babel) - (save-excursion - (set-buffer gnus-article-buffer) + (gnus-with-article-buffer (when (article-goto-body) - (let* ((inhibit-read-only t) - (start (point)) + (let* ((start (point)) (end (point-max)) (orig (buffer-substring start end)) (trans (babel-as-string orig))) @@ -3007,22 +3220,20 @@ (point-max))) (goto-char (point-min)) (when (re-search-forward tdate-regexp nil t) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face))) + (setq bface (get-text-property (point-at-bol) 'face) + eface (get-text-property (1- (point-at-eol)) 'face))) (goto-char (point-min)) (setq pos nil) ;; Delete any old Date headers. (while (re-search-forward date-regexp nil t) (if pos - (delete-region (gnus-point-at-bol) - (progn - (gnus-article-forward-header) - (point))) - (delete-region (gnus-point-at-bol) - (progn - (gnus-article-forward-header) - (forward-char -1) - (point))) + (delete-region (point-at-bol) (progn + (gnus-article-forward-header) + (point))) + (delete-region (point-at-bol) (progn + (gnus-article-forward-header) + (forward-char -1) + (point))) (setq pos (point)))) (when (and (not pos) (re-search-forward tdate-regexp nil t)) @@ -3052,22 +3263,21 @@ (cond ;; Convert to the local timezone. ((eq type 'local) - (let ((tz (car (current-time-zone time)))) - (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60)))) + (concat "Date: " (message-make-date time))) ;; Convert to Universal Time. ((eq type 'ut) (concat "Date: " - (current-time-string - (let* ((e (parse-time-string date)) - (tm (apply 'encode-time e)) - (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone time))))) - (cond ((< ls 0) (list (1- ms) (+ ls 65536))) - ((> ls 65535) (list (1+ ms) (- ls 65536))) - (t (list ms ls))))) - " UT")) + (substring + (message-make-date + (let* ((e (parse-time-string date)) + (tm (apply 'encode-time e)) + (ms (car tm)) + (ls (- (cadr tm) (car (current-time-zone time))))) + (cond ((< ls 0) (list (1- ms) (+ ls 65536))) + ((> ls 65535) (list (1+ ms) (- ls 65536))) + (t (list ms ls))))) + 0 -5) + "UT")) ;; Get the original date from the article. ((eq type 'original) (concat "Date: " (if (string-match "\n+$" date) @@ -3208,7 +3418,7 @@ (setq n 1)) (gnus-stop-date-timer) (setq article-lapsed-timer - (nnheader-run-at-time 1 n 'article-update-date-lapsed))) + (run-at-time 1 n 'article-update-date-lapsed))) (defun gnus-stop-date-timer () "Stop the X-Sent timer." @@ -3237,7 +3447,7 @@ (not (bolp))) (match-end 0)))) (date (when (and start - (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)" + (re-search-forward "[\t ]*\n\\(?:[^\t ]\\|\\'\\)" nil t)) (buffer-substring-no-properties start (match-beginning 0))))) @@ -3588,17 +3798,9 @@ (shell-command-on-region (point-min) (point-max) command nil))) (setq gnus-last-shell-command command)) -(defmacro gnus-read-string (prompt &optional initial-contents history - default-value) - "Like `read-string' but allow for older XEmacsen that don't have the 5th arg." - (if (and (featurep 'xemacs) - (< emacs-minor-version 2)) - `(read-string ,prompt ,initial-contents ,history) - `(read-string ,prompt ,initial-contents ,history ,default-value))) - (defun gnus-summary-pipe-to-muttprint (&optional command) "Pipe this article to muttprint." - (setq command (gnus-read-string + (setq command (read-string "Print using command: " gnus-summary-muttprint-program nil gnus-summary-muttprint-program)) (gnus-summary-save-in-pipe command)) @@ -3721,8 +3923,8 @@ (message-narrow-to-head) (goto-char (point-max)) (forward-line -1) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face)) + (setq bface (get-text-property (point-at-bol) 'face) + eface (get-text-property (1- (point-at-eol)) 'face)) (message-remove-header "X-Gnus-PGP-Verify") (if (re-search-forward "^X-PGP-Sig:" nil t) (forward-line) @@ -3750,7 +3952,7 @@ (canlock-verify gnus-original-article-buffer))) (eval-and-compile - (mapcar + (mapc (lambda (func) (let (afunc gfunc) (if (consp func) @@ -3773,6 +3975,7 @@ article-verify-cancel-lock article-hide-boring-headers article-treat-overstrike + article-treat-ansi-sequences article-fill-long-lines article-capitalize-sentences article-remove-cr @@ -3810,7 +4013,7 @@ article-emphasize article-treat-dumbquotes article-normalize-headers -;; (article-show-all . gnus-article-show-all-headers) + ;;(article-show-all . gnus-article-show-all-headers) ))) ;;; @@ -3873,6 +4076,7 @@ ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] + ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] @@ -3929,20 +4133,18 @@ ;; face. (set (make-local-variable 'nobreak-char-display) nil) (setq cursor-in-non-selected-windows nil) + (setq truncate-lines gnus-article-truncate-lines) (gnus-set-default-directory) (buffer-disable-undo) - (setq buffer-read-only t) + (setq buffer-read-only t + show-trailing-whitespace nil) (set-syntax-table gnus-article-mode-syntax-table) (mm-enable-multibyte) (gnus-run-mode-hooks 'gnus-article-mode-hook)) -;; Internal variables. Are `gnus-button-regexp' and `gnus-button-last' used -;; at all? -(defvar gnus-button-regexp nil) (defvar gnus-button-marker-list nil - "Regexp matching any of the regexps from `gnus-button-alist'.") -(defvar gnus-button-last nil - "The value of `gnus-button-alist' when `gnus-button-regexp' was build.") + "Regexp matching any of the regexps from `gnus-button-alist'. +Internal variable.") (defun gnus-article-setup-buffer () "Initialize the article buffer." @@ -3955,10 +4157,9 @@ (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) (setq gnus-article-mime-handle-alist nil) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + ;; This might be a variable local to the summary buffer. + (unless gnus-single-article-buffer (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) (gnus-set-global-variables))) @@ -3999,23 +4200,27 @@ (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) + (setq gnus-summary-buffer + (gnus-summary-buffer-name gnus-newsgroup-name)) (gnus-summary-set-local-parameters gnus-newsgroup-name) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) - (set-window-start - (gnus-get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) + (let ((article-window (gnus-get-buffer-window gnus-article-buffer t))) + (when article-window + (set-window-start + article-window + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (if (not line) + (point-min) + (gnus-message 6 "Moved to bookmark") + (search-forward "\n\n" nil t) + (forward-line line) + (point))))))) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. @@ -4147,6 +4352,90 @@ (gnus-run-hooks 'gnus-article-prepare-hook))) ;;; +;;; Gnus Sticky Article Mode +;;; + +(define-derived-mode gnus-sticky-article-mode gnus-article-mode "StickyArticle" + "Mode for sticky articles." + ;; Release bindings that won't work. + (substitute-key-definition 'gnus-article-read-summary-keys 'undefined + gnus-sticky-article-mode-map) + (substitute-key-definition 'gnus-article-refer-article 'undefined + gnus-sticky-article-mode-map) + (dolist (k '("e" "h" "s" "F" "R")) + (define-key gnus-sticky-article-mode-map k nil)) + (define-key gnus-sticky-article-mode-map "k" 'gnus-kill-sticky-article-buffer) + (define-key gnus-sticky-article-mode-map "q" 'bury-buffer) + (define-key gnus-sticky-article-mode-map "\C-hc" 'describe-key-briefly) + (define-key gnus-sticky-article-mode-map "\C-hk" 'describe-key)) + +(defun gnus-sticky-article (arg) + "Make the current article sticky. +If a prefix ARG is given, ask for a name for this sticky article buffer." + (interactive "P") + (gnus-summary-show-thread) + (gnus-summary-select-article nil nil 'pseudo) + (let (new-art-buf-name) + (gnus-eval-in-buffer-window gnus-article-buffer + (setq new-art-buf-name + (concat + "*Sticky Article: " + (if arg + (read-from-minibuffer "Sticky article buffer name: ") + (gnus-with-article-headers + (gnus-article-goto-header "subject") + (setq new-art-buf-name + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) + (goto-char (point-min)) + (gnus-article-goto-header "from") + (setq new-art-buf-name + (concat + new-art-buf-name ", " + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (goto-char (point-min)) + (gnus-article-goto-header "date") + (setq new-art-buf-name + (concat + new-art-buf-name ", " + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))))) + "*")) + (if (and (gnus-buffer-live-p new-art-buf-name) + (with-current-buffer new-art-buf-name + (eq major-mode 'gnus-sticky-article-mode))) + (switch-to-buffer new-art-buf-name) + (setq new-art-buf-name (rename-buffer new-art-buf-name t))) + (gnus-sticky-article-mode)) + (setq gnus-article-buffer new-art-buf-name)) + (gnus-summary-recenter) + (gnus-summary-position-point)) + +(defun gnus-kill-sticky-article-buffer (&optional buffer) + "Kill the given sticky article BUFFER. +If none is given, assume the current buffer and kill it if it has +`gnus-sticky-article-mode'." + (interactive) + (unless buffer + (setq buffer (current-buffer))) + (with-current-buffer buffer + (when (eq major-mode 'gnus-sticky-article-mode) + (gnus-kill-buffer buffer)))) + +(defun gnus-kill-sticky-article-buffers (arg) + "Kill all sticky article buffers. +If a prefix ARG is given, ask for confirmation." + (interactive "P") + (dolist (buf (gnus-buffers)) + (with-current-buffer buf + (when (eq major-mode 'gnus-sticky-article-mode) + (if (not arg) + (gnus-kill-buffer buf) + (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? ")) + (gnus-kill-buffer buf))))))) + +;;; ;;; Gnus MIME viewing functions ;;; @@ -4181,10 +4470,11 @@ (gnus-mime-view-part-as-charset "C" "View As charset...") (gnus-mime-save-part "o" "Save...") (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") + (gnus-mime-replace-part "r" "Replace part") (gnus-mime-delete-part "d" "Delete part") (gnus-mime-copy-part "c" "View As Text, In Other Buffer") (gnus-mime-inline-part "i" "View As Text, In This Buffer") - (gnus-mime-view-part-internally "E" "View Internally") + (gnus-mime-view-part-internally "E" "View Internally") ;; Why `E'? (gnus-mime-view-part-externally "e" "View Externally") (gnus-mime-print-part "p" "Print") (gnus-mime-pipe-part "|" "Pipe To Command...") @@ -4199,9 +4489,6 @@ (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) @@ -4212,25 +4499,9 @@ gnus-mime-button-menu gnus-mime-button-map "MIME button menu." `("MIME Part" ,@(mapcar (lambda (c) - (vector (caddr c) (car c) :enable t)) + (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) -(eval-when-compile - (define-compiler-macro popup-menu (&whole form - menu &optional position prefix) - (if (and (fboundp 'popup-menu) - (not (memq 'popup-menu (assoc "lmenu" load-history)))) - form - ;; Gnus is probably running under Emacs 20. - `(let* ((menu (cdr ,menu)) - (response (x-popup-menu - t (list (car menu) - (cons "" (mapcar (lambda (c) - (cons (caddr c) (car c))) - (cdr menu))))))) - (if response - (call-interactively (nth 3 (assq response menu)))))))) - (defun gnus-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." (interactive "e\nP") @@ -4244,8 +4515,7 @@ (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." (interactive) - (save-current-buffer - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -4259,8 +4529,102 @@ (delete-region (point) (point-max)) (mm-display-parts handles)))))) -(defun gnus-mime-save-part-and-strip () - "Save the MIME part under point then replace it with an external body." +(defun gnus-article-jump-to-part (n) + "Jump to MIME part N." + (interactive "P") + (pop-to-buffer gnus-article-buffer) + ;; FIXME: why is it necessary? + (sit-for 0) + (let ((parts (length gnus-article-mime-handle-alist))) + (or n (setq n + (string-to-number + (read-string ;; Emacs 21 doesn't have `read-number'. + (format "Jump to part (2..%s): " parts))))) + (unless (and (integerp n) (<= n parts) (>= n 1)) + (setq n + (progn + (gnus-message 7 "Invalid part `%s', using %s instead." + n parts) + parts))) + (gnus-message 9 "Jumping to part %s." n) + (cond ((>= gnus-auto-select-part 1) + (while (and (<= n parts) + (not (gnus-article-goto-part n))) + (setq n (1+ n)))) + ((< gnus-auto-select-part 0) + (while (and (>= n 1) + (not (gnus-article-goto-part n))) + (setq n (1- n)))) + (t + (gnus-article-goto-part n))))) + +(eval-when-compile + (defsubst gnus-article-edit-part (handles &optional current-id) + "Edit an article in order to delete a mime part. +This function is exclusively used by `gnus-mime-save-part-and-strip' +and `gnus-mime-delete-part', and not provided at run-time normally." + (gnus-article-edit-article + `(lambda () + (buffer-disable-undo) + (erase-buffer) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (insert-buffer-substring gnus-original-article-buffer) + (mime-to-mml ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (gnus-make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) + `(lambda (no-highlight) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets))) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) + ,gnus-summary-buffer no-highlight)) + t) + (gnus-article-edit-done) + (gnus-summary-expand-window) + (gnus-summary-show-article) + (when (and current-id (integerp gnus-auto-select-part)) + (gnus-article-jump-to-part + (if (text-property-any (point-min) (point-max) + 'gnus-part (+ current-id gnus-auto-select-part)) + (+ current-id gnus-auto-select-part) + (with-current-buffer gnus-article-buffer + (length gnus-article-mime-handle-alist))))))) + +(defun gnus-mime-replace-part (file) + "Replace MIME part under point with an external body." + ;; Useful if file has already been saved to disk + (interactive + (list + (mm-with-multibyte + (read-file-name "Replace MIME part with file: " + (or mm-default-directory default-directory) + nil nil)))) + (gnus-mime-save-part-and-strip file)) + +(defun gnus-mime-save-part-and-strip (&optional file) + "Save the MIME part under point then replace it with an external body. +If FILE is given, use it for the external part." (interactive) (gnus-article-check-buffer) (when (gnus-group-read-only-p) @@ -4268,66 +4632,36 @@ (when (mm-complicated-handles gnus-article-mime-handles) (error "\ The current article has a complicated MIME structure, giving up...")) - (when (gnus-yes-or-no-p "\ -Deleting parts may malfunction or destroy the article; continue? ") - (let* ((data (get-text-property (point) 'gnus-data)) - file param - (handles gnus-article-mime-handles)) - (setq file (and data (mm-save-part data))) - (when file - (with-current-buffer (mm-handle-buffer data) - (erase-buffer) - (insert "Content-Type: " (mm-handle-media-type data)) - (mml-insert-parameter-string (cdr (mm-handle-type data)) - '(charset)) - ;; Add a filename for the sake of saving the part again. - (mml-insert-parameter - (mail-header-encode-parameter "name" (file-name-nondirectory file))) - (insert "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: binary\n") - (insert "\n")) - (setcdr data - (cdr (mm-make-handle nil - `("message/external-body" - (access-type . "LOCAL-FILE") - (name . ,file))))) - (set-buffer gnus-summary-buffer) - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight))))))) + (let* ((data (get-text-property (point) 'gnus-data)) + (id (get-text-property (point) 'gnus-part)) + param + (handles gnus-article-mime-handles)) + (unless file + (setq file + (and data (mm-save-part data "Delete MIME part and save to: ")))) + (when file + (with-current-buffer (mm-handle-buffer data) + (erase-buffer) + (insert "Content-Type: " (mm-handle-media-type data)) + (mml-insert-parameter-string (cdr (mm-handle-type data)) + '(charset)) + ;; Add a filename for the sake of saving the part again. + (mml-insert-parameter + (mail-header-encode-parameter "name" (file-name-nondirectory file))) + (insert "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: binary\n") + (insert "\n")) + (setcdr data + (cdr (mm-make-handle nil + `("message/external-body" + (access-type . "LOCAL-FILE") + (name . ,file))))) + ;; (set-buffer gnus-summary-buffer) + (gnus-article-edit-part handles id)))) + +;; A function like `gnus-summary-save-parts' (`X m', ` ') but with stripping would be nice. (defun gnus-mime-delete-part () "Delete the MIME part under point. @@ -4339,9 +4673,11 @@ (when (mm-complicated-handles gnus-article-mime-handles) (error "\ The current article has a complicated MIME structure, giving up...")) - (when (gnus-yes-or-no-p "\ -Deleting parts may malfunction or destroy the article; continue? ") + (when (or gnus-expert-user + (gnus-yes-or-no-p "\ +Deleting parts may malfunction or destroy the article; continue? ")) (let* ((data (get-text-property (point) 'gnus-data)) + (id (get-text-property (point) 'gnus-part)) (handles gnus-article-mime-handles) (none "(none)") (description @@ -4371,48 +4707,8 @@ nil `("text/plain") nil nil (list "attachment") (format "Deleted attachment (%s bytes)" bsize)))))) - (set-buffer gnus-summary-buffer) - ;; FIXME: maybe some of the following code (borrowed from - ;; `gnus-mime-save-part-and-strip') isn't necessary? - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (gnus-make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))) - ;; Not in `gnus-mime-save-part-and-strip': - (gnus-article-edit-done) - (gnus-summary-expand-window) - (gnus-summary-show-article))) + ;; (set-buffer gnus-summary-buffer) + (gnus-article-edit-part handles id)))) (defun gnus-mime-save-part () "Save the MIME part under point." @@ -4450,7 +4746,11 @@ ;; Content-Disposition: attachment; filename=... (cdr (assq 'filename (cdr (mm-handle-disposition handle)))))) (def-type (and name (mm-default-file-encoding name)))) - (and def-type (cons def-type 0)))) + (or (and def-type (cons def-type 0)) + (and handle + (equal (mm-handle-media-supertype handle) "text") + '("text/plain" . 0)) + '("application/octet-stream" . 0)))) (defun gnus-mime-view-part-as-type (&optional mime-type pred) "Choose a MIME media type, and view the part as such. @@ -4484,62 +4784,67 @@ (mm-handle-id handle))) (setq gnus-article-mime-handles (mm-merge-handles gnus-article-mime-handles handle)) + (when (mm-handle-displayed-p handle) + (mm-remove-part handle)) (gnus-mm-display-part handle)))) -(eval-when-compile - (require 'jka-compr)) - -;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days -;; emacs can do that itself. -;; -(defun gnus-mime-jka-compr-maybe-uncompress () - "Uncompress the current buffer if `auto-compression-mode' is enabled. -The uncompress method used is derived from `buffer-file-name'." - (when (and (fboundp 'jka-compr-installed-p) - (jka-compr-installed-p)) - (let ((info (jka-compr-get-compression-info buffer-file-name))) - (when info - (let ((basename (file-name-nondirectory buffer-file-name)) - (args (jka-compr-info-uncompress-args info)) - (prog (jka-compr-info-uncompress-program info)) - (message (jka-compr-info-uncompress-message info)) - (err-file (jka-compr-make-temp-name))) - (if message - (message "%s %s..." message basename)) - (unwind-protect - (unless (memq (apply 'call-process-region - (point-min) (point-max) - prog - t (list t err-file) nil - args) - jka-compr-acceptable-retval-list) - (jka-compr-error prog args basename message err-file)) - (jka-compr-delete-temp-file err-file))))))) - -(defun gnus-mime-copy-part (&optional handle) +(defun gnus-mime-copy-part (&optional handle arg) "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive) + (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (contents (and handle (mm-get-part handle))) - (base (and handle - (file-name-nondirectory - (or - (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename) - "*decoded*")))) - (buffer (and base (generate-new-buffer base)))) - (when contents - (switch-to-buffer buffer) - (insert contents) + (unless handle + (setq handle (get-text-property (point) 'gnus-data))) + (when handle + (let ((filename (or (mail-content-type-get (mm-handle-type handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename))) + contents dont-decode charset coding-system) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (setq contents (or (condition-case nil + (mm-decompress-buffer filename nil 'sig) + (error + (setq dont-decode t) + nil)) + (buffer-string)))) + (setq filename (cond (filename (file-name-nondirectory filename)) + (dont-decode "*raw data*") + (t "*decoded*"))) + (cond + (dont-decode) + ((not arg) + (unless (setq charset (mail-content-type-get + (mm-handle-type handle) 'charset)) + (unless (setq coding-system (mm-with-unibyte-buffer + (insert contents) + (mm-find-buffer-file-coding-system))) + (setq charset gnus-newsgroup-charset)))) + ((numberp arg) + (setq charset (or (cdr (assq arg + gnus-summary-show-article-charset-alist)) + (mm-read-coding-system "Charset: "))))) + (switch-to-buffer (generate-new-buffer filename)) + (if (or coding-system + (and charset + (setq coding-system (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii)))) + (progn + (mm-enable-multibyte) + (insert (mm-decode-coding-string contents coding-system)) + (setq buffer-file-coding-system + (if (boundp 'last-coding-system-used) + (symbol-value 'last-coding-system-used) + coding-system))) + (mm-disable-multibyte) + (insert contents) + (setq buffer-file-coding-system mm-binary-coding-system)) ;; We do it this way to make `normal-mode' set the appropriate mode. (unwind-protect (progn - (setq buffer-file-name (expand-file-name base)) - (gnus-mime-jka-compr-maybe-uncompress) + (setq buffer-file-name (expand-file-name filename)) (normal-mode)) (setq buffer-file-name nil)) (goto-char (point-min))))) @@ -4570,22 +4875,37 @@ (ps-despool filename))))) (defun gnus-mime-inline-part (&optional handle arg) - "Insert the MIME part under point into the current buffer." + "Insert the MIME part under point into the current buffer. +Compressed files like .gz and .bz2 are decompressed." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - contents charset - (b (point)) - (inhibit-read-only t)) - (when handle + (unless handle + (setq handle (get-text-property (point) 'gnus-data))) + (when handle + (let ((b (point)) + (inhibit-read-only t) + contents charset coding-system) (if (and (not arg) (mm-handle-undisplayer handle)) (mm-remove-part handle) - (setq contents (mm-get-part handle)) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (setq contents + (or (mm-decompress-buffer + (or (mail-content-type-get (mm-handle-type handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename)) + nil t) + (buffer-string)))) (cond ((not arg) - (setq charset (or (mail-content-type-get - (mm-handle-type handle) 'charset) - gnus-newsgroup-charset))) + (unless (setq charset (mail-content-type-get + (mm-handle-type handle) 'charset)) + (unless (setq coding-system + (mm-with-unibyte-buffer + (insert contents) + (mm-find-buffer-file-coding-system))) + (setq charset gnus-newsgroup-charset)))) ((numberp arg) (if (mm-handle-undisplayer handle) (mm-remove-part handle)) @@ -4599,11 +4919,12 @@ (forward-line 2) (mm-insert-inline handle - (if (and charset - (setq charset (mm-charset-to-coding-system - charset)) - (not (eq charset 'ascii))) - (mm-decode-coding-string contents charset) + (if (or coding-system + (and charset + (setq coding-system + (mm-charset-to-coding-system charset)) + (not (eq coding-system 'ascii)))) + (mm-decode-coding-string contents coding-system) (mm-string-to-multibyte contents))) (goto-char b))))) @@ -4632,12 +4953,15 @@ (gnus-newsgroup-ignored-charsets 'gnus-all) gnus-newsgroup-charset form preferred parts) (when handle - (if (mm-handle-undisplayer handle) - (mm-remove-part handle)) - (when fun - (setq gnus-newsgroup-charset - (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (mm-read-coding-system "Charset: "))) + (when (prog1 + (and fun + (setq gnus-newsgroup-charset + (or (cdr (assq + arg + gnus-summary-show-article-charset-alist)) + (mm-read-coding-system "Charset: ")))) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle))) (gnus-mime-strip-charset-parameters handle) (when (and (consp (setq form (cdr-safe fun))) (setq form (ignore-errors @@ -4710,64 +5034,152 @@ (if action-pair (funcall (cdr action-pair))))) -(defun gnus-article-part-wrapper (n function) - (let ((window (get-buffer-window gnus-article-buffer 'visible)) - frame) - (when window - ;; It is necessary to select the article window so that - ;; `gnus-article-goto-part' may really move the point. - (setq frame (selected-frame)) - (gnus-select-frame-set-input-focus (window-frame window)) - (unwind-protect - (save-window-excursion - (select-window window) - (when (> n (length gnus-article-mime-handle-alist)) - (error "No such part")) - (gnus-article-goto-part n) - (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) - (funcall function handle))) - (gnus-select-frame-set-input-focus frame))))) +(defun gnus-article-part-wrapper (n function &optional no-handle interactive) + "Call FUNCTION on MIME part N. +Unless NO-HANDLE, call FUNCTION with N-th MIME handle as it's only argument. +If INTERACTIVE, call FUNCTION interactivly." + (let (window frame) + ;; Check whether the article is displayed. + (unless (and (gnus-buffer-live-p gnus-article-buffer) + (setq window (get-buffer-window gnus-article-buffer t)) + (frame-visible-p (setq frame (window-frame window)))) + (error "No article is displayed")) + (with-current-buffer gnus-article-buffer + ;; Check whether the article displays the right contents. + (unless (with-current-buffer gnus-summary-buffer + (eq gnus-current-article (gnus-summary-article-number))) + (error "You should select the right article first")) + (if n + (setq n (prefix-numeric-value n)) + (let ((pt (point))) + (setq n (or (get-text-property pt 'gnus-part) + (and (not (bobp)) + (get-text-property (1- pt) 'gnus-part)) + (get-text-property (prog2 + (forward-line 1) + (point) + (goto-char pt)) + 'gnus-part) + (get-text-property + (or (and (setq pt (previous-single-property-change + pt 'gnus-part)) + (1- pt)) + (next-single-property-change (point) 'gnus-part) + (point)) + 'gnus-part) + 1)))) + ;; Check whether the specified part exists. + (when (> n (length gnus-article-mime-handle-alist)) + (error "No such part"))) + (unless + (progn + ;; To select the window is needed so that the cursor + ;; might be visible on the MIME button. + (select-window (prog1 + window + (setq window (selected-window)) + ;; Article may be displayed in the other frame. + (gnus-select-frame-set-input-focus + (prog1 + frame + (setq frame (selected-frame)))))) + (when (gnus-article-goto-part n) + ;; We point the cursor and the arrow at the MIME button + ;; when the `function' prompt the user for something. + (let ((cursor-in-non-selected-windows t) + (overlay-arrow-string "=>") + (overlay-arrow-position (point-marker))) + (unwind-protect + (cond + ((and no-handle interactive) + (call-interactively function)) + (no-handle + (funcall function)) + (interactive + (call-interactively + function + (cdr (assq n gnus-article-mime-handle-alist)))) + (t + (funcall function + (cdr (assq n gnus-article-mime-handle-alist))))) + (set-marker overlay-arrow-position nil) + (unless gnus-auto-select-part + (gnus-select-frame-set-input-focus frame) + (select-window window)))) + t)) + (if gnus-inhibit-mime-unbuttonizing + ;; This is the default though the program shouldn't reach here. + (error "No such part") + ;; The part which doesn't have the MIME button is selected. + ;; So, we display all the buttons and redo it. + (let ((gnus-inhibit-mime-unbuttonizing t)) + (gnus-summary-show-article) + (gnus-article-part-wrapper n function no-handle)))))) (defun gnus-article-pipe-part (n) "Pipe MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-pipe-part)) (defun gnus-article-save-part (n) "Save MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-save-part)) (defun gnus-article-interactively-view-part (n) "View MIME part N interactively, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'mm-interactively-view-part)) (defun gnus-article-copy-part (n) "Copy MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) "View MIME part N using a specified charset. N is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) (defun gnus-article-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." - (interactive "p") + (interactive "P") (gnus-article-part-wrapper n 'gnus-mime-inline-part)) +(defun gnus-article-save-part-and-strip (n) + "Save MIME part N and replace it with an external body. +N is the numerical prefix." + (interactive "P") + (gnus-article-part-wrapper n 'gnus-mime-save-part-and-strip t)) + +(defun gnus-article-replace-part (n) + "Replace MIME part N with an external body. +N is the numerical prefix." + (interactive "P") + (gnus-article-part-wrapper n 'gnus-mime-replace-part t t)) + +(defun gnus-article-delete-part (n) + "Delete MIME part N and add some information about the removed part. +N is the numerical prefix." + (interactive "P") + (gnus-article-part-wrapper n 'gnus-mime-delete-part t)) + +(defun gnus-article-view-part-as-type (n) + "Choose a MIME media type, and view part N as such. +N is the numerical prefix." + (interactive "P") + (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t)) + (defun gnus-article-mime-match-handle-first (condition) (if condition - (let ((alist gnus-article-mime-handle-alist) ihandle n) - (while (setq ihandle (pop alist)) + (let (n) + (dolist (ihandle gnus-article-mime-handle-alist) (if (and (cond ((functionp condition) (funcall condition (cdr ihandle))) @@ -4787,8 +5199,7 @@ (defun gnus-article-view-part (&optional n) "View MIME part N, which is the numerical prefix." (interactive "P") - (save-current-buffer - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) @@ -4816,8 +5227,7 @@ (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (if (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets) nil))) (save-excursion @@ -4885,15 +5295,18 @@ (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-button-map) - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) + `(keymap ,gnus-mime-button-map + gnus-callback gnus-mm-display-part + gnus-part ,gnus-tmp-id + article-type annotation + gnus-data ,handle)) (setq e (if (bolp) ;; Exclude a newline. (1- (point)) (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -5121,8 +5534,9 @@ (gnus-article-insert-newline) (mm-insert-inline handle - (let ((charset (mail-content-type-get (mm-handle-type handle) - 'charset))) + (let ((charset (or (mail-content-type-get (mm-handle-type handle) + 'charset) + (and (equal type "text/calendar") 'utf-8)))) (cond ((not charset) (mm-string-as-multibyte (mm-get-part handle))) ((eq charset 'gnus-decoded) @@ -5135,10 +5549,21 @@ (save-excursion (save-restriction (narrow-to-region beg (point)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))))))) + (if (eq handle gnus-article-mime-handles) + ;; The format=flowed case. + (gnus-treat-article nil 1 1 (mm-handle-media-type handle)) + ;; Don't count signature parts that are never displayed. + ;; The part number should be re-calculated supposing this + ;; might be a message/rfc822 part. + (let (handles) + (dolist (part gnus-article-mime-handles) + (unless (or (stringp part) + (equal (car (mm-handle-type part)) + "application/pgp-signature")) + (push part handles))) + (gnus-treat-article + nil (length (memq handle handles)) (length handles) + (mm-handle-media-type handle))))))))))) (defun gnus-unbuttonized-mime-type-p (type) "Say whether TYPE is to be unbuttonized." @@ -5195,7 +5620,7 @@ ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) + keymap ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id @@ -5219,7 +5644,7 @@ ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) + keymap ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id @@ -5234,8 +5659,8 @@ (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (mm-display-part preferred) ;; Do highlighting. (save-excursion @@ -5285,8 +5710,7 @@ (defun gnus-article-wash-status () "Return a string which display status of article washing." - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((cite (memq 'cite gnus-article-wash-types)) (headers (memq 'headers gnus-article-wash-types)) (boring (memq 'boring-headers gnus-article-wash-types)) @@ -5335,8 +5759,8 @@ "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) - (not (save-excursion (set-buffer gnus-summary-buffer) - gnus-have-all-headers))) + (not (with-current-buffer gnus-summary-buffer + gnus-have-all-headers))) (not gnus-inhibit-hiding)) (gnus-article-hide-headers))) @@ -5502,9 +5926,7 @@ (min (max 0 scroll-margin) (max 1 (- (window-height) (if mode-line-format 1 0) - (if (and (boundp 'header-line-format) - (symbol-value 'header-line-format)) - 1 0))))))) + (if header-line-format 1 0))))))) (defun gnus-article-next-page-1 (lines) (when (and (not (featurep 'xemacs)) @@ -5567,9 +5989,9 @@ "Read article specified by message-id around point." (interactive) (save-excursion - (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) - (re-search-forward "]+" (gnus-point-at-eol) t) + (re-search-backward "[ \t]\\|^" (point-at-bol) t) + (re-search-forward "]+" (point-at-eol) t) (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article msg-id)) @@ -5641,64 +6063,94 @@ (message "") - (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-article-current-summary) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (or (not func) - (numberp func)) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func) - (setq new-sum-point (point))) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer))) + (cond + ((eq (aref keys (1- (length keys))) ?\C-h) + (with-current-buffer gnus-article-current-summary + (describe-bindings (substring keys 0 -1)))) + ((or (member keys nosaves) + (member keys nosave-but-article) + (member keys nosave-in-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-article-current-summary) + ;; We disable the pick minor mode commands. + (let (gnus-pick-mode) + (setq func (lookup-key (current-local-map) keys)))) + (if (or (not func) + (numberp func)) + (ding) + (unless (member keys nosave-in-article) + (set-buffer gnus-article-current-summary)) + (call-interactively func) + (setq new-sum-point (point))) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer)))) + (t ;; These commands should restore window configuration. (let ((obuf (current-buffer)) (owin (current-window-configuration)) - (opoint (point)) - win func in-buffer selected new-sum-start new-sum-hscroll) + win func in-buffer selected new-sum-start new-sum-hscroll err) (cond (not-restore-window - (pop-to-buffer gnus-article-current-summary)) + (pop-to-buffer gnus-article-current-summary) + (setq win (selected-window))) ((setq win (get-buffer-window gnus-article-current-summary)) (select-window win)) (t - (switch-to-buffer gnus-article-current-summary 'norecord))) + (let ((summary-buffer gnus-article-current-summary)) + (gnus-configure-windows 'article) + (unless (setq win (get-buffer-window summary-buffer 'visible)) + (let ((gnus-buffer-configuration + '(article ((vertical 1.0 + (summary 0.25 point) + (article 1.0)))))) + (gnus-configure-windows 'article)) + (setq win (get-buffer-window summary-buffer 'visible))) + (gnus-select-frame-set-input-focus (window-frame win)) + (select-window win)))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. (if (and (setq func (let (gnus-pick-mode) (lookup-key (current-local-map) keys))) - (functionp func)) + (functionp func) + (condition-case code + (progn + (call-interactively func) + t) + (error + (setq err code) + nil))) (progn - (call-interactively func) (when (eq win (selected-window)) (setq new-sum-point (point) new-sum-start (window-start win) new-sum-hscroll (window-hscroll win))) - (when (eq in-buffer (current-buffer)) + (when (or (eq in-buffer (current-buffer)) + (when (eq obuf (current-buffer)) + (set-buffer in-buffer) + t)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) - (when (eq selected 'old) - (article-goto-body) + (when (and (eq selected 'old) + new-sum-point) (set-window-start (get-buffer-window (current-buffer)) 1) (set-window-point (get-buffer-window (current-buffer)) - (point))) + (if (article-goto-body) + (1- (point)) + (point)))) (when (and (not not-restore-window) - new-sum-point) + new-sum-point + (with-current-buffer (window-buffer win) + (eq major-mode 'gnus-summary-mode))) (set-window-point win new-sum-point) (set-window-start win new-sum-start) (set-window-hscroll win new-sum-hscroll)))) (set-window-configuration owin) - (ding)))))) + (if err + (signal (car err) (cdr err)) + (ding)))))))) (defun gnus-article-describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." @@ -5868,16 +6320,14 @@ gnus-summary-buffer (get-buffer gnus-summary-buffer) (gnus-buffer-exists-p gnus-summary-buffer) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) + (eq (cdr (with-current-buffer gnus-summary-buffer (assq article gnus-newsgroup-reads))) gnus-canceled-mark)) nil) ;; We first check `gnus-original-article-buffer'. ((and (get-buffer gnus-original-article-buffer) (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer (and (equal (car gnus-original-article) group) (eq (cdr gnus-original-article) article)))) (insert-buffer-substring gnus-original-article-buffer) @@ -5995,7 +6445,6 @@ (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) -(defvar gnus-article-edit-mode nil) ;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map @@ -6095,7 +6544,7 @@ ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) -(defun gnus-article-edit-article (start-func exit-func) +(defun gnus-article-edit-article (start-func exit-func &optional quiet) "Start editing the contents of the current article buffer." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) @@ -6108,7 +6557,8 @@ (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) - (gnus-message 6 "C-c C-c to end edits"))) + (unless quiet + (gnus-message 6 "C-c C-c to end edits")))) (defun gnus-article-edit-done (&optional arg) "Update the article edits and exit." @@ -6135,7 +6585,7 @@ (car gnus-article-current) (cdr gnus-article-current))) ;; We remove all text props from the article buffer. (kill-all-local-variables) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) (gnus-article-mode) (set-window-configuration winconf) (set-buffer buf) @@ -6183,9 +6633,24 @@ ;;; Internal Variables: (defcustom gnus-button-url-regexp - (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") + (concat + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|" + "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)" + "\\(//[-a-z0-9_.]+:[0-9]*\\)?" + (if (string-match "[[:digit:]]" "1") ;; Support POSIX? + (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") + (punct "!?:;.,")) + (concat + "\\(?:" + ;; Match paired parentheses, e.g. in Wikipedia URLs: + "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]" + "\\|" + "[" chars punct "]+" "[" chars "]" + "\\)")) + (concat ;; XEmacs 21.4 doesn't support POSIX. + "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" + "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) + "\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) @@ -6437,9 +6902,14 @@ (gnus-url-mailto url-mailto)) (t (gnus-message 3 "Invalid string."))))) -(defun gnus-button-handle-custom (url) - "Follow a Custom URL." - (customize-apropos (gnus-url-unhex-string url))) +(defun gnus-button-handle-custom (fun arg) + "Call function FUN on argument ARG. +Both FUN and ARG are supposed to be strings. ARG will be passed +as a symbol to FUN." + (funcall (intern fun) + (if (string-match "^customize-apropos" fun) + arg + (intern arg)))) (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") @@ -6583,6 +7053,8 @@ 0 (>= gnus-button-message-level 0) gnus-button-message-id 2) ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) + ("\\b\\(mid\\|message-id\\):? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" + 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) ;; RFC 2368 (The mailto URL scheme) @@ -6619,10 +7091,8 @@ ;; Info links like `C-h i d m CC Mode RET' 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) ;; This is custom - ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) - ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 - (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) + ("M-x[ \t\n]\\(customize-[^ ]+\\)[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1 2) ;; Emacs help commands ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" ;; regexp doesn't match arguments containing ` '. @@ -6640,7 +7110,7 @@ 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) ("`\\([a-z][-a-z0-9]+\\.el\\)'" 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) - ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" + ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'" 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) @@ -6657,13 +7127,10 @@ ;; here to determine where it ends. 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... - ("]*\\)>" + ("]*\\)>" 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) ;; RFC 2396 (2.4.3., delims) ... - ("\"URL: *\\([^\"]*\\)\"" - 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) - ;; RFC 2396 (2.4.3., delims) ... - ("\"URL: *\\([^\"]*\\)\"" + ("\"URL: *\\([^\n\"]*\\)\"" 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) ;; Raw URLs. (gnus-button-url-regexp @@ -6680,6 +7147,13 @@ ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W" 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) + ;; Recognizing patches to .el files. This is somewhat obscure, + ;; but considering the percentage of Gnus users who hack Emacs + ;; Lisp files... + ("^--- \\([^ .]+\\.el\\).*\n.*\n@@ -?\\([0-9]+\\)" 1 + (>= gnus-button-message-level 4) gnus-button-patch 1 2) + ("^\\*\\*\\* \\([^ .]+\\.el\\).*\n.*\n\\*+\n\\*\\*\\* \\([0-9]+\\)" 1 + (>= gnus-button-message-level 4) gnus-button-patch 1 2) ;; MID or mail: To avoid too many false positives we don't try to catch ;; all kind of allowed MIDs or mail addresses. Domain part must contain ;; at least one dot. TLD must contain two or three chars or be a know TLD @@ -6722,6 +7196,8 @@ 0 (>= gnus-button-browse-level 0) browse-url 0) ("^[^:]+:" gnus-button-url-regexp 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^OpenPGP:.*url=" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) gnus-button-openpgp 0) ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" @@ -6797,55 +7273,46 @@ (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (inhibit-read-only t) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (article-narrow-to-head) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face)))))))) + (gnus-with-article-headers + (let (regexp header-face field-face from hpoints fpoints) + (dolist (entry gnus-header-face-alist) + (goto-char (point-min)) + (setq regexp (concat "^\\(" + (if (string-equal "" (nth 0 entry)) + "[^\t ]" + (nth 0 entry)) + "\\)") + header-face (nth 1 entry) + field-face (nth 2 entry)) + (while (and (re-search-forward regexp nil t) + (not (eobp))) + (beginning-of-line) + (setq from (point)) + (unless (search-forward ":" nil t) + (forward-char 1)) + (when (and header-face + (not (memq (point) hpoints))) + (push (point) hpoints) + (gnus-put-text-property from (point) 'face header-face)) + (when (and field-face + (not (memq (setq from (point)) fpoints))) + (push from fpoints) + (if (re-search-forward "^[^ \t]" nil t) + (forward-char -2) + (goto-char (point-max))) + (gnus-put-text-property from (point) 'face field-face))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using the face `gnus-signature'." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) + (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t) 'face gnus-signature-face) (widen) (gnus-article-search-signature) @@ -6863,10 +7330,8 @@ \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) @@ -6889,65 +7354,116 @@ (setq regexp (eval (car entry))) (goto-char beg) (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning (nth 1 entry)))) - (end (and entry (match-end (nth 1 entry)))) - (from (match-beginning 0))) + (let ((start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (from (match-beginning 0))) (when (and (or (eq t (nth 2 entry)) (eval (nth 2 entry))) (not (gnus-button-in-region-p start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the ;; button. - (gnus-article-add-button - start end 'gnus-button-push - (car (push (set-marker (make-marker) from) - gnus-button-marker-list)))))))))) + (setq from (set-marker (make-marker) from)) + (push from gnus-button-marker-list) + (unless (and (eq (car entry) 'gnus-button-url-regexp) + (gnus-article-extend-url-button from start end)) + (gnus-article-add-button start end + 'gnus-button-push from))))))))) + +(defun gnus-article-extend-url-button (beg start end) + "Extend url button if url is folded into two or more lines. +Return non-nil if button is extended. BEG is a marker that points to +the beginning position of a text containing url. START and END are +the endpoints of a url button before it is extended. The concatenated +url is put as the `gnus-button-url' overlay property on the button." + (let ((opoint (point)) + (points (list start end)) + url delim regexp) + (prog1 + (when (and (progn + (goto-char end) + (not (looking-at "[\t ]*[\">]"))) + (progn + (goto-char start) + (string-match + "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'" + (buffer-substring (point-at-bol) start))) + (progn + (setq url (list (buffer-substring start end)) + delim (if (match-beginning 1) ">" "\"")) + (beginning-of-line) + (setq regexp (concat + (when (and (looking-at + message-cite-prefix-regexp) + (< (match-end 0) start)) + (regexp-quote (match-string 0))) + "\ +\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*" + delim "\\)")) + (while (progn + (forward-line 1) + (and (looking-at regexp) + (prog1 + (match-beginning 1) + (push (or (match-string 2) + (match-string 1)) + url) + (push (setq end (or (match-end 2) + (match-end 1))) + points) + (push (or (match-beginning 2) + (match-beginning 1)) + points))))) + (match-beginning 2))) + (let (gnus-article-mouse-face widget-mouse-face) + (while points + (gnus-article-add-button (pop points) (pop points) + 'gnus-button-push beg))) + (let ((overlay (gnus-make-overlay start end))) + (gnus-overlay-put overlay 'evaporate t) + (gnus-overlay-put overlay 'gnus-button-url + (list (mapconcat 'identity (nreverse url) ""))) + (when gnus-article-mouse-face + (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))) + t) + (goto-char opoint)))) ;; Add buttons to the head of an article. (defun gnus-article-add-buttons-to-head () "Add buttons to the head of the article." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (article-narrow-to-head) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (eval (nth 1 entry)) end t) - ;; Each match within a header. - (let* ((entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (when (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end))))))) + (gnus-with-article-headers + (let (beg end) + (dolist (entry gnus-header-button-alist) + ;; Each alist entry. + (goto-char (point-min)) + (while (re-search-forward (car entry) nil t) + ;; Each header matching the entry. + (setq beg (match-beginning 0)) + (setq end (or (and (re-search-forward "^[^ \t]" nil t) + (match-beginning 0)) + (point-max))) + (goto-char beg) + (while (re-search-forward (eval (nth 1 entry)) end t) + ;; Each match within a header. + (let* ((entry (cdr entry)) + (start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (form (nth 2 entry))) + (goto-char (match-end 0)) + (when (eval form) + (gnus-article-add-button + start end (nth 3 entry) + (buffer-substring (match-beginning (nth 4 entry)) + (match-end (nth 4 entry))))))) + (goto-char end)))))) ;;; External functions: (defun gnus-article-add-button (from to fun &optional data) "Create a button between FROM and TO with callback FUN and data DATA." (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) + (gnus-overlay-put (gnus-make-overlay from to nil t) 'face gnus-article-button-face)) (gnus-add-text-properties from to @@ -6961,15 +7477,12 @@ ;;; Internal functions: (defun gnus-article-set-globals () - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-set-global-variables))) (defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((inhibit-read-only t) - (inhibit-point-motion-hooks t)) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t)) (if (text-property-any end (point-max) 'article-type 'signature) (progn (gnus-delete-wash-type 'signature) @@ -7003,12 +7516,14 @@ (let* ((entry (gnus-button-entry)) (inhibit-point-motion-hooks t) (fun (nth 3 entry)) - (args (mapcar (lambda (group) - (let ((string (match-string group))) - (gnus-set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 entry)))) + (args (or (and (eq (car entry) 'gnus-button-url-regexp) + (get-char-property marker 'gnus-button-url)) + (mapcar (lambda (group) + (let ((string (match-string group))) + (set-text-properties + 0 (length string) nil string) + string)) + (nthcdr 4 entry))))) (cond ((fboundp fun) (apply fun args)) @@ -7066,6 +7581,15 @@ (group (gnus-button-fetch-group url))))) +(defun gnus-button-patch (library line) + "Visit an Emacs Lisp library LIBRARY on line LINE." + (interactive) + (let ((file (locate-library (file-name-nondirectory library)))) + (unless file + (error "Couldn't find library %s" library)) + (find-file file) + (goto-line (string-to-number line)))) + (defun gnus-button-handle-man (url) "Fetch a man page." (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url) @@ -7115,14 +7639,25 @@ (Info-directory) (Info-menu url)) +(defun gnus-button-openpgp (url) + "Retrieve and add an OpenPGP key given URL from an OpenPGP header." + (with-temp-buffer + (mm-url-insert-file-contents-external url) + (pgg-snarf-keys-region (point-min) (point-max)) + (pgg-display-output-buffer nil nil nil))) + (defun gnus-button-message-id (message-id) "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-summary-refer-article message-id))) -(defun gnus-button-fetch-group (address) +(defun gnus-button-fetch-group (address &rest ignore) "Fetch GROUP specified by ADDRESS." + (when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'" + address) + ;; Allow to use `gnus-button-fetch-group' in `browse-url-browser-function' + ;; for nntp:// and news:// + (setq address (match-string 3 address))) (if (not (string-match "[:/]" address)) ;; This is just a simple group url. (gnus-group-read-ephemeral-group address gnus-select-method) @@ -7198,9 +7733,6 @@ (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-button-prev-page) (define-key map "\r" 'gnus-button-prev-page) map)) @@ -7215,19 +7747,23 @@ map)) (defun gnus-insert-prev-page-button () - (let ((b (point)) + (let ((b (point)) e (inhibit-read-only t)) (gnus-eval-format gnus-prev-page-line-format nil - `(,@(gnus-local-map-property gnus-prev-page-map) - gnus-prev t - gnus-callback gnus-article-button-prev-page - article-type annotation)) + `(keymap ,gnus-prev-page-map + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) + 'link b e :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) @@ -7248,18 +7784,22 @@ (select-window win))) (defun gnus-insert-next-page-button () - (let ((b (point)) + (let ((b (point)) e (inhibit-read-only t)) (gnus-eval-format gnus-next-page-line-format nil - `(,@(gnus-local-map-property gnus-next-page-map) - gnus-next t - gnus-callback gnus-article-button-next-page - article-type annotation)) + `(keymap ,gnus-next-page-map + gnus-next t + gnus-callback gnus-article-button-next-page + article-type annotation)) + (setq e (if (bolp) + ;; Exclude a newline. + (1- (point)) + (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button - 'link b (if (bolp) - ;; Exclude a newline. - (1- (point)) - (point)) + 'link b e :action 'gnus-button-next-page :button-keymap gnus-next-page-map))) @@ -7302,14 +7842,13 @@ (eq gnus-newsgroup-name (car gnus-decode-header-methods-cache))) (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) - (mapcar (lambda (x) - (if (symbolp x) - (nconc gnus-decode-header-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-header-methods-cache - (list (cdr x)))))) - gnus-decode-header-methods)) + (dolist (x gnus-decode-header-methods) + (if (symbolp x) + (nconc gnus-decode-header-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-header-methods-cache + (list (cdr x))))))) (let ((xlist gnus-decode-header-methods-cache)) (pop xlist) (save-restriction @@ -7385,6 +7924,8 @@ t) ((eq val 'head) nil) + ((eq val 'first) + (eq part-number 1)) ((eq val 'last) (eq part-number total-parts)) ((numberp val) @@ -7485,14 +8026,51 @@ (?d gnus-tmp-details ?s) (?D gnus-tmp-pressed-details ?s))) +(defvar gnus-mime-security-button-commands + '((gnus-article-press-button "\r" "Show Detail") + (undefined "v") + (undefined "t") + (undefined "C") + (gnus-mime-security-save-part "o" "Save...") + (undefined "\C-o") + (undefined "r") + (undefined "d") + (undefined "c") + (undefined "i") + (undefined "E") + (undefined "e") + (undefined "p") + (gnus-mime-security-pipe-part "|" "Pipe To Command...") + (undefined "."))) + (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) - (define-key map "\r" 'gnus-article-press-button) + (define-key map gnus-down-mouse-3 'gnus-mime-security-button-menu) + (dolist (c gnus-mime-security-button-commands) + (define-key map (cadr c) (car c))) map)) +(easy-menu-define + gnus-mime-security-button-menu gnus-mime-security-button-map + "Security button menu." + `("Security Part" + ,@(delq nil + (mapcar (lambda (c) + (unless (eq (car c) 'undefined) + (vector (caddr c) (car c) :active t))) + gnus-mime-security-button-commands)))) + +(defun gnus-mime-security-button-menu (event prefix) + "Construct a context-sensitive menu of security commands." + (interactive "e\nP") + (save-window-excursion + (let ((pos (event-start event))) + (select-window (posn-window pos)) + (goto-char (posn-point pos)) + (gnus-article-check-buffer) + (popup-menu gnus-mime-security-button-menu nil prefix)))) + (defvar gnus-mime-security-details-buffer nil) (defvar gnus-mime-security-button-pressed nil) @@ -7506,18 +8084,15 @@ point (inhibit-read-only t)) (if region (goto-char (car region))) - (save-restriction - (narrow-to-region (point) (point)) - (with-current-buffer (mm-handle-multipart-original-buffer handle) - (let* ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) - (unless (eq nparts (cdr handle)) - (mm-destroy-parts (cdr handle)) - (setcdr handle nparts)))) - (setq point (point)) - (gnus-mime-display-security handle) - (goto-char (point-max))) + (setq point (point)) + (with-current-buffer (mm-handle-multipart-original-buffer handle) + (let* ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (unless (eq nparts (cdr handle)) + (mm-destroy-parts (cdr handle)) + (setcdr handle nparts)))) + (gnus-mime-display-security handle) (when region (delete-region (point) (cdr region)) (set-marker (car region) nil) @@ -7595,7 +8170,7 @@ (gnus-eval-format gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-security-button-map) + `(keymap ,gnus-mime-security-button-map gnus-callback gnus-mime-security-press-button gnus-line-format ,gnus-mime-security-button-line-format gnus-mime-details ,gnus-mime-security-button-pressed @@ -7605,6 +8180,9 @@ ;; Exclude a newline. (1- (point)) (point))) + (when gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -7617,15 +8195,16 @@ (when (boundp 'help-echo-owns-message) (setq help-echo-owns-message t)) (format - "%S: show detail" - (aref gnus-mouse-2 0)))))) + "%S: show detail; %S: more options" + (aref gnus-mouse-2 0) + (aref gnus-down-mouse-3 0)))))) (defun gnus-mime-display-security (handle) (save-restriction (narrow-to-region (point) (point)) (unless (gnus-unbuttonized-mime-type-p (car handle)) (gnus-insert-mime-security-button handle)) - (gnus-mime-display-mixed (cdr handle)) + (gnus-mime-display-part (cadr handle)) (unless (bolp) (insert "\n")) (unless (gnus-unbuttonized-mime-type-p (car handle)) @@ -7635,7 +8214,36 @@ (mm-set-handle-multipart-parameter handle 'gnus-region (cons (set-marker (make-marker) (point-min)) - (set-marker (make-marker) (point-max)))))) + (set-marker (make-marker) (point-max)))) + (goto-char (point-max)))) + +(defun gnus-mime-security-run-function (function) + "Run FUNCTION with the security part under point." + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data)) + buffer handle) + (when (and (stringp (car-safe data)) + (setq buffer (mm-handle-multipart-original-buffer data)) + (setq handle (cadr data))) + (if (bufferp (mm-handle-buffer handle)) + (progn + (setq handle (cons buffer (copy-sequence (cdr handle)))) + (mm-handle-set-undisplayer handle nil)) + (setq handle (mm-make-handle + buffer + (mm-handle-multipart-ctl-parameter handle 'protocol) + nil nil nil nil nil nil))) + (funcall function handle)))) + +(defun gnus-mime-security-save-part () + "Save the security part under point." + (interactive) + (gnus-mime-security-run-function 'mm-save-part)) + +(defun gnus-mime-security-pipe-part () + "Pipe the security part under point to a process." + (interactive) + (gnus-mime-security-run-function 'mm-pipe-part)) (gnus-ems-redefine) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-async.el --- a/lisp/gnus/gnus-async.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-async.el Sun Oct 28 09:18:39 2007 +0000 @@ -33,10 +33,6 @@ (require 'gnus-sum) (require 'nntp) -(eval-when-compile - (when (featurep 'xemacs) - (require 'timer-funcs))) - (defgroup gnus-asynchronous nil "Support for asynchronous operations." :group 'gnus) @@ -274,28 +270,29 @@ (nntp-server-buffer (current-buffer)) (nntp-have-messaged nil) (tries 0)) - (condition-case nil - ;; FIXME: we could stop waiting after some - ;; timeout, but this is the wrong place to do it. - ;; rather than checking time-spent-waiting, we - ;; should check time-since-last-output, which - ;; needs to be done in nntp.el. - (while (eq article gnus-async-current-prefetch-article) - (incf tries) - (when (nntp-accept-process-output proc) - (setq tries 0)) - (when (and (not nntp-have-messaged) - (= tries 3)) - (gnus-message 5 "Waiting for async article...") - (setq nntp-have-messaged t))) - (quit - ;; if the user interrupted on a slow/hung connection, - ;; do something friendly. - (when (> tries 3) - (setq gnus-async-current-prefetch-article nil)) - (signal 'quit nil))) - (when nntp-have-messaged - (gnus-message 5 ""))))) + (when proc + (condition-case nil + ;; FIXME: we could stop waiting after some + ;; timeout, but this is the wrong place to do it. + ;; rather than checking time-spent-waiting, we + ;; should check time-since-last-output, which + ;; needs to be done in nntp.el. + (while (eq article gnus-async-current-prefetch-article) + (incf tries) + (when (nntp-accept-process-output proc) + (setq tries 0)) + (when (and (not nntp-have-messaged) + (= tries 3)) + (gnus-message 5 "Waiting for async article...") + (setq nntp-have-messaged t))) + (quit + ;; if the user interrupted on a slow/hung connection, + ;; do something friendly. + (when (> tries 3) + (setq gnus-async-current-prefetch-article nil)) + (signal 'quit nil))) + (when nntp-have-messaged + (gnus-message 5 "")))))) (defun gnus-async-delete-prefetched-entry (entry) "Delete ENTRY from buffer and alist." @@ -311,13 +308,11 @@ "Remove all articles belonging to GROUP from the prefetch buffer." (when (and (gnus-group-asynchronous-p group) (memq 'exit gnus-prefetched-article-deletion-strategy)) - (let ((alist gnus-async-article-alist)) - (save-excursion - (gnus-async-set-buffer) - (while alist - (when (equal group (nth 3 (car alist))) - (gnus-async-delete-prefetched-entry (car alist))) - (pop alist)))))) + (save-excursion + (gnus-async-set-buffer) + (dolist (entry gnus-async-article-alist) + (when (equal group (nth 3 entry)) + (gnus-async-delete-prefetched-entry entry)))))) (defun gnus-async-prefetched-article-entry (group article) "Return the entry for ARTICLE in GROUP if it has been prefetched." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-bookmark.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gnus-bookmark.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,826 @@ +;;; gnus-bookmark.el --- Bookmarks in Gnus + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Bastien Guerry +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file implements real bookmarks for Gnus, closely following the way +;; `bookmark.el' handles bookmarks. Most of the code comes from +;; `bookmark.el'. +;; +;; Set a Gnus bookmark: +;; M-x `gnus-bookmark-set' from the summary buffer. +;; +;; Jump to a Gnus bookmark: +;; M-x `gnus-bookmark-jump'. +;; +;; Display a list of bookmarks +;; M-x `gnus-bookmark-bmenu-list'. +;; + +;;; Todo: + +;; - add tags to bookmarks +;; - don't write file each time a bookmark is created +;; - better annotation interactive buffer +;; - edit annotation in gnus-bookmark-bmenu +;; - sort gnus-bookmark-buffer by author/subject/date/group/message-id +;; - auto-bmk-name customizable format +;; - renaming bookmarks in gnus-bookmark-bmenu-list +;; - better (formatted string) display in bmenu-list + +;; - Integrate the `gnus-summary-*-bookmark' functionality +;; - Initialize defcustoms from corresponding `bookmark.el' variables? + +;;; Code: + +(require 'gnus-sum) + +;; FIXME: should avoid using C-c (no?) +;; (define-key gnus-summary-mode-map "\C-crm" 'gnus-bookmark-set) +;; (define-key global-map "\C-crb" 'gnus-bookmark-jump) +;; (define-key global-map "\C-crj" 'gnus-bookmark-jump) +;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list) + +(defgroup gnus-bookmark nil + "Setting, annotation and jumping to Gnus bookmarks." + :group 'gnus) + +(defcustom gnus-bookmark-default-file + (cond + ;; Backward compatibility with previous versions: + ((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk") + (t (nnheader-concat gnus-directory "bookmarks.el"))) + "The default Gnus bookmarks file." + :type 'string + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-file-coding-system + (if (mm-coding-system-p 'iso-2022-7bit) + 'iso-2022-7bit) + "Coding system used for writing Gnus bookmark files." + :type '(symbol :tag "Coding system") + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-sort-flag t + "Non-nil means Gnus bookmarks are sorted by bookmark names. +Otherwise they will be displayed in LIFO order (that is, +most recently set ones come first, oldest ones come last)." + :type 'boolean + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-bmenu-toggle-infos t + "Non-nil means show details when listing Gnus bookmarks. +List of details is defined in `gnus-bookmark-bookmark-inline-details'. +This may result in truncated bookmark names. To disable this, put the +following in your `.emacs' file: + +\(setq gnus-bookmark-bmenu-toggle-infos nil\)" + :type 'boolean + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-bmenu-file-column 30 + "Column at which to display details in a buffer listing Gnus bookmarks. +You can toggle whether details are shown with \\\\[gnus-bookmark-bmenu-toggle-infos]." + :type 'integer + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-use-annotations nil + "If non-nil, ask for an annotation when setting a bookmark." + :type 'boolean + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-bookmark-inline-details '(author) + "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'. +The default value is \(subject\)." + :type '(list :tag "Gnus bookmark details" + (set :inline t + (const :tag "Author" author) + (const :tag "Subject" subject) + (const :tag "Date" date) + (const :tag "Group" group) + (const :tag "Message-id" message-id))) + :group 'gnus-bookmark) + +(defcustom gnus-bookmark-bookmark-details + '(author subject date group annotation) + "Details to be shown with `gnus-bookmark-bmenu-show-details'. +The default value is \(author subject date group annotation\)." + :type '(list :tag "Gnus bookmark details" + (set :inline t + (const :tag "Author" author) + (const :tag "Subject" subject) + (const :tag "Date" date) + (const :tag "Group" group) + (const :tag "Message-id" message-id) + (const :tag "Annotation" annotation))) + :group 'gnus-bookmark) + +(defface gnus-bookmark-menu-heading + '((t (:inherit font-lock-type-face))) + "Face used to highlight the heading in Gnus bookmark menu buffers." + :version "23.0" ;; No Gnus + :group 'gnus-bookmark) + +(defconst gnus-bookmark-end-of-version-stamp-marker + "-*- End Of Bookmark File Format Version Stamp -*-\n" + "This string marks the end of the version stamp in a Gnus bookmark file.") + +(defconst gnus-bookmark-file-format-version 0 + "The current version of the format used by bookmark files. +You should never need to change this.") + +(defvar gnus-bookmark-after-jump-hook nil + "Hook run after `gnus-bookmark-jump' jumps to a Gnus bookmark.") + +(defvar gnus-bookmark-alist () + "Association list of Gnus bookmarks and their records. +The format of the alist is + + \(BMK1 BMK2 ...\) + +where each BMK is of the form + +\(NAME + \(group . GROUP\) + \(message-id . MESSAGE-ID\) + \(author . AUTHOR\) + \(date . DATE\) + \(subject . SUBJECT\) + \(annotation . ANNOTATION\)\) + +So the cdr of each bookmark is an alist too.") + +(defmacro gnus-bookmark-mouse-available-p () + "Return non-nil if a mouse is available." + (if (featurep 'xemacs) + '(and (eq (device-class) 'color) (device-on-window-system-p)) + '(and (display-color-p) (display-mouse-p)))) + +(defun gnus-bookmark-remove-properties (string) + "Remove all text properties from STRING." + (set-text-properties 0 (length string) nil string) + string) + +;;;###autoload +(defun gnus-bookmark-set () + "Set a bookmark for this article." + (interactive) + (gnus-bookmark-maybe-load-default-file) + (if (or (not (eq major-mode 'gnus-summary-mode)) + (not gnus-article-current)) + (error "Please select an article in the Gnus summary buffer") + (let* ((group (car gnus-article-current)) + (article (cdr gnus-article-current)) + (header (gnus-summary-article-header article)) + (author (mail-header-from header)) + (message-id (mail-header-id header)) + (date (mail-header-date header)) + (subject (gnus-summary-subject-string)) + (bmk-name (gnus-bookmark-set-bookmark-name group author subject)) + ;; Maybe ask for annotation + (annotation + (if gnus-bookmark-use-annotations + (read-from-minibuffer + (format "Annotation for %s: " bmk-name)) ""))) + ;; Set the bookmark list + (setq gnus-bookmark-alist + (cons + (list (gnus-bookmark-remove-properties bmk-name) + (gnus-bookmark-make-cell + group message-id author date subject annotation)) + gnus-bookmark-alist)))) + (gnus-bookmark-bmenu-surreptitiously-rebuild-list) + (gnus-bookmark-write-file)) + +(defun gnus-bookmark-make-cell + (group message-id author date subject annotation) + "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION." + (let ((the-record + `((group . ,(gnus-bookmark-remove-properties group)) + (message-id . ,(gnus-bookmark-remove-properties message-id)) + (author . ,(gnus-bookmark-remove-properties author)) + (date . ,(gnus-bookmark-remove-properties date)) + (subject . ,(gnus-bookmark-remove-properties subject)) + (annotation . ,(gnus-bookmark-remove-properties annotation))))) + the-record)) + +(defun gnus-bookmark-set-bookmark-name (group author subject) + "Set bookmark name from GROUP AUTHOR and SUBJECT." + (let* ((subject (split-string subject)) + (default-name-0 ;; Should be merged with -1? + (concat (car (nreverse (delete "" (split-string group "[\\.:]")))) + "-" (car (split-string author)) + "-" (car subject) "-" (cadr subject))) + (default-name-1 + ;; Strip "[]" chars from the bookmark name: + (gnus-replace-in-string default-name-0 "[]_[]" "")) + (name (read-from-minibuffer + (format "Set bookmark (%s): " default-name-1) + nil nil nil nil + default-name-1))) + (if (string-equal name "") + default-name-1 + name))) + +(defun gnus-bookmark-write-file () + "Write currently defined Gnus bookmarks into `gnus-bookmark-default-file'." + (interactive) + (save-excursion + (save-window-excursion + ;; Avoir warnings? + ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file) + (set-buffer (get-buffer-create " *Gnus bookmarks*")) + (erase-buffer) + (gnus-bookmark-insert-file-format-version-stamp) + (pp gnus-bookmark-alist (current-buffer)) + (condition-case nil + (let ((coding-system-for-write gnus-bookmark-file-coding-system)) + (write-region (point-min) (point-max) + gnus-bookmark-default-file)) + (file-error (message "Can't write %s" + gnus-bookmark-default-file))) + (kill-buffer (current-buffer)) + (message + "Saving Gnus bookmarks to file %s...done" + gnus-bookmark-default-file)))) + +(defun gnus-bookmark-insert-file-format-version-stamp () + "Insert text indicating current version of Gnus bookmark file format." + (insert + (format ";;;; Gnus Bookmark Format Version %d %s;;;;\n" + gnus-bookmark-file-format-version + (if gnus-bookmark-file-coding-system + (concat "-*- coding: " + (symbol-name gnus-bookmark-file-coding-system) + "; -*- ") + ""))) + (insert ";;; This format is meant to be slightly human-readable;\n" + ";;; nevertheless, you probably don't want to edit it.\n" + ";;; " + gnus-bookmark-end-of-version-stamp-marker)) + +;;;###autoload +(defun gnus-bookmark-jump (&optional bmk-name) + "Jump to a Gnus bookmark (BMK-NAME)." + (interactive) + (gnus-bookmark-maybe-load-default-file) + (let* ((bookmark (or bmk-name + (completing-read "Jump to bookmarked article: " + gnus-bookmark-alist))) + (bmk-cell (cadr (assoc bookmark gnus-bookmark-alist))) + (group (cdr (assoc 'group bmk-cell))) + (message-id (cdr (assoc 'message-id bmk-cell)))) + (when group + (unless (get-buffer gnus-group-buffer) + (gnus-no-server)) + (gnus-activate-group group) + (gnus-group-quick-select-group 0 group)) + (if message-id + (or (gnus-summary-goto-article message-id nil 'force) + (if (fboundp 'gnus-summary-insert-cached-articles) + (progn + (gnus-summary-insert-cached-articles) + (gnus-summary-goto-article message-id nil 'force)) + (message "Message could not be found.")))))) + +(defvar gnus-bookmark-already-loaded nil) + +(defun gnus-bookmark-alist-from-buffer () + "Return a `gnus-bookmark-alist' from the current buffer. +The buffer must of course contain Gnus bookmark format information. +Does not care from where in the buffer it is called, and does not +affect point." + (save-excursion + (goto-char (point-min)) + (if (search-forward + gnus-bookmark-end-of-version-stamp-marker nil t) + (read (current-buffer)) + ;; Else no hope of getting information here. + (error "Not Gnus bookmark format")))) + +(defun gnus-bookmark-load (file) + "Load Gnus bookmarks from FILE (which must be in bookmark format)." + (interactive + (list (read-file-name + (format "Load Gnus bookmarks from: (%s) " + gnus-bookmark-default-file) + "~/" gnus-bookmark-default-file 'confirm))) + (setq file (expand-file-name file)) + (if (file-readable-p file) + (save-excursion + (save-window-excursion + (set-buffer (let ((enable-local-variables nil)) + (find-file-noselect file))) + (goto-char (point-min)) + (let ((blist (gnus-bookmark-alist-from-buffer))) + (if (listp blist) + (progn (setq gnus-bookmark-already-loaded t) + (setq gnus-bookmark-alist blist)) + (error "Not Gnus bookmark format"))))))) + +(defun gnus-bookmark-maybe-load-default-file () + "Maybe load Gnus bookmarks in `gnus-bookmark-alist'." + (and (not gnus-bookmark-already-loaded) + (null gnus-bookmark-alist) + (file-readable-p (expand-file-name gnus-bookmark-default-file)) + (gnus-bookmark-load gnus-bookmark-default-file))) + +(defun gnus-bookmark-maybe-sort-alist () + "Return the gnus-bookmark-alist for display. +If the gnus-bookmark-sort-flag is non-nil, then return a sorted +copy of the alist." + (when gnus-bookmark-sort-flag + (setq gnus-bookmark-alist + (sort (copy-alist gnus-bookmark-alist) + (function + (lambda (x y) (string-lessp (car x) (car y)))))))) + +;;;###autoload +(defun gnus-bookmark-bmenu-list () + "Display a list of existing Gnus bookmarks. +The list is displayed in a buffer named `*Gnus Bookmark List*'. +The leftmost column displays a D if the bookmark is flagged for +deletion, or > if it is flagged for displaying." + (interactive) + (gnus-bookmark-maybe-load-default-file) + (if (interactive-p) + (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*")) + (set-buffer (get-buffer-create "*Gnus Bookmark List*"))) + (let ((inhibit-read-only t) + alist name start end) + (erase-buffer) + (insert "% Gnus Bookmark\n- --------\n") + (add-text-properties (point-min) (point) + '(font-lock-face gnus-bookmark-menu-heading)) + ;; sort before displaying + (gnus-bookmark-maybe-sort-alist) + ;; Display gnus bookmarks + (setq alist gnus-bookmark-alist) + (while alist + (setq name (gnus-bookmark-name-from-full-record (pop alist))) + ;; if a Gnus bookmark has an annotation, prepend a "*" + ;; in the list of bookmarks. + (insert (if (member (gnus-bookmark-get-annotation name) (list nil "")) + " " + " *")) + (if (gnus-bookmark-mouse-available-p) + (add-text-properties + (prog1 + (point) + (insert name)) + (let ((end (point))) + (prog2 + (re-search-backward "[^ \t]") + (1+ (point)) + (goto-char end) + (insert "\n"))) + `(mouse-face highlight follow-link t + help-echo ,(format "%s: go to this article" + (aref gnus-mouse-2 0)))) + (insert name "\n"))) + (goto-char (point-min)) + (forward-line 2) + (gnus-bookmark-bmenu-mode) + (if gnus-bookmark-bmenu-toggle-infos + (gnus-bookmark-bmenu-toggle-infos t)))) + +(defun gnus-bookmark-bmenu-surreptitiously-rebuild-list () + "Rebuild the Bookmark List if it exists. +Don't affect the buffer ring order." + (if (get-buffer "*Gnus Bookmark List*") + (save-excursion + (save-window-excursion + (gnus-bookmark-bmenu-list))))) + +(defun gnus-bookmark-get-annotation (bookmark) + "Return the annotation of Gnus BOOKMARK, or nil if none." + (cdr (assq 'annotation (gnus-bookmark-get-bookmark-record bookmark)))) + +(defun gnus-bookmark-get-bookmark (bookmark) + "Return the full entry for Gnus BOOKMARK in `gnus-bookmark-alist'. +If BOOKMARK is not a string, return nil." + (when (stringp bookmark) + (assoc bookmark gnus-bookmark-alist))) + +(defun gnus-bookmark-get-bookmark-record (bookmark) + "Return the guts of the entry for Gnus BOOKMARK in `gnus-bookmark-alist'. +That is, all information but the name." + (car (cdr (gnus-bookmark-get-bookmark bookmark)))) + +(defun gnus-bookmark-name-from-full-record (full-record) + "Return name of FULL-RECORD \(an alist element instead of a string\)." + (car full-record)) + +(defvar gnus-bookmark-bmenu-bookmark-column nil) +(defvar gnus-bookmark-bmenu-hidden-bookmarks ()) +(defvar gnus-bookmark-bmenu-mode-map nil) + +(if gnus-bookmark-bmenu-mode-map + nil + (setq gnus-bookmark-bmenu-mode-map (make-keymap)) + (suppress-keymap gnus-bookmark-bmenu-mode-map t) + (define-key gnus-bookmark-bmenu-mode-map "q" (if (fboundp 'quit-window) + 'quit-window + 'bury-buffer)) + (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select) + (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select) + (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete) + (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete) + (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards) + (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions) + (define-key gnus-bookmark-bmenu-mode-map " " 'next-line) + (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line) + (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line) + (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark) + (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode) + (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark) + (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark) + (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load) + (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save) + (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos) + (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details) + (define-key gnus-bookmark-bmenu-mode-map gnus-mouse-2 + 'gnus-bookmark-bmenu-select-by-mouse)) + +;; Bookmark Buffer Menu mode is suitable only for specially formatted +;; data. +(put 'gnus-bookmark-bmenu-mode 'mode-class 'special) + +;; Been to lazy to use gnus-bookmark-save... +(defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file) + +(defun gnus-bookmark-bmenu-mode () + "Major mode for editing a list of Gnus bookmarks. +Each line describes one of the bookmarks in Gnus. +Letters do not insert themselves; instead, they are commands. +Gnus bookmarks names preceded by a \"*\" have annotations. +\\ +\\[gnus-bookmark-bmenu-mark] -- mark bookmark to be displayed. +\\[gnus-bookmark-bmenu-select] -- select bookmark of line point is on. + Also show bookmarks marked using m in other windows. +\\[gnus-bookmark-bmenu-toggle-infos] -- toggle displaying of details (they may obscure long bookmark names). +\\[gnus-bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark. +\\[gnus-bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\). +\\[gnus-bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. +\\[gnus-bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. +\\[gnus-bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[gnus-bookmark-bmenu-delete]'. +\\[gnus-bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) +\\[gnus-bookmark-bmenu-save] -- load in a file of bookmarks (prompts for file.) +\\[gnus-bookmark-bmenu-unmark] -- remove all kinds of marks from current line. + With prefix argument, also move up one line. +\\[gnus-bookmark-bmenu-backup-unmark] -- back up a line and remove marks. +\\[gnus-bookmark-bmenu-show-details] -- show the annotation, if it exists, for the current bookmark + in another buffer. +\\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. +\\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." + (kill-all-local-variables) + (use-local-map gnus-bookmark-bmenu-mode-map) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq major-mode 'gnus-bookmark-bmenu-mode) + (setq mode-name "Bookmark Menu") + (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook)) + +;; avoid compilation warnings +(defvar gnus-bookmark-bmenu-toggle-infos nil) + +(defun gnus-bookmark-bmenu-toggle-infos (&optional show) + "Toggle whether details are shown in the Gnus bookmark list. +Optional argument SHOW means show them unconditionally." + (interactive) + (cond + (show + (setq gnus-bookmark-bmenu-toggle-infos nil) + (gnus-bookmark-bmenu-show-infos) + (setq gnus-bookmark-bmenu-toggle-infos t)) + (gnus-bookmark-bmenu-toggle-infos + (gnus-bookmark-bmenu-hide-infos) + (setq gnus-bookmark-bmenu-toggle-infos nil)) + (t + (gnus-bookmark-bmenu-show-infos) + (setq gnus-bookmark-bmenu-toggle-infos t)))) + +(defun gnus-bookmark-bmenu-show-infos (&optional force) + "Show infos in bmenu, maybe FORCE display of infos." + (if (and (not force) gnus-bookmark-bmenu-toggle-infos) + nil ;already shown, so do nothing + (save-excursion + (save-window-excursion + (goto-char (point-min)) + (forward-line 2) + (setq gnus-bookmark-bmenu-hidden-bookmarks ()) + (let ((inhibit-read-only t)) + (while (< (point) (point-max)) + (let ((bmrk (gnus-bookmark-bmenu-bookmark))) + (setq gnus-bookmark-bmenu-hidden-bookmarks + (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks)) + (let ((start (save-excursion (end-of-line) (point)))) + (move-to-column gnus-bookmark-bmenu-file-column t) + ;; Strip off `mouse-face' from the white spaces region. + (if (gnus-bookmark-mouse-available-p) + (remove-text-properties start (point) + '(mouse-face nil help-echo nil)))) + (delete-region (point) (progn (end-of-line) (point))) + (insert " ") + ;; Pass the NO-HISTORY arg: + (gnus-bookmark-insert-details bmrk) + (forward-line 1)))))))) + +(defun gnus-bookmark-insert-details (bmk-name) + "Insert the details of the article associated with BMK-NAME." + (let ((start (point))) + (prog1 + (insert (gnus-bookmark-get-details + bmk-name + gnus-bookmark-bookmark-inline-details)) + (if (gnus-bookmark-mouse-available-p) + (add-text-properties + start + (save-excursion (re-search-backward + "[^ \t]") + (1+ (point))) + `(mouse-face highlight + follow-link t + help-echo ,(format "%s: go to this article" + (aref gnus-mouse-2 0)))))))) + +(defun gnus-bookmark-kill-line (&optional newline-too) + "Kill from point to end of line. +If optional arg NEWLINE-TOO is non-nil, delete the newline too. +Does not affect the kill ring." + (let ((eol (save-excursion (end-of-line) (point)))) + (delete-region (point) eol) + (if (and newline-too (looking-at "\n")) + (delete-char 1)))) + +(defun gnus-bookmark-get-details (bmk-name details-list) + "Get details for a Gnus BMK-NAME depending on DETAILS-LIST." + (let ((details (cadr (assoc bmk-name gnus-bookmark-alist)))) + (mapconcat + (lambda (info) + (cdr (assoc info details))) + details-list " | "))) + +(defun gnus-bookmark-bmenu-hide-infos (&optional force) + "Hide infos in bmenu, maybe FORCE." + (if (and (not force) gnus-bookmark-bmenu-toggle-infos) + ;; nothing to hide if above is nil + (save-excursion + (save-window-excursion + (goto-char (point-min)) + (forward-line 2) + (setq gnus-bookmark-bmenu-hidden-bookmarks + (nreverse gnus-bookmark-bmenu-hidden-bookmarks)) + (save-excursion + (goto-char (point-min)) + (search-forward "Gnus Bookmark") + (backward-word 2) + (setq gnus-bookmark-bmenu-bookmark-column (current-column))) + (save-excursion + (let ((inhibit-read-only t)) + (while gnus-bookmark-bmenu-hidden-bookmarks + (move-to-column gnus-bookmark-bmenu-bookmark-column t) + (gnus-bookmark-kill-line) + (let ((start (point))) + (insert (car gnus-bookmark-bmenu-hidden-bookmarks)) + (if (gnus-bookmark-mouse-available-p) + (add-text-properties + start + (save-excursion (re-search-backward + "[^ \t]") + (1+ (point))) + `(mouse-face highlight + follow-link t + help-echo + ,(format "%s: go to this bookmark in other window" + (aref gnus-mouse-2 0)))))) + (setq gnus-bookmark-bmenu-hidden-bookmarks + (cdr gnus-bookmark-bmenu-hidden-bookmarks)) + (forward-line 1)))))))) + +(defun gnus-bookmark-bmenu-check-position () + "Return non-nil if on a line with a bookmark. +The actual value returned is gnus-bookmark-alist. Else +reposition and try again, else return nil." + (cond ((< (count-lines (point-min) (point)) 2) + (goto-char (point-min)) + (forward-line 2) + gnus-bookmark-alist) + ((and (bolp) (eobp)) + (beginning-of-line 0) + gnus-bookmark-alist) + (t + gnus-bookmark-alist))) + +(defun gnus-bookmark-bmenu-bookmark () + "Return a string which is bookmark of this line." + (if (gnus-bookmark-bmenu-check-position) + (save-excursion + (save-window-excursion + (goto-char (point-min)) + (search-forward "Gnus Bookmark") + (backward-word 2) + (setq gnus-bookmark-bmenu-bookmark-column (current-column))))) + (if gnus-bookmark-bmenu-toggle-infos + (gnus-bookmark-bmenu-hide-infos)) + (save-excursion + (save-window-excursion + (beginning-of-line) + (forward-char gnus-bookmark-bmenu-bookmark-column) + (prog1 + (buffer-substring-no-properties (point) + (progn + (end-of-line) + (point))) + ;; well, this is certainly crystal-clear: + (if gnus-bookmark-bmenu-toggle-infos + (gnus-bookmark-bmenu-toggle-infos t)))))) + +(defun gnus-bookmark-show-details (bookmark) + "Display the annotation for BOOKMARK in a buffer." + (let ((record (gnus-bookmark-get-bookmark-record bookmark)) + (old-buf (current-buffer)) + (details gnus-bookmark-bookmark-details) + detail) + (save-excursion + (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t) + (erase-buffer) + (while details + (setq detail (pop details)) + (unless (equal (cdr (assoc detail record)) "") + (insert (symbol-name detail) ": " (cdr (assoc detail record)) "\n"))) + (goto-char (point-min)) + (pop-to-buffer old-buf)))) + +(defun gnus-bookmark-bmenu-show-details () + "Show the annotation for the current bookmark in another window." + (interactive) + (let ((bookmark (gnus-bookmark-bmenu-bookmark))) + (if (gnus-bookmark-bmenu-check-position) + (gnus-bookmark-show-details bookmark)))) + +(defun gnus-bookmark-bmenu-mark () + "Mark bookmark on this line to be displayed by \\\\[gnus-bookmark-bmenu-select]." + (interactive) + (beginning-of-line) + (if (gnus-bookmark-bmenu-check-position) + (let ((inhibit-read-only t)) + (delete-char 1) + (insert ?>) + (forward-line 1) + (gnus-bookmark-bmenu-check-position)))) + +(defun gnus-bookmark-bmenu-unmark (&optional backup) + "Cancel all requested operations on bookmark on this line and move down. +Optional BACKUP means move up." + (interactive "P") + (beginning-of-line) + (if (gnus-bookmark-bmenu-check-position) + (progn + (let ((inhibit-read-only t)) + (delete-char 1) + ;; any flags to reset according to circumstances? How about a + ;; flag indicating whether this bookmark is being visited? + ;; well, we don't have this now, so maybe later. + (insert " ")) + (forward-line (if backup -1 1)) + (gnus-bookmark-bmenu-check-position)))) + +(defun gnus-bookmark-bmenu-backup-unmark () + "Move up and cancel all requested operations on bookmark on line above." + (interactive) + (forward-line -1) + (if (gnus-bookmark-bmenu-check-position) + (progn + (gnus-bookmark-bmenu-unmark) + (forward-line -1) + (gnus-bookmark-bmenu-check-position)))) + +(defun gnus-bookmark-bmenu-delete () + "Mark Gnus bookmark on this line to be deleted. +To carry out the deletions that you've marked, use +\\\\[gnus-bookmark-bmenu-execute-deletions]." + (interactive) + (beginning-of-line) + (if (gnus-bookmark-bmenu-check-position) + (let ((inhibit-read-only t)) + (delete-char 1) + (insert ?D) + (forward-line 1) + (gnus-bookmark-bmenu-check-position)))) + +(defun gnus-bookmark-bmenu-delete-backwards () + "Mark bookmark on this line to be deleted, then move up one line. +To carry out the deletions that you've marked, use +\\\\[gnus-bookmark-bmenu-execute-deletions]." + (interactive) + (gnus-bookmark-bmenu-delete) + (forward-line -2) + (if (gnus-bookmark-bmenu-check-position) + (forward-line 1)) + (gnus-bookmark-bmenu-check-position)) + +(defun gnus-bookmark-bmenu-select () + "Select this line's bookmark; also display bookmarks marked with `>'. +You can mark bookmarks with the +\\\\[gnus-bookmark-bmenu-mark] +command." + (interactive) + (if (gnus-bookmark-bmenu-check-position) + (let ((bmrk (gnus-bookmark-bmenu-bookmark)) + (menu (current-buffer))) + (goto-char (point-min)) + (delete-other-windows) + (gnus-bookmark-jump bmrk) + (bury-buffer menu)))) + +(defun gnus-bookmark-bmenu-select-by-mouse (event) + (interactive "e") + (mouse-set-point event) + (gnus-bookmark-bmenu-select)) + +(defun gnus-bookmark-bmenu-load () + "Load the Gnus bookmark file and rebuild the bookmark menu-buffer." + (interactive) + (if (gnus-bookmark-bmenu-check-position) + (save-excursion + (save-window-excursion + ;; This will call `gnus-bookmark-bmenu-list' + (call-interactively 'gnus-bookmark-load))))) + +(defun gnus-bookmark-bmenu-execute-deletions () + "Delete Gnus bookmarks marked with \\\\[Buffer-menu-delete] commands." + (interactive) + (message "Deleting Gnus bookmarks...") + (let ((hide-em gnus-bookmark-bmenu-toggle-infos) + (o-point (point)) + (o-str (save-excursion + (beginning-of-line) + (if (looking-at "^D") + nil + (buffer-substring + (point) + (progn (end-of-line) (point)))))) + (o-col (current-column))) + (if hide-em (gnus-bookmark-bmenu-hide-infos)) + (setq gnus-bookmark-bmenu-toggle-infos nil) + (goto-char (point-min)) + (forward-line 1) + (while (re-search-forward "^D" (point-max) t) + (gnus-bookmark-delete (gnus-bookmark-bmenu-bookmark) t)) ; pass BATCH arg + (gnus-bookmark-bmenu-list) + (setq gnus-bookmark-bmenu-toggle-infos hide-em) + (if gnus-bookmark-bmenu-toggle-infos + (gnus-bookmark-bmenu-toggle-infos t)) + (if o-str + (progn + (goto-char (point-min)) + (search-forward o-str) + (beginning-of-line) + (forward-char o-col)) + (goto-char o-point)) + (beginning-of-line) + (gnus-bookmark-write-file) + (message "Deleting bookmarks...done"))) + +(defun gnus-bookmark-delete (bookmark &optional batch) + "Delete BOOKMARK from the bookmark list. +Removes only the first instance of a bookmark with that name. If +there are one or more other bookmarks with the same name, they will +not be deleted. Defaults to the \"current\" bookmark \(that is, the +one most recently used in this file, if any\). +Optional second arg BATCH means don't update the bookmark list buffer, +probably because we were called from there." + (gnus-bookmark-maybe-load-default-file) + (let ((will-go (gnus-bookmark-get-bookmark bookmark))) + (setq gnus-bookmark-alist (delq will-go gnus-bookmark-alist))) + ;; Don't rebuild the list + (if batch + nil + (gnus-bookmark-bmenu-surreptitiously-rebuild-list))) + +(provide 'gnus-bookmark) + +;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525 +;;; gnus-bookmark.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-cache.el --- a/lisp/gnus/gnus-cache.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-cache.el Sun Oct 28 09:18:39 2007 +0000 @@ -30,11 +30,8 @@ (eval-when-compile (require 'cl)) (require 'gnus) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-start) (eval-when-compile - (if (not (fboundp 'gnus-agent-load-alist)) + (unless (fboundp 'gnus-agent-load-alist) (defun gnus-agent-load-alist (group))) (require 'gnus-sum)) @@ -92,6 +89,7 @@ (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) +(defvar gnus-cache-total-fetched-hashtb nil) (eval-and-compile (autoload 'nnml-generate-nov-databases-1 "nnml") @@ -133,16 +131,20 @@ (let ((coding-system-for-write gnus-cache-overview-coding-system)) (gnus-write-buffer overview-file)) - ;; Empty overview file, remove it - (when (file-exists-p overview-file) - (delete-file overview-file)) - ;; If possible, remove group's cache subdirectory. - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + ;; Empty overview file, remove it + (when (file-exists-p overview-file) + (delete-file overview-file)) + ;; If possible, remove group's cache subdirectory. + (condition-case nil + ;; FIXME: we can detect the error type and warn the user + ;; of any inconsistencies (articles w/o nov entries?). + ;; for now, just be conservative...delete only if safe -- sj + (delete-directory (file-name-directory overview-file)) + (error)))) + + (gnus-cache-update-overview-total-fetched-for + (car gnus-cache-buffer) overview-file))) ;; Kill the buffer -- it's either unmodified or saved. (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) @@ -152,7 +154,9 @@ (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) (> article 0)) ; This might be a dummy article. - (let ((number article) file headers) + (let ((number article) + file headers lines-chars + (file-name-coding-system nnmail-pathname-coding-system)) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) (let ((result (nnvirtual-find-group-art @@ -180,10 +184,14 @@ (gnus-request-article-this-buffer number group)) (when (> (buffer-size) 0) (let ((coding-system-for-write gnus-cache-coding-system)) - (gnus-write-buffer file)) + (gnus-write-buffer file) + (gnus-cache-update-file-total-fetched-for group file)) + (setq lines-chars (nnheader-get-lines-and-char)) (nnheader-remove-body) (setq headers (nnheader-parse-naked-head)) (mail-header-set-number headers number) + (mail-header-set-lines headers (car lines-chars)) + (mail-header-set-chars headers (cadr lines-chars)) (gnus-cache-change-buffer group) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-max)) @@ -236,12 +244,10 @@ (defun gnus-cache-possibly-remove-articles-1 () "Possibly remove some of the removable articles." (when (gnus-cache-fully-p gnus-newsgroup-name) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) + (let ((cache-articles gnus-newsgroup-cached)) (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (when (memq (setq article (pop articles)) cache-articles) + (dolist (article gnus-cache-removable-articles) + (when (memq article cache-articles) ;; The article was in the cache, so we see whether we are ;; supposed to remove it from the cache. (gnus-cache-possibly-remove-article @@ -256,7 +262,8 @@ (defun gnus-cache-request-article (article group) "Retrieve ARTICLE in GROUP from the cache." (let ((file (gnus-cache-file-name group article)) - (buffer-read-only nil)) + (buffer-read-only nil) + (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) @@ -285,7 +292,8 @@ (gnus-retrieve-headers articles group fetch-old)) (let ((uncached-articles (gnus-sorted-difference articles cached)) (cache-file (gnus-cache-file-name group ".overview")) - type) + type + (file-name-coding-system nnmail-pathname-coding-system)) ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) @@ -325,9 +333,8 @@ If not given a prefix, use the process marked articles instead. Returns the list of articles entered." (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article out) - (while (setq article (pop articles)) + (let (out) + (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) (if (natnump article) (when (gnus-cache-possibly-enter-article @@ -348,10 +355,8 @@ Returns the list of articles removed." (interactive "P") (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) + (let (out) + (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) (when (gnus-cache-possibly-remove-article article nil nil nil t) (when gnus-newsgroup-agentized @@ -407,7 +412,8 @@ " *gnus-cache-overview*")))) ;; Insert the contents of this group's cache overview. (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) + (let ((file (gnus-cache-file-name group ".overview")) + (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p file) (nnheader-insert-file-contents file))) ;; We have a fresh (empty/just loaded) buffer, @@ -421,8 +427,43 @@ (and unread (memq 'unread class)) (and (not unread) (not ticked) (not dormant) (memq 'read class)))) +(defvar gnus-cache-decoded-group-names nil + "Alist of original group names and decoded group names. +Decoding is done according to `gnus-group-name-charset-method-alist' +or `gnus-group-name-charset-group-alist'.") + +(defvar gnus-cache-unified-group-names nil + "Alist of unified decoded group names and original group names. +A group name is decoded according to +`gnus-group-name-charset-method-alist' or +`gnus-group-name-charset-group-alist' first, and is encoded and +decoded again according to `nnmail-pathname-coding-system', +`file-name-coding-system', or `default-file-name-coding-system'. + +It is used when asking for a original group name from a cache +directory name, in which non-ASCII characters might have been unified +into the ones of a certain charset particularly if the `utf-8' coding +system for example was used.") + +(defun gnus-cache-decoded-group-name (group) + "Return a decoded group name of GROUP." + (or (cdr (assoc group gnus-cache-decoded-group-names)) + (let ((decoded (gnus-group-decoded-name group)) + (coding (or nnmail-pathname-coding-system + (and (boundp 'file-name-coding-system) + file-name-coding-system) + (and (boundp 'default-file-name-coding-system) + default-file-name-coding-system)))) + (push (cons group decoded) gnus-cache-decoded-group-names) + (push (cons (mm-decode-coding-string + (mm-encode-coding-string decoded coding) + coding) + group) + gnus-cache-unified-group-names) + decoded))) + (defun gnus-cache-file-name (group article) - (setq group (gnus-group-decoded-name group)) + (setq group (gnus-cache-decoded-group-name group)) (expand-file-name (if (stringp article) article (int-to-string article)) (file-name-as-directory @@ -455,7 +496,8 @@ "Possibly remove ARTICLE from the cache." (let ((group gnus-newsgroup-name) (number article) - file) + file + (file-name-coding-system nnmail-pathname-coding-system)) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) (let ((result (nnvirtual-find-group-art @@ -468,13 +510,15 @@ (gnus-cache-member-of-class gnus-cache-remove-articles ticked dormant unread))) (save-excursion + (gnus-cache-update-file-total-fetched-for group file t) (delete-file file) + (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) (when (or (looking-at (concat (int-to-string number) "\t")) (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) - (gnus-delete-line))) + (gnus-delete-line))) (unless (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) @@ -485,7 +529,8 @@ (defun gnus-cache-articles-in-group (group) "Return a sorted list of cached articles in GROUP." (let ((dir (file-name-directory (gnus-cache-file-name group 1))) - articles) + articles + (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p dir) (setq articles (sort (mapcar (lambda (name) (string-to-number name)) @@ -508,8 +553,8 @@ (save-excursion (set-buffer cache-buf) (erase-buffer) - (let ((coding-system-for-read - gnus-cache-overview-coding-system)) + (let ((coding-system-for-read gnus-cache-overview-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) (insert-file-contents (or file (gnus-cache-file-name group ".overview")))) (goto-char (point-min)) @@ -525,7 +570,7 @@ (set-buffer cache-buf) (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") nil t) - (setq beg (gnus-point-at-bol) + (setq beg (point-at-bol) end (progn (end-of-line) (point))) (setq beg nil)) (set-buffer nntp-server-buffer) @@ -537,24 +582,23 @@ (defun gnus-cache-braid-heads (group cached) (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) + (with-current-buffer cache-buf (erase-buffer)) (set-buffer nntp-server-buffer) (goto-char (point-min)) - (while cached + (dolist (entry cached) (while (and (not (eobp)) (looking-at "2.. +\\([0-9]+\\) ") (< (progn (goto-char (match-beginning 1)) (read (current-buffer))) - (car cached))) + entry)) (search-forward "\n.\n" nil 'move)) (beginning-of-line) (set-buffer cache-buf) (erase-buffer) - (let ((coding-system-for-read - gnus-cache-coding-system)) - (insert-file-contents (gnus-cache-file-name group (car cached)))) + (let ((coding-system-for-read gnus-cache-coding-system) + (file-name-coding-system nnmail-pathname-coding-system)) + (insert-file-contents (gnus-cache-file-name group entry))) (goto-char (point-min)) (insert "220 ") (princ (car cached) (current-buffer)) @@ -564,8 +608,7 @@ (forward-char -1) (insert ".") (set-buffer nntp-server-buffer) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) + (insert-buffer-substring cache-buf)) (kill-buffer cache-buf))) ;;;###autoload @@ -661,6 +704,7 @@ (interactive) (let* ((top (null directory)) (directory (expand-file-name (or directory gnus-cache-directory))) + (file-name-coding-system nnmail-pathname-coding-system) (files (directory-files directory 'full)) (group (if top @@ -686,16 +730,21 @@ (push (pop files) alphs))) ;; If we have nums, then this is probably a valid group. (when (setq nums (sort nums '<)) - (gnus-sethash group (cons (car nums) (gnus-last-element nums)) + ;; Use non-decoded group name. + ;; FIXME: this is kind of a workaround. The active file should + ;; be updated at the time articles are cached. It will make + ;; `gnus-cache-unified-group-names' needless. + (gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names)) + group) + (cons (car nums) (gnus-last-element nums)) gnus-cache-active-hashtb)) ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) + (dolist (file alphs) + (when (and (file-directory-p file) (not (string-match "^\\." - (file-name-nondirectory (car alphs))))) + (file-name-nondirectory file)))) ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) + (gnus-cache-generate-active file))) ;; Write the new active file. (when top (gnus-cache-write-active t) @@ -708,6 +757,9 @@ (gnus-cache-close) (let ((nnml-generate-active-function 'identity)) (nnml-generate-nov-databases-1 dir)) + + (setq gnus-cache-total-fetched-hashtb nil) + (gnus-cache-open)) (defun gnus-cache-move-cache (dir) @@ -736,9 +788,12 @@ depends on the caller to determine whether group renaming is supported." (let ((old-dir (gnus-cache-file-name old-group "")) - (new-dir (gnus-cache-file-name new-group ""))) + (new-dir (gnus-cache-file-name new-group "")) + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-rename-file old-dir new-dir t)) + (gnus-cache-rename-group-total-fetched-for old-group new-group) + (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb (gnus-cache-read-active)) @@ -762,9 +817,12 @@ files would corrupt gnus when the cache was next enabled. Depends upon the caller to determine whether group deletion is supported." - (let ((dir (gnus-cache-file-name group ""))) + (let ((dir (gnus-cache-file-name group "")) + (file-name-coding-system nnmail-pathname-coding-system)) (gnus-delete-directory dir)) + (gnus-cache-delete-group-total-fetched-for group) + (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb (gnus-cache-read-active)) @@ -775,6 +833,85 @@ (setq gnus-cache-active-altered group-hash-value) (gnus-cache-write-active group-hash-value))))) +(defvar gnus-cache-inhibit-update-total-fetched-for nil) +(defvar gnus-cache-need-update-total-fetched-for nil) + +(defmacro gnus-cache-with-refreshed-group (group &rest body) + `(prog1 (let ((gnus-cache-inhibit-update-total-fetched-for t)) + ,@body) + (when (and gnus-cache-need-update-total-fetched-for + (not gnus-cache-inhibit-update-total-fetched-for)) + (save-excursion + (set-buffer gnus-group-buffer) + (setq gnus-cache-need-update-total-fetched-for nil) + (gnus-group-update-group ,group t))))) + +(defun gnus-cache-update-file-total-fetched-for (group file &optional subtract) + (when gnus-cache-total-fetched-hashtb + (gnus-cache-with-refreshed-group + group + (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) + (gnus-sethash group (make-vector 2 0) + gnus-cache-total-fetched-hashtb))) + size) + + (if file + (setq size (or (nth 7 (file-attributes file)) 0)) + (let* ((file-name-coding-system nnmail-pathname-coding-system) + (files (directory-files (gnus-cache-file-name group "") + t nil t)) + file attrs) + (setq size 0.0) + (while (setq file (pop files)) + (setq attrs (file-attributes file)) + (unless (nth 0 attrs) + (incf size (float (nth 7 attrs))))))) + + (setq gnus-cache-need-update-total-fetched-for t) + + (incf (nth 1 entry) (if subtract (- size) size)))))) + +(defun gnus-cache-update-overview-total-fetched-for (group file) + (when gnus-cache-total-fetched-hashtb + (gnus-cache-with-refreshed-group + group + (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) + (gnus-sethash group (make-list 2 0) + gnus-cache-total-fetched-hashtb))) + (file-name-coding-system nnmail-pathname-coding-system) + (size (or (nth 7 (file-attributes + (or file + (gnus-cache-file-name group ".overview")))) + 0))) + (setq gnus-cache-need-update-total-fetched-for t) + (setf (nth 0 entry) size))))) + +(defun gnus-cache-rename-group-total-fetched-for (old-group new-group) + "Record of disk space used by OLD-GROUP now associated with NEW-GROUP." + (when gnus-cache-total-fetched-hashtb + (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb))) + (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb) + (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb)))) + +(defun gnus-cache-delete-group-total-fetched-for (group) + "Delete record of disk space used by GROUP being deleted." + (when gnus-cache-total-fetched-hashtb + (gnus-sethash group nil gnus-cache-total-fetched-hashtb))) + +(defun gnus-cache-total-fetched-for (group &optional no-inhibit) + "Get total disk space used by the cache for the specified GROUP." + (unless (equal group "dummy.group") + (unless gnus-cache-total-fetched-hashtb + (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024))) + + (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb))) + (if entry + (apply '+ entry) + (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) + (+ + (gnus-cache-update-overview-total-fetched-for group nil) + (gnus-cache-update-file-total-fetched-for group nil))))))) + (provide 'gnus-cache) ;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-cite.el --- a/lisp/gnus/gnus-cite.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-cite.el Sun Oct 28 09:18:39 2007 +0000 @@ -27,6 +27,9 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile + (when (featurep 'xemacs) + (require 'easy-mmode))) ; for `define-minor-mode' (require 'gnus) (require 'gnus-range) @@ -268,7 +271,7 @@ (defface gnus-cite-10 '((((class color) (background dark)) - (:foreground "medium purple")) + (:foreground "plum1")) (((class color) (background light)) (:foreground "medium purple")) @@ -294,14 +297,28 @@ (defcustom gnus-cite-face-list '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 - gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11) + gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11) "*List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. This should make it easier to see who wrote what." :group 'gnus-cite - :type '(repeat face)) + :type '(repeat face) + :set (lambda (symbol value) + (prog1 + (custom-set-default symbol value) + (if (boundp 'gnus-message-max-citation-depth) + (setq gnus-message-max-citation-depth (length value))) + (if (boundp 'gnus-message-citation-keywords) + (setq gnus-message-citation-keywords + `((gnus-message-search-citation-line + ,@(let ((list nil) + (count 1)) + (dolist (face value (nreverse list)) + (push (list count (list 'quote face) 'prepend t) + list) + (setq count (1+ count))))))))))) (defcustom gnus-cite-hide-percentage 50 "Only hide excess citation if above this percentage of the body." @@ -367,7 +384,7 @@ ;;; Commands: -(defun gnus-article-highlight-citation (&optional force) +(defun gnus-article-highlight-citation (&optional force same-buffer) "Highlight cited text. Each citation in the article will be highlighted with a different face. The faces are taken from `gnus-cite-face-list'. @@ -381,7 +398,8 @@ `gnus-cite-attribution-prefix' are considered attribution lines." (interactive (list 'force)) (save-excursion - (set-buffer gnus-article-buffer) + (unless same-buffer + (set-buffer gnus-article-buffer)) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) @@ -416,7 +434,7 @@ (goto-char (point-min)) (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix - (gnus-point-at-eol) + (point-at-eol) t) (gnus-article-add-button (match-beginning 1) (match-end 1) 'gnus-cite-toggle prefix)) @@ -770,7 +788,7 @@ ;; Each line. (setq begin (point) guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) - end (gnus-point-at-bol 2) + end (point-at-bol 2) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. @@ -793,7 +811,7 @@ ;; Each prefix. (setq end (match-end 0) prefix (buffer-substring begin end)) - (gnus-set-text-properties 0 (length prefix) nil prefix) + (set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) (if entry (setcdr entry (cons line (cdr entry))) @@ -803,13 +821,24 @@ (setq line (1+ line))) ;; Horrible special case for some Microsoft mailers. (goto-char (point-min)) - (when (re-search-forward gnus-cite-unsightly-citation-regexp max t) - (setq begin (count-lines (point-min) (point))) - (setq end (count-lines (point-min) max)) - (setq entry nil) - (while (< begin end) - (push begin entry) - (setq begin (1+ begin))) + (setq start t begin nil entry nil) + (while start + ;; Assume this search ends up at the beginning of a line. + (if (re-search-forward gnus-cite-unsightly-citation-regexp max t) + (progn + (when (number-or-marker-p start) + (setq begin (count-lines (point-min) start) + end (count-lines (point-min) (match-beginning 0)))) + (setq start (match-end 0))) + (when (number-or-marker-p start) + (setq begin (count-lines (point-min) start) + end (count-lines (point-min) max))) + (setq start nil)) + (when begin + (while (< begin end) + ;; Need to do 1+ because we're in the bol. + (push (setq begin (1+ begin)) entry)))) + (when entry (push (cons "" entry) alist)) ;; We got all the potential prefixes. Now create ;; `gnus-cite-prefix-alist' containing the oldest prefix for each @@ -875,11 +904,10 @@ (let ((al (buffer-substring (save-excursion (beginning-of-line 0) (1+ (point))) end))) - (if (not (assoc al al-alist)) - (progn - (push (list wrote in prefix tag) - gnus-cite-loose-attribution-alist) - (push (cons al t) al-alist)))))))) + (when (not (assoc al al-alist)) + (push (list wrote in prefix tag) + gnus-cite-loose-attribution-alist) + (push (cons al t) al-alist))))))) (defun gnus-cite-connect-attributions () ;; Connect attributions to citations @@ -1101,6 +1129,108 @@ (setq found t))) found))) + +;; Highlighting of different citation levels in message-mode. +;; - message-cite-prefix will be overridden if this is enabled. + +(defvar gnus-message-max-citation-depth + (length gnus-cite-face-list) + "Maximum supported level of citation.") + +(defvar gnus-message-cite-prefix-regexp + (concat "^\\(?:" message-cite-prefix-regexp "\\)")) + +(defun gnus-message-search-citation-line (limit) + "Search for a cited line and set match data accordingly. +Returns nil if there is no such line before LIMIT, t otherwise." + (when (re-search-forward gnus-message-cite-prefix-regexp limit t) + (let ((cdepth (min (length (apply 'concat + (split-string + (match-string-no-properties 0) + "[ \t [:alnum:]]+"))) + gnus-message-max-citation-depth)) + (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil)) + (start (point-at-bol)) + (end (point-at-eol))) + (setcar mlist start) + (setcar (cdr mlist) end) + (setcar (nthcdr (* cdepth 2) mlist) start) + (setcar (nthcdr (1+ (* cdepth 2)) mlist) end) + (set-match-data mlist)) + t)) + +(defvar gnus-message-citation-keywords + ;; eval-when-compile ;; This breaks in XEmacs + `((gnus-message-search-citation-line + ,@(let ((list nil) + (count 1)) + ;; (require 'gnus-cite) + (dolist (face gnus-cite-face-list (nreverse list)) + (push (list count (list 'quote face) 'prepend t) list) + (setq count (1+ count)))))) ;; + "Keywords for highlighting different levels of message citations.") + +(eval-when-compile + (defvar font-lock-defaults-computed) + (defvar font-lock-keywords) + (defvar font-lock-set-defaults)) + +(eval-and-compile + (unless (featurep 'xemacs) + (autoload 'font-lock-set-defaults "font-lock"))) + +(define-minor-mode gnus-message-citation-mode + "Toggle `gnus-message-citation-mode' in current buffer. +This buffer local minor mode provides additional font-lock support for +nested citations. +With prefix ARG, turn `gnus-message-citation-mode' on if and only if ARG +is positive. +Automatically turn `font-lock-mode' on when `gnus-message-citation-mode' +is turned on." + nil ;; init-value + "" ;; lighter + nil ;; keymap + (when (eq major-mode 'message-mode) + (let ((defaults (car (if (featurep 'xemacs) + (get 'message-mode 'font-lock-defaults) + font-lock-defaults))) + default keywords) + (while defaults + (setq default (if (consp defaults) + (pop defaults) + (prog1 + defaults + (setq defaults nil)))) + (if gnus-message-citation-mode + ;; `gnus-message-citation-keywords' should be the last + ;; elements of the keywords because the others are unlikely + ;; to have the OVERRIDE flags -- XEmacs applies a keyword + ;; having no OVERRIDE flag to matched text even if it has + ;; already other faces, while Emacs doesn't. + (set (make-local-variable default) + (append (default-value default) + gnus-message-citation-keywords)) + (kill-local-variable default)))) + ;; Force `font-lock-set-defaults' to update `font-lock-keywords'. + (if (featurep 'xemacs) + (progn + (require 'font-lock) + (setq font-lock-defaults-computed nil + font-lock-keywords nil)) + (setq font-lock-set-defaults nil)) + (font-lock-set-defaults) + (cond ((symbol-value 'font-lock-mode) + (font-lock-fontify-buffer)) + (gnus-message-citation-mode + (font-lock-mode 1))))) + +(defun turn-on-gnus-message-citation-mode () + "Turn on `gnus-message-citation-mode'." + (gnus-message-citation-mode 1)) +(defun turn-off-gnus-message-citation-mode () + "Turn off `gnus-message-citation-mode'." + (gnus-message-citation-mode -1)) + (gnus-ems-redefine) (provide 'gnus-cite) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-cus.el --- a/lisp/gnus/gnus-cus.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-cus.el Sun Oct 28 09:18:39 2007 +0000 @@ -980,7 +980,7 @@ (deflt (if (,field defaults) (concat " [" (gnus-trim-whitespace (gnus-pp-to-string (,field defaults))) - "]"))) + "]"))) symb) (if (eq (car type) 'radio) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-delay.el --- a/lisp/gnus/gnus-delay.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-delay.el Sun Oct 28 09:18:39 2007 +0000 @@ -152,7 +152,7 @@ (message-send-hook (copy-sequence message-send-hook)) articles article deadline) - (when (gnus-gethash group gnus-newsrc-hashtb) + (when (gnus-group-entry group) (gnus-activate-group group) (add-hook 'message-send-hook '(lambda () diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-demon.el --- a/lisp/gnus/gnus-demon.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-demon.el Sun Oct 28 09:18:39 2007 +0000 @@ -35,10 +35,6 @@ (require 'nntp) (require 'nnmail) (require 'gnus-util) -(eval-and-compile - (if (featurep 'xemacs) - (require 'itimer) - (require 'timer))) (autoload 'parse-time-string "parse-time" nil nil) @@ -109,7 +105,7 @@ (when gnus-demon-handlers ;; Set up the timer. (setq gnus-demon-timer - (nnheader-run-at-time + (run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) ;; Reset control variables. (setq gnus-demon-handler-state diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-diary.el --- a/lisp/gnus/gnus-diary.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-diary.el Sun Oct 28 09:18:39 2007 +0000 @@ -251,32 +251,32 @@ ;; - a nice summary line format ;; - NNDiary specific sorting by schedule functions ;; In general, try not to mess with what the user might have modified. - (let ((posting-style (gnus-group-get-parameter group 'posting-style t))) - ;; Posting style: - (mapcar (lambda (elt) - (let ((header (format "X-Diary-%s" (car elt)))) - (unless (assoc header posting-style) - (setq posting-style (append posting-style - `((,header "*"))))) - )) - nndiary-headers) - (gnus-group-set-parameter group 'posting-style posting-style) - ;; Summary line format: - (unless (gnus-group-get-parameter group 'gnus-summary-line-format t) - (gnus-group-set-parameter group 'gnus-summary-line-format - `(,gnus-diary-summary-line-format))) - ;; Sorting by schedule: - (unless (gnus-group-get-parameter group 'gnus-article-sort-functions) - (gnus-group-set-parameter group 'gnus-article-sort-functions - '((append gnus-article-sort-functions - (list - 'gnus-article-sort-by-schedule))))) - (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions) - (gnus-group-set-parameter group 'gnus-thread-sort-functions - '((append gnus-thread-sort-functions - (list - 'gnus-thread-sort-by-schedule))))) - )) + + ;; Posting style: + (let ((posting-style (gnus-group-get-parameter group 'posting-style t)) + (headers nndiary-headers) + header) + (while headers + (setq header (format "X-Diary-%s" (caar headers)) + headers (cdr headers)) + (unless (assoc header posting-style) + (setq posting-style (append posting-style (list (list header "*")))))) + (gnus-group-set-parameter group 'posting-style posting-style)) + ;; Summary line format: + (unless (gnus-group-get-parameter group 'gnus-summary-line-format t) + (gnus-group-set-parameter group 'gnus-summary-line-format + `(,gnus-diary-summary-line-format))) + ;; Sorting by schedule: + (unless (gnus-group-get-parameter group 'gnus-article-sort-functions) + (gnus-group-set-parameter group 'gnus-article-sort-functions + '((append gnus-article-sort-functions + (list + 'gnus-article-sort-by-schedule))))) + (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions) + (gnus-group-set-parameter group 'gnus-thread-sort-functions + '((append gnus-thread-sort-functions + (list + 'gnus-thread-sort-by-schedule)))))) ;; Called when a group is subscribed. This is needed because groups created ;; because of mail splitting are *not* created with the back end function. @@ -347,7 +347,7 @@ (when (re-search-forward (concat "^" header ":") nil t) (unless (eq (char-after) ? ) (insert " ")) - (setq value (buffer-substring (point) (gnus-point-at-eol))) + (setq value (buffer-substring (point) (point-at-eol))) (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value) (setq value (match-string 1 value))) (condition-case () diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-dired.el --- a/lisp/gnus/gnus-dired.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-dired.el Sun Oct 28 09:18:39 2007 +0000 @@ -72,7 +72,7 @@ (if (null arg) (not gnus-dired-mode) (> (prefix-numeric-value arg) 0))) (when gnus-dired-mode - (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) + (add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map) (gnus-run-hooks 'gnus-dired-mode-hook)))) ;;;###autoload diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-draft.el --- a/lisp/gnus/gnus-draft.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-draft.el Sun Oct 28 09:18:39 2007 +0000 @@ -75,7 +75,7 @@ ;; Set up the menu. (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) - (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) + (add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) (gnus-run-hooks 'gnus-draft-mode-hook)))) ;;; Commands @@ -105,7 +105,9 @@ (save-restriction (message-narrow-to-headers) (message-remove-header "date"))) - (save-buffer) + (let ((message-draft-headers + (delq 'Date (copy-sequence message-draft-headers)))) + (save-buffer)) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) group t)) (push @@ -160,7 +162,7 @@ (concat "^" (regexp-quote gnus-agent-target-move-group-header) ":") nil t) (skip-syntax-forward "-") - (setq move-to (buffer-substring (point) (gnus-point-at-eol))) + (setq move-to (buffer-substring (point) (point-at-eol))) (message-remove-header gnus-agent-target-move-group-header)) (goto-char (point-min)) (when (re-search-forward @@ -238,6 +240,12 @@ (throw 'continue t) (error "Stop!")))))))) +(defcustom gnus-draft-setup-hook nil + "Hook run after setting up a draft buffer." + :group 'gnus-message + :version "23.0" ;; No Gnus + :type 'hook) + ;;; Utility functions ;;;!!!If this is byte-compiled, it fails miserably. @@ -285,7 +293,8 @@ (gnus-add-mark ,(car ga) 'replied ,article) (gnus-request-set-mark ,(car ga) (list (list (list ,article) 'add '(reply))))) - 'send))))))) + 'send)))) + (run-hooks 'gnus-draft-setup-hook)))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-dup.el --- a/lisp/gnus/gnus-dup.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-dup.el Sun Oct 28 09:18:39 2007 +0000 @@ -85,10 +85,8 @@ (setq gnus-dup-list nil)) (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) ;; Enter all Message-IDs into the hash table. - (let ((list gnus-dup-list) - (obarray gnus-dup-hashtb)) - (while list - (intern (pop list))))) + (let ((obarray gnus-dup-hashtb)) + (mapc 'intern gnus-dup-list))) (defun gnus-dup-read () "Read the duplicate suppression list." @@ -113,11 +111,10 @@ (unless gnus-dup-list (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving - (let ((data gnus-newsgroup-data) - datum msgid) + (let (msgid) ;; Enter the Message-IDs of all read articles into the list ;; and hash table. - (while (setq datum (pop data)) + (dolist (datum gnus-newsgroup-data) (when (and (not (gnus-data-pseudo-p datum)) (> (gnus-data-number datum) 0) (not (memq (gnus-data-number datum) gnus-newsgroup-unreads)) @@ -130,6 +127,7 @@ ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) (when end + (mapc (lambda (id) (unintern id gnus-dup-hashtb)) (cdr end)) (setcdr end nil)))) (defun gnus-dup-suppress-articles () @@ -137,11 +135,10 @@ (unless gnus-dup-list (gnus-dup-open)) (gnus-message 6 "Suppressing duplicates...") - (let ((headers gnus-newsgroup-headers) - (auto (and gnus-newsgroup-auto-expire + (let ((auto (and gnus-newsgroup-auto-expire (memq gnus-duplicate-mark gnus-auto-expirable-marks))) - number header) - (while (setq header (pop headers)) + number) + (dolist (header gnus-newsgroup-headers) (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) (gnus-summary-article-unread-p (mail-header-number header))) (setq gnus-newsgroup-unreads @@ -155,7 +152,8 @@ (defun gnus-dup-unsuppress-article (article) "Stop suppression of ARTICLE." - (let ((id (mail-header-id (gnus-data-header (gnus-data-find article))))) + (let* ((header (gnus-data-header (gnus-data-find article))) + (id (when header (mail-header-id header)))) (when id (setq gnus-dup-list-dirty t) (setq gnus-dup-list (delete id gnus-dup-list)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-eform.el --- a/lisp/gnus/gnus-eform.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-eform.el Sun Oct 28 09:18:39 2007 +0000 @@ -86,13 +86,14 @@ (make-local-variable 'gnus-prev-winconf) (gnus-run-mode-hooks 'gnus-edit-form-mode-hook)) -(defun gnus-edit-form (form documentation exit-func) +(defun gnus-edit-form (form documentation exit-func &optional layout) "Edit FORM in a new buffer. Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning -of the buffer." +of the buffer. +The optional LAYOUT overrides the `edit-form' window layout." (let ((winconf (current-window-configuration))) (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer)) - (gnus-configure-windows 'edit-form) + (gnus-configure-windows (or layout 'edit-form)) (gnus-edit-form-mode) (setq gnus-prev-winconf winconf) (setq gnus-edit-form-done-function exit-func) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-ems.el --- a/lisp/gnus/gnus-ems.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-ems.el Sun Oct 28 09:18:39 2007 +0000 @@ -38,21 +38,17 @@ (defvar gnus-down-mouse-2 [down-mouse-2]) (defvar gnus-widget-button-keymap nil) (defvar gnus-mode-line-modified - (if (or (featurep 'xemacs) - (< emacs-major-version 20)) + (if (featurep 'xemacs) '("--**-" . "-----") '("**" "--"))) (eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt") (autoload 'gnus-get-buffer-create "gnus") (autoload 'nnheader-find-etc-directory "nnheader")) (autoload 'smiley-region "smiley") -;; Fixme: shouldn't require message -(autoload 'message-text-with-property "message") (defun gnus-kill-all-overlays () "Delete all overlays in the current buffer." @@ -73,12 +69,6 @@ valstr))) (eval-and-compile - (defalias 'gnus-char-width - (if (fboundp 'char-width) - 'char-width - (lambda (ch) 1)))) ;; A simple hack. - -(eval-and-compile (if (featurep 'xemacs) (gnus-xmas-define) (defvar gnus-mouse-face-prop 'mouse-face @@ -149,6 +139,18 @@ gnus-mouse-face-prop gnus-mouse-face) (insert " " gnus-tmp-subject-or-nil "\n"))))) +;; Clone of `appt-select-lowest-window' in appt.el. +(defun gnus-select-lowest-window () +"Select the lowest window on the frame." + (let ((lowest-window (selected-window)) + (bottom-edge (nth 3 (window-edges)))) + (walk-windows (lambda (w) + (let ((next-bottom-edge (nth 3 (window-edges w)))) + (when (< bottom-edge next-bottom-edge) + (setq bottom-edge next-bottom-edge + lowest-window w))))) + (select-window lowest-window))) + (defun gnus-region-active-p () "Say whether the region is active." (and (boundp 'transient-mark-mode) @@ -160,16 +162,6 @@ "Non-nil means the mark and region are currently active in this buffer." mark-active) ; aliased to region-exists-p in XEmacs. -(if (fboundp 'add-minor-mode) - (defalias 'gnus-add-minor-mode 'add-minor-mode) - (defun gnus-add-minor-mode (mode name map &rest rest) - (set (make-local-variable mode) t) - (unless (assq mode minor-mode-alist) - (push `(,mode ,name) minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode map) - minor-mode-map-alist)))) - (defun gnus-x-splash () "Show a splash screen using a pixmap in the current buffer." (interactive) @@ -289,13 +281,26 @@ glyph)) (defun gnus-remove-image (image &optional category) - (dolist (position (message-text-with-property 'display)) - (when (and (equal (get-text-property position 'display) image) - (equal (get-text-property position 'gnus-image-category) + "Remove the image matching IMAGE and CATEGORY found first." + (let ((start (point-min)) + val end) + (while (and (not end) + (or (setq val (get-text-property start 'display)) + (and (setq start + (next-single-property-change start 'display)) + (setq val (get-text-property start 'display))))) + (setq end (or (next-single-property-change start 'display) + (point-max))) + (if (and (equal val image) + (equal (get-text-property start 'gnus-image-category) category)) - (put-text-property position (1+ position) 'display nil) - (when (get-text-property position 'gnus-image-text-deletable) - (delete-region position (1+ position)))))) + (progn + (put-text-property start end 'display nil) + (when (get-text-property start 'gnus-image-text-deletable) + (delete-region start end))) + (unless (= end (point-max)) + (setq start end + end nil)))))) (provide 'gnus-ems) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-fun.el --- a/lisp/gnus/gnus-fun.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-fun.el Sun Oct 28 09:18:39 2007 +0000 @@ -46,21 +46,37 @@ :group 'gnus-fun :type 'string) -(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface" +(defcustom gnus-convert-image-to-x-face-command + "convert -scale 48x48! %s xbm:- | xbm2xface.pl" "Command for converting an image to an X-Face. +The command must take a image filename (use \"%s\") as input. +The output must be the Face header data on stdout in PNG format. + By default it takes a GIF filename and output the X-Face header data on stdout." :version "22.1" :group 'gnus-fun - :type 'string) + :type '(choice (const :tag "giftopnm, netpbm (GIF input only)" + "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface") + (const :tag "convert" + "convert -scale 48x48! %s xbm:- | xbm2xface.pl") + (string))) -(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng" +(defcustom gnus-convert-image-to-face-command + "convert -scale 48x48! %s -colors %d png:-" "Command for converting an image to a Face. -By default it takes a JPEG filename and output the Face header data -on stdout." + +The command must take an image filename (first format argument +\"%s\") and the number of colors (second format argument: \"%d\") +as input. The output must be the Face header data on stdout in +PNG format." :version "22.1" :group 'gnus-fun - :type 'string) + :type '(choice (const :tag "djpeg, netpbm (JPG input only)" + "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng") + (const :tag "convert" + "convert -scale 48x48! %s -colors %d png:-") + (string))) (defun gnus-shell-command-to-string (command) "Like `shell-command-to-string' except not mingling ERROR." @@ -102,8 +118,11 @@ ;;;###autoload (defun gnus-x-face-from-file (file) - "Insert an X-Face header based on an image file." - (interactive "fImage file name (by default GIF): ") + "Insert an X-Face header based on an image file. + +Depending on `gnus-convert-image-to-x-face-command' it may accept +different input formats." + (interactive "fImage file name: ") (when (file-exists-p file) (gnus-shell-command-to-string (format gnus-convert-image-to-x-face-command @@ -111,8 +130,11 @@ ;;;###autoload (defun gnus-face-from-file (file) - "Return a Face header based on an image file." - (interactive "fImage file name (by default JPEG): ") + "Return a Face header based on an image file. + +Depending on `gnus-convert-image-to-face-command' it may accept +different input formats." + (interactive "fImage file name: ") (when (file-exists-p file) (let ((done nil) (attempt "") @@ -127,7 +149,7 @@ quant)))) (if (> (length attempt) 726) (progn - (setq quant (- quant 2)) + (setq quant (- quant (if (< quant 10) 1 2))) (gnus-message 9 "Length %d; trying quant %d" (length attempt) quant)) (setq done t))) @@ -197,11 +219,11 @@ 'xface (gnus-put-image (if (gnus-image-type-available-p 'xface) - (gnus-create-image - (concat "X-Face: " data) - 'xface t :face 'gnus-x-face) - (gnus-create-image - pbm 'pbm t :face 'gnus-x-face)) nil 'xface)) + (apply 'gnus-create-image (concat "X-Face: " data) 'xface t + (cdr (assq 'xface gnus-face-properties-alist))) + (apply 'gnus-create-image pbm 'pbm t + (cdr (assq 'pbm gnus-face-properties-alist)))) + nil 'xface)) (gnus-add-wash-type 'xface)))))) (defun gnus-grab-cam-x-face () diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-gl.el --- a/lisp/gnus/gnus-gl.el Sun Oct 28 04:58:17 2007 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,860 +0,0 @@ -;;; gnus-gl.el --- an interface to GroupLens for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. - -;; Author: Brad Miller -;; Keywords: news, score - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GroupLens software and documentation is copyright (c) 1995 by Paul -;; Resnick (Massachusetts Institute of Technology); Brad Miller, John -;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), -;; and David Maltz (Carnegie-Mellon University). -;; -;; Permission to use, copy, modify, and distribute this documentation -;; for non-commercial and commercial purposes without fee is hereby -;; granted provided that this copyright notice and permission notice -;; appears in all copies and that the names of the individuals and -;; institutions holding this copyright are not used in advertising or -;; publicity pertaining to this software without specific, written -;; prior permission. The copyright holders make no representations -;; about the suitability of this software and documentation for any -;; purpose. It is provided ``as is'' without express or implied -;; warranty. -;; -;; The copyright holders request that they be notified of -;; modifications of this code. Please send electronic mail to -;; grouplens@cs.umn.edu for more information or to announce derived -;; works. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Author: Brad Miller -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; User Documentation: -;; To use GroupLens you must load this file. -;; You must also register a pseudonym with the Better Bit Bureau. -;; http://www.cs.umn.edu/Research/GroupLens -;; -;; ---------------- For your .emacs or .gnus file ---------------- -;; -;; As of version 2.5, grouplens now works as a minor mode of -;; gnus-summary-mode. To get make that work you just need a couple of -;; hooks. -;; (setq gnus-use-grouplens t) -;; (setq grouplens-pseudonym "") -;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") -;; -;; (setq gnus-summary-default-score 0) -;; -;; USING GROUPLENS -;; How do I Rate an article?? -;; Before you type n to go to the next article, hit a number from 1-5 -;; Type r in the summary buffer and you will be prompted. -;; Note that when you're in grouplens-minor-mode 'r' masks the -;; usual reply binding for 'r' -;; -;; What if, Gasp, I find a bug??? -;; Please type M-x gnus-gl-submit-bug-report. This will set up a -;; mail buffer with the state of variables and buffers that will help -;; me debug the problem. A short description up front would help too! -;; -;; How do I display the prediction for an article: -;; If you set the gnus-summary-line-format as shown above, the score -;; (prediction) will be shown automatically. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes -;; 10/9/95 -;; gnus-scores-articles contains the articles -;; When scoring is done, the call tree looks something like: -;; gnus-possibly-score-headers -;; ==> gnus-score-headers -;; ==> gnus-score-load-file -;; ==> get-all-mids (from the eval form) -;; -;; it would be nice to have one that gets called after all the other -;; headers have been scored. -;; we may want a variable gnus-grouplens-scale-factor -;; and gnus-grouplens-offset this would probably be either -3 or 0 -;; to make the scores centered around zero or not. -;; Notes 10/12/95 -;; According to Lars, Norse god of gnus, the simple way to insert a -;; call to an external function is to have a function added to the -;; variable gnus-score-find-files-function This new function -;; gnus-grouplens-score-alist will return a core alist that -;; has (("message-id" ("" score) ("" score)) -;; This seems like it would be pretty inefficient, though workable. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 3. Add some more ways to rate messages -;; 4. Better error handling for token timeouts. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bugs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus-score) -(require 'gnus) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gnus-summary-grouplens-line-format - "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n" - "*The line format spec in summary GroupLens mode buffers.") - -(defvar grouplens-pseudonym "" - "User's pseudonym. -This pseudonym is obtained during the registration process") - -(defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running.") - -(defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening.") - -(defvar grouplens-newsgroups - '("comp.groupware" "comp.human-factors" "comp.lang.c++" - "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" - "comp.os.linux.announce" "comp.os.linux.answers" - "comp.os.linux.development" "comp.os.linux.development.apps" - "comp.os.linux.development.system" "comp.os.linux.hardware" - "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" - "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" - "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "rec.food.recipes" "rec.humor") - "*Groups that are part of the GroupLens experiment.") - -(defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, - confidence-interval -- a numeric confidence interval - prediction-bar -- |##### | the longer the bar, the better the article, - confidence-bar -- | ----- } the prediction is in the middle of the bar, - confidence-spot -- ) * | the spot gets bigger with more confidence, - prediction-num -- plain-old numeric value, - confidence-plus-minus -- prediction +/i confidence") - -(defvar grouplens-score-offset 0 - "Offset the prediction by this value. -Setting this variable to -2 would have the following effect on -GroupLens scores: - - 1 --> -2 - 2 --> -1 - 3 --> 0 - 4 --> 1 - 5 --> 2 - -The reason is that a user might want to do this is to combine -GroupLens predictions with scores calculated by other score methods.") - -(defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset.") - -(defvar gnus-grouplens-override-scoring 'override - "Tell GroupLens to override the normal Gnus scoring mechanism. -GroupLens scores can be combined with gnus scores in one of three ways. -'override -- just use grouplens predictions for grouplens groups -'combine -- combine grouplens scores with gnus scores -'separate -- treat grouplens scores completely separate from gnus") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Program global variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-bbb-token nil - "Current session token number.") - -(defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process.") - -(defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process.") - -(defvar grouplens-rating-alist nil - "Current set of message-id rating pairs.") - -(defvar grouplens-current-hashtable nil - "A hashtable to hold predictions from the BBB.") - -(defvar grouplens-current-group nil) - -;;(defvar bbb-alist nil) - -(defvar bbb-timeout-secs 10 - "Number of seconds to wait for some response from the BBB. -If this times out we give up and assume that something has died..." ) - -(defvar grouplens-previous-article nil - "Message-ID of the last article read.") - -(defvar bbb-read-point) -(defvar bbb-response-point) - -(defun bbb-renew-hash-table () - (setq grouplens-current-hashtable (make-vector 100 0))) - -(bbb-renew-hash-table) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Utility Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer - (gnus-get-buffer-create (format " *BBBD trace: %s*" host))) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (make-local-variable 'bbb-read-point) - (make-local-variable 'bbb-response-point) - (setq bbb-read-point (point-min)))) - - ;; if an old process is still running for some reason, kill it - (when grouplens-bbb-process - (ignore-errors - (when (eq 'open (process-status grouplens-bbb-process)) - (set-process-buffer grouplens-bbb-process nil) - (delete-process grouplens-bbb-process)))) - - ;; clear the trace buffer of old output - (save-excursion - (set-buffer grouplens-bbb-buffer) - (erase-buffer)) - - ;; open the connection to the server - (catch 'done - (condition-case error - (setq grouplens-bbb-process - (open-network-stream "BBBD" grouplens-bbb-buffer host port)) - (error (gnus-message 3 "Error: Failed to connect to BBB") - nil)) - (and (null grouplens-bbb-process) - (throw 'done nil)) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (setq bbb-read-point (point-min)) - (or (bbb-read-response grouplens-bbb-process) - (throw 'done nil)))) - - ;; return the process - grouplens-bbb-process) - -(defun bbb-send-command (process command) - (goto-char (point-max)) - (insert command) - (insert "\r\n") - (setq bbb-read-point (point)) - (setq bbb-response-point (point)) - (set-marker (process-mark process) (point)) ; process output also comes here - (process-send-string process command) - (process-send-string process "\r\n") - (process-send-eof process)) - -(defun bbb-read-response (process) - "This function eats the initial response of OK or ERROR from the BBB." - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward "\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char bbb-read-point) - (setq bbb-read-point match-end) - (looking-at "OK"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Login Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-login () - "return the token number if login is successful, otherwise return nil." - (interactive) - (setq grouplens-bbb-token nil) - (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (concat "login " grouplens-pseudonym)) - (if (bbb-read-response bbb-process) - (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) - (gnus-message 3 "Error: you must set a pseudonym")) - grouplens-bbb-token) - -(defun bbb-extract-token-number () - (let ((token-pos (search-forward "token=" nil t))) - (when (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) - -(gnus-add-shutdown 'bbb-logout 'gnus) - -(defun bbb-logout () - "logout of bbb session." - (when grouplens-bbb-token - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) - (bbb-read-response bbb-process)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Get Predictions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-build-mid-scores-alist (groupname) - "this function can be called as part of the function to return the list of score files to use. -See the gnus variable `gnus-score-find-score-files-function'. - -*Note:* If you want to use grouplens scores along with calculated scores, -you should see the offset and scale variables. At this point, I don't -recommend using both scores and grouplens predictions together." - (setq grouplens-current-group groupname) - (when (member groupname grouplens-newsgroups) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list - (list - (list (append (list "message-id") - (bbb-get-predictions (bbb-get-all-mids) groupname))))))) - -(defun bbb-get-predictions (midlist groupname) - "Ask the bbb for predictions, and build up the score alist." - (gnus-message 5 "Fetching Predictions...") - (if grouplens-bbb-token - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (if (bbb-read-response bbb-process) - (bbb-get-prediction-response bbb-process) - (gnus-message 1 "Invalid Token, login and try again") - (ding))))) - (gnus-message 3 "Error: You are not logged in to a BBB") - (ding))) - -(defun bbb-get-all-mids () - (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) - -(defun bbb-build-predict-command (mlist grpname token) - (concat "getpredictions " token " " grpname "\r\n" - (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) - -(defun bbb-get-prediction-response (process) - (let ((case-fold-search nil)) - (goto-char bbb-read-point) - (while (and (not (search-forward ".\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (goto-char (+ bbb-response-point 4));; we ought to be right before OK - (bbb-build-response-alist))) - -;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. -(defun bbb-build-response-alist () - (let (resp mid pred) - (while - (cond - ((looking-at "\\(<.*>\\) :nopred=") - ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) - resp)) - -;; these "get" functions assume that there is an active match lying -;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction, the third and fourth -;; are the confidence interval -;; -;; Since gnus assumes that scores are integer values?? we round the -;; prediction. -(defun bbb-get-mid () - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring (match-beginning 2) - (match-end 2))))) - (if (> tpred 0) - (round (* grouplens-score-scale-factor - (+ grouplens-score-offset tpred))) - 1))) - -(defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -(defun bbb-get-confh () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Prediction Display -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst grplens-rating-range 4.0) -(defconst grplens-maxrating 5) -(defconst grplens-minrating 1) -(defconst grplens-predstringsize 12) - -(defvar gnus-tmp-score) -(defun bbb-grouplens-score (header) - (if (eq gnus-grouplens-override-scoring 'separate) - (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (iscore gnus-tmp-score) - (low (car (cdr hashent))) - (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (member grouplens-current-group grouplens-newsgroups) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< iscore 0) - (setq iscore 1)) - ((> iscore 5) - (setq iscore 5)))) - (setq low 0) - (setq high 0)) - (if (and (bbb-valid-score iscore) - (not (null mid))) - (cond - ;; prediction-spot - ((equal grouplens-prediction-display 'prediction-spot) - (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) - ;; confidence-interval - ((equal grouplens-prediction-display 'confidence-interval) - (setq rate-string (bbb-fmt-confidence-interval iscore low high))) - ;; prediction-bar - ((equal grouplens-prediction-display 'prediction-bar) - (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) - ;; confidence-bar - ((equal grouplens-prediction-display 'confidence-bar) - (setq rate-string (format "| %4.2f |" iscore))) - ;; confidence-spot - ((equal grouplens-prediction-display 'confidence-spot) - (setq rate-string (format "| %4.2f |" iscore))) - ;; prediction-num - ((equal grouplens-prediction-display 'prediction-num) - (setq rate-string (bbb-fmt-prediction-num iscore))) - ;; confidence-plus-minus - ((equal grouplens-prediction-display 'confidence-plus-minus) - (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) - ) - (t (gnus-message 3 "Invalid prediction display type"))) - (aset rate-string 5 ?N) (aset rate-string 6 ?A)) - rate-string))) - -;; Gnus user format function that doesn't depend on -;; bbb-build-mid-scores-alist being used as the score function, but is -;; instead called from gnus-select-group-hook. -- LAB -(defun bbb-grouplens-other-score (header) - (if (not (member grouplens-current-group grouplens-newsgroups)) - ;; Return an empty string - "" - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (pred (or (nth 0 hashent) 0)) - (low (nth 1 hashent)) - (high (nth 2 hashent))) - ;; Init rate-string - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< pred 0) - (setq pred 1)) - ((> pred 5) - (setq pred 5)))) - ;; If no entry in BBB hash mark rate string as NA and return - (cond - ((null hashent) - (aset rate-string 5 ?N) - (aset rate-string 6 ?A) - rate-string) - - ((equal grouplens-prediction-display 'prediction-spot) - (bbb-fmt-prediction-spot rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-interval) - (bbb-fmt-confidence-interval pred low high)) - - ((equal grouplens-prediction-display 'prediction-bar) - (bbb-fmt-prediction-bar rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-bar) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'confidence-spot) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'prediction-num) - (bbb-fmt-prediction-num pred)) - - ((equal grouplens-prediction-display 'confidence-plus-minus) - (bbb-fmt-confidence-plus-minus pred low high)) - - (t - (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - rate-string))))) - -(defun bbb-valid-score (score) - (or (equal grouplens-prediction-display 'prediction-num) - (and (>= score grplens-minrating) - (<= score grplens-maxrating)))) - -(defun bbb-requires-confidence (format-type) - (or (equal format-type 'confidence-plus-minus) - (equal format-type 'confidence-spot) - (equal format-type 'confidence-interval))) - -(defun bbb-have-confidence (clow chigh) - (not (or (null clow) - (null chigh)))) - -(defun bbb-fmt-prediction-spot (rate-string score) - (aset rate-string - (round (* (/ (- score grplens-minrating) grplens-rating-range) - (+ (- grplens-predstringsize 4) 1.49))) - ?*) - rate-string) - -(defun bbb-fmt-confidence-interval (score low high) - (if (bbb-have-confidence low high) - (format "|%4.2f-%4.2f |" low high) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-confidence-plus-minus (score low high) - (if (bbb-have-confidence low high) - (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) - (step (/ grplens-rating-range (- grplens-predstringsize 4))) - (half-step (/ step 2)) - (loc (- grplens-minrating half-step))) - (while (< i (- grplens-predstringsize 2)) - (if (> score loc) - (aset rate-string i ?#) - (aset rate-string i ?\ )) - (setq i (+ i 1)) - (setq loc (+ loc step))) - ) - rate-string) - -(defun bbb-fmt-prediction-num (score) - (format "| %4.2f |" score)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Put Ratings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-put-ratings () - (if (and grouplens-bbb-token - grouplens-rating-alist - (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port)) - (rate-command (bbb-build-rate-command grouplens-rating-alist))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (gnus-message 5 "Sending Ratings...") - (bbb-send-command bbb-process rate-command) - (if (bbb-read-response bbb-process) - (setq grouplens-rating-alist nil) - (gnus-message 1 - "Token timed out: call bbb-login and quit again") - (ding)) - (gnus-message 5 "Sending Ratings...Done")) - (gnus-message 3 "No BBB connection"))) - (setq grouplens-rating-alist nil))) - -(defun bbb-build-rate-command (rate-alist) - (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" - (mapconcat (lambda (this) ; form (mid . (score . time)) - (concat (car this) - " :rating=" (cadr this) ".00" - " :time=" (cddr this))) - rate-alist "\r\n") - "\r\n.\r\n")) - -;; Interactive rating functions. -(defun bbb-summary-rate-article (rating &optional midin) - (interactive "nRating: ") - (when (member gnus-newsgroup-name grouplens-newsgroups) - (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating - (>= rating grplens-minrating) - (<= rating grplens-maxrating) - mid) - (let ((oldrating (assoc mid grouplens-rating-alist))) - (if oldrating - (setcdr oldrating (cons rating 0)) - (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) - (gnus-message 3 "Invalid rating"))))) - -(defun grouplens-next-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-next-unread-article)) - -(defun grouplens-best-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-best-unread-article)) - -(defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (if (numberp rating) - (gnus-summary-catchup-and-exit) - (gnus-summary-catchup-and-exit rating))) - -(defun grouplens-score-thread (score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "nRating: ") - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread)) - article) - (while (setq article (pop articles)) - (gnus-summary-goto-subject article) - (bbb-summary-rate-article score - (mail-header-id - (gnus-summary-article-header article))))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun bbb-exit-group () - (bbb-put-ratings) - (bbb-renew-hash-table)) - -(defun bbb-get-current-id () - (if gnus-current-headers - (mail-header-id gnus-current-headers) - (gnus-message 3 "You must select an article before you rate it"))) - -(defun bbb-grouplens-group-p (group) - "Say whether GROUP is a GroupLens group." - (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TIME SPENT READING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-current-starting-time nil) - -(defun grouplens-start-timer () - (setq grouplens-current-starting-time (current-time))) - -(defun grouplens-elapsed-time () - (let ((et (bbb-time-float (current-time)))) - (- et (bbb-time-float grouplens-current-starting-time)))) - -(defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) - (cadr timeval))) - -(defun grouplens-do-time () - (when (member gnus-newsgroup-name grouplens-newsgroups) - (when grouplens-previous-article - (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article - grouplens-rating-alist))) - (if (not oldrating) - (push `(,grouplens-previous-article . (0 . ,elapsed-time)) - grouplens-rating-alist) - (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) - (grouplens-start-timer) - (setq grouplens-previous-article (bbb-get-current-id)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; BUG REPORTING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst gnus-gl-version "gnus-gl.el 2.50") -(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") -(defun gnus-gl-submit-bug-report () - "Submit via mail a bug report on gnus-gl." - (interactive) - (require 'reporter) - (reporter-submit-bug-report gnus-gl-maintainer-address - (concat "gnus-gl.el " gnus-gl-version) - (list 'grouplens-pseudonym - 'grouplens-bbb-host - 'grouplens-bbb-port - 'grouplens-newsgroups - 'grouplens-bbb-token - 'grouplens-bbb-process - 'grouplens-current-group - 'grouplens-previous-article) - nil - 'gnus-gl-get-trace)) - -(defun gnus-gl-get-trace () - "Insert the contents of the BBBD trace buffer." - (when grouplens-bbb-buffer - (insert-buffer-substring grouplens-bbb-buffer))) - -;; -;; GroupLens minor mode -;; - -(defvar gnus-grouplens-mode nil - "Minor mode for providing a GroupLens interface in Gnus summary buffers.") - -(defvar gnus-grouplens-mode-map nil) - -(unless gnus-grouplens-mode-map - (setq gnus-grouplens-mode-map (make-keymap)) - (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) - -(defun gnus-grouplens-make-menu-bar () - (unless (boundp 'gnus-grouplens-menu) - (easy-menu-define - gnus-grouplens-menu gnus-grouplens-mode-map "" - '("GroupLens" - ["Login" bbb-login t] - ["Rate" bbb-summary-rate-article t] - ["Next article" grouplens-next-unread-article t] - ["Best article" grouplens-best-unread-article t] - ["Raise thread" grouplens-score-thread t] - ["Report bugs" gnus-gl-submit-bug-report t])))) - -(defun gnus-grouplens-mode (&optional arg) - "Minor mode for providing a GroupLens interface in Gnus summary buffers." - (interactive "P") - (when (and (eq major-mode 'gnus-summary-mode) - (member gnus-newsgroup-name grouplens-newsgroups)) - (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode - (if (null arg) (not gnus-grouplens-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-grouplens-mode - (gnus-make-local-hook 'gnus-select-article-hook) - (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) - (gnus-make-local-hook 'gnus-exit-group-hook) - (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) - (make-local-variable 'gnus-score-find-score-files-function) - - (cond - ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function)) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - (lambda () - (bbb-get-predictions (bbb-get-all-mids) - gnus-newsgroup-name)))) - ;; default is to override - (t - (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) - - ;; Change how summary lines look - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (setq gnus-summary-line-format gnus-summary-grouplens-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'grouplens-menu 'menu)) - (gnus-grouplens-make-menu-bar)) - (gnus-add-minor-mode - 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) - (gnus-run-hooks 'gnus-grouplens-mode-hook)))) - -(provide 'gnus-gl) - -;;; arch-tag: 6f1bab2c-c2a3-4764-9ef6-0714cd5902a4 -;;; gnus-gl.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-group.el --- a/lisp/gnus/gnus-group.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-group.el Sun Oct 28 09:18:39 2007 +0000 @@ -47,7 +47,11 @@ (require 'mm-url) (let ((features (cons 'gnus-group features))) (require 'gnus-sum)) - (defvar gnus-cache-active-hashtb)) + (unless (boundp 'gnus-cache-active-hashtb) + (defvar gnus-cache-active-hashtb nil))) + +(autoload 'gnus-agent-total-fetched-for "gnus-agent") +(autoload 'gnus-cache-total-fetched-for "gnus-cache") (defcustom gnus-group-archive-directory "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" @@ -61,7 +65,7 @@ :group 'gnus-group-foreign :type 'directory) -(defcustom gnus-no-groups-message "No gnus is bad news" +(defcustom gnus-no-groups-message "No Gnus is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start :type 'string) @@ -151,7 +155,7 @@ (function-item gnus-group-sort-by-rank) (function :tag "other" nil)))) -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n" +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -179,11 +183,11 @@ %O Moderated group (string, \"(m)\" or \"\") %P Topic indentation (string) %m Whether there is new(ish) mail in the group (char, \"%\") -%l Whether there are GroupLens predictions for this group (string) %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used %d The date the group was last entered. %E Icon as defined by `gnus-group-icon-list'. +%F The disk space used by the articles fetched by both the cache and agent. %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, where X is the letter following %u. The function will be passed a @@ -198,10 +202,10 @@ groups. If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect. +a bit of extra memory will be used. %D and %F will also worsen +performance. Also note that if you change the format specification to +include any of these specs, you must probably re-start Gnus to see +them go into effect. General format specifiers can also be used. See Info node `(gnus)Formatting Variables'." @@ -440,13 +444,20 @@ (defcustom gnus-group-jump-to-group-prompt nil "Default prompt for `gnus-group-jump-to-group'. -If non-nil, the value should be a string, e.g. \"nnml:\", -in which case `gnus-group-jump-to-group' offers \"Group: nnml:\" -in the minibuffer prompt." + +If non-nil, the value should be a string or an alist. If it is a string, +e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group: +nnml:\" in the minibuffer prompt. + +If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example: +\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is +used when no prefix argument is given to `gnus-group-jump-to-group'." :version "22.1" :group 'gnus-group-various :type '(choice (string :tag "Prompt string") - (const :tag "Empty" nil))) + (const :tag "Empty" nil) + (repeat (cons (integer :tag "Argument") + (string :tag "Prompt string"))))) (defvar gnus-group-listing-limit 1000 "*A limit of the number of groups when listing. @@ -512,11 +523,12 @@ (?P gnus-group-indentation ?s) (?E gnus-tmp-group-icon ?s) (?B gnus-tmp-summary-live ?c) - (?l gnus-tmp-grouplens ?s) (?z gnus-tmp-news-method-string ?s) (?m (gnus-group-new-mail gnus-tmp-group) ?c) (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) + (?u gnus-tmp-user-defined ?s) + (?F (gnus-total-fetched-for gnus-tmp-group) ?s) + )) (defvar gnus-group-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -648,6 +660,7 @@ "r" gnus-group-rename-group "R" gnus-group-make-rss-group "c" gnus-group-customize + "z" gnus-group-compact-group "x" gnus-group-nnimap-expunge "\177" gnus-group-delete-group [delete] gnus-group-delete-group) @@ -730,7 +743,8 @@ "?" gnus-group-list-plus) (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache) + "f" gnus-score-flush-cache + "e" gnus-score-edit-all-score) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) "c" gnus-group-fetch-charter @@ -825,6 +839,8 @@ (gnus-group-group-name)] ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] ["Customize" gnus-group-customize (gnus-group-group-name)] + ["Compact" gnus-group-compact-group + :active (gnus-group-group-name)] ("Edit" ["Parameters" gnus-group-edit-group-parameters :included (not (gnus-topic-mode-p)) @@ -1010,7 +1026,7 @@ (const :tag "Retro look" gnus-group-tool-bar-retro) (repeat :tag "User defined list" gmm-tool-bar-item) (symbol)) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-group-tool-bar-update :group 'gnus-group) @@ -1053,7 +1069,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-group-tool-bar-update :group 'gnus-group) @@ -1072,7 +1088,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-group-tool-bar-update :group 'gnus-group) @@ -1083,7 +1099,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-group-tool-bar-update :group 'gnus-group) @@ -1143,7 +1159,8 @@ (use-local-map gnus-group-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t) + (setq buffer-read-only t + show-trailing-whitespace nil) (gnus-set-default-directory) (gnus-update-format-specifications nil 'group 'group-mode) (gnus-update-group-mark-positions) @@ -1202,7 +1219,10 @@ (defun gnus-group-name-charset (method group) (if (null method) (setq method (gnus-find-method-for-group group))) - (let ((item (assoc method gnus-group-name-charset-method-alist)) + (let ((item (or (assoc method gnus-group-name-charset-method-alist) + (and (consp method) + (assoc (list (car method) (cadr method)) + gnus-group-name-charset-method-alist)))) (alist gnus-group-name-charset-group-alist) result) (if item @@ -1244,7 +1264,7 @@ (gnus-group-setup-buffer) (gnus-update-format-specifications nil 'group 'group-mode) (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) + (props (text-properties-at (point-at-bol))) (empty (= (point-min) (point-max))) (group (gnus-group-group-name)) number) @@ -1276,7 +1296,7 @@ (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) + (let ((newsrc (cdddr (gnus-group-entry group)))) (while (and newsrc (not (gnus-goto-char (text-property-any @@ -1331,7 +1351,7 @@ group (gnus-info-group info) params (gnus-info-params info) newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) + unread (gnus-group-unread group)) (when not-in-list (setq not-in-list (delete group not-in-list))) (when (gnus-group-prepare-logic @@ -1431,7 +1451,7 @@ "Update the current line in the group buffer." (let* ((buffer-read-only nil) (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) + (entry (and group (gnus-group-entry group))) gnus-group-indentation) (when group (and entry @@ -1448,7 +1468,7 @@ (defun gnus-group-insert-group-line-info (group) "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let ((entry (gnus-group-entry group)) (gnus-group-indentation (gnus-group-group-indentation)) active info) (if entry @@ -1575,10 +1595,6 @@ (gnus-tmp-process-marked (if (member gnus-tmp-group gnus-group-marked) gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) (buffer-read-only nil) beg end header gnus-tmp-header) ; passed as parameter to user-funcs. @@ -1615,7 +1631,7 @@ "Highlight the current line according to `gnus-group-highlight'." (let* ((list gnus-group-highlight) (p (point)) - (end (gnus-point-at-eol)) + (end (point-at-eol)) ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) (group (gnus-group-group-name)) @@ -1666,7 +1682,7 @@ (loc (point-min)) found buffer-read-only) ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) + (let ((entry (gnus-group-entry group))) (when (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter @@ -1691,7 +1707,7 @@ ;; go, and insert it there (or at the end of the buffer). (if gnus-goto-missing-group-function (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) + (let ((entry (cddr (gnus-group-entry group)))) (while (and entry (car entry) (not (gnus-goto-char @@ -1751,24 +1767,24 @@ (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) + (let ((group (get-text-property (point-at-bol) 'gnus-group))) (when group (symbol-name group)))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) + (get-text-property (point-at-bol) 'gnus-level)) (defun gnus-group-group-indentation () "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) + (or (get-text-property (point-at-bol) 'gnus-indentation) (and gnus-group-indentation-function (funcall gnus-group-indentation-function)) "")) (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) + (get-text-property (point-at-bol) 'gnus-unread)) (defun gnus-group-new-mail (group) (if (nnmail-new-mail-p (gnus-group-real-name group)) @@ -1826,6 +1842,18 @@ (goto-char (or pos beg)) (and pos t)))) +(defun gnus-total-fetched-for (group) + (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0)) + (size-in-agent (or (gnus-agent-total-fetched-for group) 0)) + (size (+ size-in-cache size-in-agent)) + (suffix '("B" "K" "M" "G")) + (scale 1024.0) + (cutoff scale)) + (while (> size cutoff) + (setq size (/ size scale) + suffix (cdr suffix))) + (format "%5.1f%s" size (car suffix)))) + ;;; Gnus group mode commands ;; Group marking. @@ -1847,15 +1875,14 @@ ;; Go to the mark position. (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (subst-char-in-region - (point) (1+ (point)) (char-after) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - ? ) + (delete-char 1) + (if unmark + (progn + (setq gnus-group-marked (delete group gnus-group-marked)) + (insert-char ? 1 t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))) - gnus-process-mark))) + (insert-char gnus-process-mark 1 t))) (unless no-advance (gnus-group-next-group 1)) (decf n)) @@ -1871,10 +1898,8 @@ (defun gnus-group-unmark-all-groups () "Unmark all groups." (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) + (save-excursion + (mapc 'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) @@ -2020,8 +2045,7 @@ (unless group (error "No group on current line")) (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) + (nth 2 (setq entry (gnus-group-entry group))))) ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. (setq number @@ -2051,11 +2075,11 @@ (forward-line -1)) (gnus-group-read-group all t)) -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed. -If ALL (the prefix argument) is 0, don't even generate the summary -buffer. +(defun gnus-group-quick-select-group (&optional all group) + "Select the GROUP \"quickly\". +This means that no highlighting or scoring will be performed. If +ALL (the prefix argument) is 0, don't even generate the summary +buffer. If GROUP is nil, use current group. This might be useful if you want to toggle threading before entering the group." @@ -2066,7 +2090,7 @@ gnus-home-score-file gnus-apply-kill-hook gnus-summary-expunge-below) - (gnus-group-read-group all t))) + (gnus-group-read-group all t group))) (defun gnus-group-visible-select-group (&optional all) "Select the current group without hiding any articles." @@ -2090,14 +2114,86 @@ (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) +(defun gnus-group-name-at-point () + "Return a group name from around point if it exists, or nil." + (if (eq major-mode 'gnus-group-mode) + (let ((group (gnus-group-group-name))) + (when group + (gnus-group-decoded-name group))) + (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\ +\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ +\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\ +\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)") + (start (point)) + (case-fold-search nil)) + (prog1 + (if (or (and (not (or (eobp) + (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]"))) + (prog1 t + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)))) + (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$") + (prog1 t + (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)))) + (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'" + (buffer-substring (point-at-bol) (point)))) + (when (looking-at regexp) + (match-string 1)) + (let (group distance) + (when (looking-at regexp) + (setq group (match-string 1) + distance (- (match-beginning 1) (match-beginning 0)))) + (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?") + (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?" + (point-at-bol)) + (if (looking-at regexp) + (if (and group (<= distance (- start (match-end 0)))) + group + (match-string 1)) + group))) + (goto-char start))))) + +(defun gnus-group-completing-read (prompt &optional collection predicate + require-match initial-input hist def + &rest args) + "Read a group name with completion. Non-ASCII group names are allowed. +The arguments are the same as `completing-read' except that COLLECTION +and HIST default to `gnus-active-hashtb' and `gnus-group-history' +respectively if they are omitted." + (let (group) + (mapatoms (lambda (symbol) + (setq group (symbol-name symbol)) + (set (intern (if (string-match "[^\000-\177]" group) + (gnus-group-decoded-name group) + group) + collection) + group)) + (prog1 + (or collection + (setq collection (or gnus-active-hashtb [0]))) + (setq collection (gnus-make-hashtable (length collection))))) + (setq group (apply 'completing-read prompt collection predicate + require-match initial-input + (or hist 'gnus-group-history) + def args)) + (or (prog1 + (symbol-value (intern-soft group collection)) + (setq collection nil)) + (mm-encode-coding-string group (gnus-group-name-charset nil group))))) + ;;;###autoload (defun gnus-fetch-group (group &optional articles) "Start Gnus if necessary and enter GROUP. +If ARTICLES, display those articles. Returns whether the fetching was successful or not." - (interactive (list (completing-read "Group name: " gnus-active-hashtb))) - (unless (get-buffer gnus-group-buffer) + (interactive (list (gnus-group-completing-read "Group name: " + nil nil nil + (gnus-group-name-at-point)))) + (unless (gnus-alive-p) (gnus-no-server)) - (gnus-group-read-group articles nil group)) + (gnus-group-read-group (if articles nil t) nil group articles)) ;;;###autoload (defun gnus-fetch-group-other-frame (group) @@ -2155,10 +2251,7 @@ (interactive (list ;; (gnus-read-group "Group name: ") - (completing-read - "Group: " gnus-active-hashtb - nil nil nil - 'gnus-group-history) + (gnus-group-completing-read "Group: ") (gnus-read-method "From method: "))) ;; Transform the select method into a unique server. (when (stringp method) @@ -2204,15 +2297,20 @@ (message "Quit reading the ephemeral group") nil))))) -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." +(defun gnus-group-jump-to-group (group &optional prompt) + "Jump to newsgroup GROUP. + +If PROMPT (the prefix) is a number, use the prompt specified in +`gnus-group-jump-to-group-prompt'." (interactive - (list (mm-string-make-unibyte - (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - gnus-group-jump-to-group-prompt - 'gnus-group-history)))) + (list (gnus-group-completing-read + "Group: " nil nil (gnus-read-active-file-p) + (if current-prefix-arg + (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt)) + (or (and (stringp gnus-group-jump-to-group-prompt) + gnus-group-jump-to-group-prompt) + (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt)))) + (and (stringp p) p))))))) (when (equal group "") (error "Empty group name")) @@ -2360,6 +2458,25 @@ (gnus-group-position-point) (and best-point (gnus-group-group-name)))) +;; Is there something like an after-point-motion-hook? +;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function? + +;; (defun gnus-group-menu-bar-update () +;; (let* ((buf (list (with-current-buffer gnus-group-buffer +;; (current-buffer)))) +;; (name (buffer-name (car buf)))) +;; (setcdr buf +;; (if (> (length name) 27) +;; (concat (substring name 0 12) +;; "..." +;; (substring name -12)) +;; name)) +;; (menu-bar-update-buffers-1 buf))) + +;; (defun gnus-group-position-point () +;; (gnus-goto-colon) +;; (gnus-group-menu-bar-update)) + (defun gnus-group-first-unread-group () "Go to the first group with unread articles." (interactive) @@ -2381,10 +2498,19 @@ (interactive) (gnus-enter-server-buffer)) -(defun gnus-group-make-group (name &optional method address args) +(defun gnus-group-make-group-simple (&optional group) + "Add a new newsgroup. +The user will be prompted for GROUP." + (interactive (list (gnus-group-completing-read "Group: "))) + (gnus-group-make-group (gnus-group-real-name group) + (gnus-group-server group) + nil nil t)) + +(defun gnus-group-make-group (name &optional method address args encoded) "Add a new newsgroup. The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." +ADDRESS. NAME should be a human-readable string (i.e., not be encoded +even if it contains non-ASCII characters) unless ENCODED is non-nil." (interactive (list (gnus-read-group "Group name: ") @@ -2392,6 +2518,10 @@ (when (stringp method) (setq method (or (gnus-server-to-method method) method))) + (unless encoded + (setq name (mm-encode-coding-string + name + (gnus-group-name-charset method name)))) (let* ((meth (gnus-method-simplify (when (and method (not (gnus-server-equal method gnus-select-method))) @@ -2399,15 +2529,14 @@ method)))) (nname (if method (gnus-group-prefixed-name name meth) name)) backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) + (when (gnus-group-entry nname) (error "Group %s already exists" (gnus-group-decoded-name nname))) ;; Subscribe to the new group. (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) + (gnus-group-entry (gnus-group-group-name))) t) ;; Make it active. (gnus-set-active nname (cons 1 0)) @@ -2474,7 +2603,7 @@ (gnus-message 6 "Deleting group %s...done" group-decoded) (gnus-group-goto-group group) (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) + (gnus-set-active group nil) t))) (gnus-group-position-point))) @@ -2641,7 +2770,7 @@ (interactive) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) (file (nnheader-find-etc-directory "gnus-tut.txt" t))) - (if (gnus-gethash name gnus-newsrc-hashtb) + (if (gnus-group-entry name) (cond ((eq noerror nil) (error "Documentation group already exists")) ((eq noerror t) @@ -2684,19 +2813,17 @@ nil)))) (setq type found))) (setq file (expand-file-name file)) - (let ((name (gnus-generate-new-group-name - (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc "")))) - (encodable (mm-coding-system-p 'utf-8))) + (let* ((name (gnus-generate-new-group-name + (gnus-group-prefixed-name + (file-name-nondirectory file) '(nndoc "")))) + (method (list 'nndoc file + (list 'nndoc-address file) + (list 'nndoc-article-type (or type 'guess)))) + (coding (gnus-group-name-charset method name))) + (setcar (cdr method) (mm-encode-coding-string file coding)) (gnus-group-make-group - (if encodable - (mm-encode-coding-string (gnus-group-real-name name) 'utf-8) - (gnus-group-real-name name)) - (list 'nndoc (if encodable - (mm-encode-coding-string file 'utf-8) - file) - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) + (mm-encode-coding-string (gnus-group-real-name name) coding) + method nil nil t))) (defvar nnweb-type-definition) (defvar gnus-group-web-type-history nil) @@ -2750,25 +2877,23 @@ (setq url (read-from-minibuffer "URL to Search for RSS: "))) (let ((feedinfo (nnrss-discover-feed url))) (if feedinfo - (let ((title (gnus-newsgroup-savable-name - (read-from-minibuffer "Title: " - (gnus-newsgroup-savable-name - (or (cdr (assoc 'title - feedinfo)) - ""))))) - (desc (read-from-minibuffer "Description: " - (cdr (assoc 'description - feedinfo)))) - (href (cdr (assoc 'href feedinfo))) - (encodable (mm-coding-system-p 'utf-8))) - (when encodable + (let* ((title (gnus-newsgroup-savable-name + (read-from-minibuffer "Title: " + (gnus-newsgroup-savable-name + (or (cdr (assoc 'title + feedinfo)) + ""))))) + (desc (read-from-minibuffer "Description: " + (cdr (assoc 'description + feedinfo)))) + (href (cdr (assoc 'href feedinfo))) + (coding (gnus-group-name-charset '(nnrss "") title))) + (when coding ;; Unify non-ASCII text. (setq title (mm-decode-coding-string - (mm-encode-coding-string title 'utf-8) 'utf-8))) - (gnus-group-make-group (if encodable - (mm-encode-coding-string title 'utf-8) - title) - '(nnrss "")) + (mm-encode-coding-string title coding) + coding))) + (gnus-group-make-group title '(nnrss "")) (push (list title href desc) nnrss-group-alist) (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) @@ -2815,7 +2940,7 @@ (interactive "P") (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-gethash group gnus-newsrc-hashtb) + (when (gnus-group-entry group) (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) @@ -2839,7 +2964,7 @@ (let ((ext "") (i 0) group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) + (while (or (not group) (gnus-group-entry group)) (setq group (gnus-group-prefixed-name (expand-file-name ext dir) @@ -2858,7 +2983,7 @@ (list (read-string "nnkiboze group name: ") (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) + (let ((headers (mapcar 'list '("subject" "from" "number" "date" "message-id" "references" "chars" "lines" "xref" "followup" "all" "body" "head"))) @@ -2909,7 +3034,7 @@ (let* ((method (list 'nnvirtual "^$")) (pgroup (gnus-group-prefixed-name group method))) ;; Check whether it exists already. - (when (gnus-gethash pgroup gnus-newsrc-hashtb) + (when (gnus-group-entry pgroup) (error "Group %s already exists" pgroup)) ;; Subscribe the new group after the group on the current line. (gnus-subscribe-group pgroup (gnus-group-group-name) method) @@ -3081,7 +3206,7 @@ (let (entries infos) ;; First find all the group entries for these groups. (while groups - (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) + (push (nthcdr 2 (gnus-group-entry (pop groups))) entries)) ;; Then sort the infos. (setq infos @@ -3162,8 +3287,8 @@ (defun gnus-group-sort-by-unread (info1 info2) "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) + (let ((n1 (gnus-group-unread (gnus-info-group info1))) + (n2 (gnus-group-unread (gnus-info-group info2)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) @@ -3283,13 +3408,15 @@ (when (eq 'nnvirtual (car method)) (nnvirtual-catchup-group (gnus-group-real-name group) (nth 1 method) all))) - (if (>= (gnus-group-level group) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group group) - (gnus-group-catchup group all)) - (gnus-group-update-group-line) - (setq ret (1+ ret))))) + (cond + ((>= (gnus-group-level group) gnus-level-zombie) + (gnus-message 2 "Dead groups can't be caught up")) + ((prog1 + (gnus-group-goto-group group) + (gnus-group-catchup group all)) + (gnus-group-update-group-line)) + (t + (setq ret (1+ ret))))) (gnus-group-next-unread-group 1) ret))) @@ -3304,9 +3431,9 @@ If ALL is non-nil, all articles are marked as read. The return value is the number of articles that were marked as read, or nil if no action could be taken." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry group)) (num (car entry)) - (marks (nth 3 (nth 2 entry))) + (marks (gnus-info-marks (nth 2 entry))) (unread (gnus-sequence-of-unread-articles group))) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) @@ -3321,16 +3448,18 @@ (list (cdr (assq 'dormant marks)) 'del '(dormant)))) (setq unread (gnus-range-add (gnus-range-add - unread (cdr (assq 'dormant marks))) - (cdr (assq 'tick marks)))) + unread (cdr (assq 'dormant marks))) + (cdr (assq 'tick marks)))) (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. (when (gnus-group-auto-expirable-p group) - (gnus-range-map (lambda (article) - (gnus-add-marked-articles group 'expire (list article)) - (gnus-request-set-mark group (list (list (list article) 'add '(expire))))) - unread)) + (gnus-range-map + (lambda (article) + (gnus-add-marked-articles group 'expire (list article)) + (gnus-request-set-mark group (list (list (list article) + 'add '(expire))))) + unread)) (let ((gnus-newsgroup-name group)) (gnus-run-hooks 'gnus-group-catchup-group-hook)) num))) @@ -3412,17 +3541,15 @@ s)))))) (unless (and (>= level 1) (<= level gnus-level-killed)) (error "Invalid level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - (gnus-group-decoded-name group) - (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) + (dolist (group (gnus-group-process-prefix n)) + (gnus-group-remove-mark group) + (gnus-message 6 "Changed level of %s from %d to %d" + (gnus-group-decoded-name group) + (or (gnus-group-group-level) gnus-level-killed) + level) + (gnus-group-change-level + group level (or (gnus-group-group-level) gnus-level-killed)) + (gnus-group-update-group-line)) (gnus-group-position-point)) (defun gnus-group-unsubscribe (&optional n) @@ -3460,13 +3587,9 @@ "Toggle subscription to GROUP. Killed newsgroups are subscribed. If SILENT, don't try to update the group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) + (interactive (list (gnus-group-completing-read + "Group: " nil nil (gnus-read-active-file-p)))) + (let ((newsrc (gnus-group-entry group))) (cond ((string-match "^[ \t]*$" group) (error "Empty group name")) @@ -3490,7 +3613,7 @@ gnus-level-zombie) gnus-level-killed) (when (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) + (gnus-group-entry (gnus-group-group-name)))) (unless silent (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) @@ -3529,12 +3652,10 @@ (count-lines (progn (goto-char begin) - (beginning-of-line) - (point)) + (point-at-bol)) (progn (goto-char end) - (beginning-of-line) - (point)))))) + (point-at-bol)))))) (goto-char begin) (beginning-of-line) ;Important when LINES < 1 (gnus-group-kill-group lines))) @@ -3558,7 +3679,7 @@ (setq level (gnus-group-group-level)) (gnus-delete-line) (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) + (setq entry (gnus-group-entry group))) (gnus-undo-register `(progn (gnus-group-goto-group ,(gnus-group-group-name)) @@ -3581,7 +3702,7 @@ (funcall gnus-group-change-level-function group gnus-level-killed 3)) (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) + ((setq entry (gnus-group-entry group)) (push (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups) (setcdr (cdr entry) (cdddr entry))) @@ -3614,7 +3735,7 @@ (setq prev (gnus-group-group-name)) (gnus-group-change-level info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) + (and prev (gnus-group-entry prev)) t) (gnus-group-insert-group-line-info group) (gnus-undo-register @@ -3773,6 +3894,7 @@ (gnus-get-unread-articles arg)) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) + (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) (max (car gnus-group-list-mode) arg))))) @@ -3797,15 +3919,17 @@ (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. (gnus-remove-denial (setq method (gnus-find-method-for-group group))) - (if (gnus-activate-group group (if dont-scan nil 'scan)) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) + (if (gnus-activate-group group (if dont-scan nil 'scan) nil method) + (let ((info (gnus-get-info group)) + (active (gnus-active group))) + (when info + (gnus-request-update-info info method)) + (gnus-get-unread-articles-in-group info active) (unless (gnus-virtual-group-p group) (gnus-close-group group)) (when gnus-agent (gnus-agent-save-group-info - method (gnus-group-real-name group) (gnus-active group))) + method (gnus-group-real-name group) active)) (gnus-group-update-group group)) (if (eq (gnus-server-status (gnus-find-method-for-group group)) 'denied) @@ -3851,7 +3975,7 @@ If given a prefix argument, prompt for a group." (interactive (list (or (when current-prefix-arg - (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-completing-read "Group: ")) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -3879,7 +4003,7 @@ If given a prefix argument, prompt for a group." (interactive (list (or (when current-prefix-arg - (completing-read "Group: " gnus-active-hashtb)) + (gnus-group-completing-read "Group: ")) (gnus-group-group-name) gnus-newsgroup-name))) (unless group @@ -4105,14 +4229,12 @@ (gnus-offer-save-summaries) ;; Kill Gnus buffers except for group mode buffer. (let ((group-buf (get-buffer gnus-group-buffer))) - (mapcar (lambda (buf) - (unless (or (member buf (list group-buf gnus-dribble-buffer)) - (progn - (save-excursion - (set-buffer buf) - (eq major-mode 'message-mode)))) - (gnus-kill-buffer buf))) - (gnus-buffers)) + (dolist (buf (gnus-buffers)) + (unless (or (eq buf group-buf) + (eq buf gnus-dribble-buffer) + (with-current-buffer buf + (eq major-mode 'message-mode))) + (gnus-kill-buffer buf))) (setq gnus-backlog-articles nil) (gnus-kill-gnus-frames) (when group-buf @@ -4196,17 +4318,15 @@ ;; Suggested by mapjph@bath.ac.uk. (completing-read "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) + (mapcar 'list gnus-secondary-servers))) ;; We got a server name. how)))) (gnus-browse-foreign-server method)) (defun gnus-group-set-info (info &optional method-only-group part) (when (or info part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry + (or method-only-group (gnus-info-group info)))) (part-info info) (info (if method-only-group (nth 2 entry) info)) method) @@ -4239,15 +4359,15 @@ (if (stringp method) method (prin1-to-string (car method))) (and (consp method) - (nth 1 (gnus-info-method info)))) + (nth 1 (gnus-info-method info))) + nil t) ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) + (gnus-group-make-group (gnus-info-group info) nil nil nil t))) (gnus-message 6 "Note: New group created") (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) + (gnus-group-entry (gnus-group-prefixed-name + (gnus-group-real-name (gnus-info-group info)) + (or (gnus-info-method info) gnus-select-method)))))) ;; Whether it was a new group or not, we now have the entry, so we ;; can do the update. (if entry @@ -4460,6 +4580,40 @@ (gnus-add-marked-articles group 'expire (list article)))))) + +;;; +;;; Group compaction. -- dvl +;;; + +(defun gnus-group-compact-group (group) + "Compact the current group. +Compaction means removing gaps between article numbers. Hence, this +operation is only meaningful for back ends using one file per article +\(e.g. nnml). + +Note: currently only implemented in nnml." + (interactive (list (gnus-group-group-name))) + (unless group + (error "No group to compact")) + (unless (gnus-check-backend-function 'request-compact-group group) + (error "This back end does not support group compaction")) + (let ((group-decoded (gnus-group-decoded-name group))) + (gnus-message 6 "\ +Compacting group %s... (this may take a long time)" + group-decoded) + (prog1 + (if (not (gnus-request-compact-group group)) + (gnus-error 3 "Couldn't compact group %s" group-decoded) + (gnus-message 6 "Compacting group %s...done" group-decoded) + t) + ;; Invalidate the "original article" buffer which might be out of date. + ;; #### NOTE: Yes, this might be a bit rude, but since compaction + ;; #### will not happen very often, I think this is acceptable. + (let ((original (get-buffer gnus-original-article-buffer))) + (and original (gnus-kill-buffer original))) + ;; Update the group line to reflect new information (art number etc). + (gnus-group-update-group-line)))) + (provide 'gnus-group) ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-int.el --- a/lisp/gnus/gnus-int.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-int.el Sun Oct 28 09:18:39 2007 +0000 @@ -75,7 +75,7 @@ ;; Read server name with completion. (setq gnus-nntp-server (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) + (mapcar 'list (cons (list gnus-nntp-server) gnus-secondary-servers)) nil nil gnus-nntp-server))) @@ -209,11 +209,12 @@ "Open a connection to GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((elem (assoc gnus-command-method gnus-opened-servers))) + (let ((elem (assoc gnus-command-method gnus-opened-servers)) + (server (gnus-method-to-server-name gnus-command-method))) ;; If this method was previously denied, we just return nil. (if (eq (nth 1 elem) 'denied) (progn - (gnus-message 1 "Denied server") + (gnus-message 1 "Denied server %s" server) nil) ;; Open the server. (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server)) @@ -224,11 +225,11 @@ (nthcdr 2 gnus-command-method)) (error (gnus-message 1 (format - "Unable to open server due to: %s" - (error-message-string err))) + "Unable to open server %s due to: %s" + server (error-message-string err))) nil) (quit - (gnus-message 1 "Quit trying to open server") + (gnus-message 1 "Quit trying to open server %s" server) nil))) open-offline) ;; If this hasn't been opened before, we add it to the list. @@ -253,9 +254,9 @@ ((and (not gnus-batch-mode) (gnus-y-or-n-p - (format "Unable to open %s:%s, go offline? " - (car gnus-command-method) - (cadr gnus-command-method)))) + (format + "Unable to open server %s, go offline? " + server))) (setq open-offline t) 'offline) (t @@ -335,6 +336,23 @@ (funcall (gnus-get-function gnus-command-method 'request-regenerate) (nth 1 gnus-command-method))) +(defun gnus-request-compact-group (group) + (let* ((method (gnus-find-method-for-group group)) + (gnus-command-method method) + (result + (funcall (gnus-get-function gnus-command-method + 'request-compact-group) + (gnus-group-real-name group) + (nth 1 gnus-command-method) t))) + result)) + +(defun gnus-request-compact (gnus-command-method) + "Request groups compaction from GNUS-COMMAND-METHOD." + (when (stringp gnus-command-method) + (setq gnus-command-method (gnus-server-to-method gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-compact) + (nth 1 gnus-command-method))) + (defun gnus-request-group (group &optional dont-check gnus-command-method) "Request GROUP. If DONT-CHECK, no information is required." (let ((gnus-command-method @@ -342,7 +360,7 @@ (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) + (funcall (inline (gnus-get-function gnus-command-method 'request-group)) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check))) @@ -521,12 +539,11 @@ (if group (gnus-find-method-for-group group) gnus-command-method)) (gnus-inhibit-demon t) (mail-source-plugged gnus-plugged)) - (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) - (progn - (setq gnus-internal-registry-spool-current-method gnus-command-method) - (funcall (gnus-get-function gnus-command-method 'request-scan) - (and group (gnus-group-real-name group)) - (nth 1 gnus-command-method)))))) + (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) + (setq gnus-internal-registry-spool-current-method gnus-command-method) + (funcall (gnus-get-function gnus-command-method 'request-scan) + (and group (gnus-group-real-name group)) + (nth 1 gnus-command-method))))) (defsubst gnus-request-update-info (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." @@ -566,12 +583,12 @@ not-deleted)) (defun gnus-request-move-article (article group server accept-function - &optional last) + &optional last move-is-internal) (let* ((gnus-command-method (gnus-find-method-for-group group)) (result (funcall (gnus-get-function gnus-command-method 'request-move-article) article (gnus-group-real-name group) - (nth 1 gnus-command-method) accept-function last))) + (nth 1 gnus-command-method) accept-function last move-is-internal))) (when (and result gnus-agent (gnus-agent-method-p gnus-command-method)) (gnus-agent-unfetch-articles group (list article))) @@ -597,7 +614,7 @@ (let ((mail-parse-charset message-default-charset)) (mail-encode-encoded-word-buffer))) (message-encode-message-body))) -(let ((gnus-command-method (or gnus-command-method + (let ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) (result (funcall diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-kill.el --- a/lisp/gnus/gnus-kill.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-kill.el Sun Oct 28 09:18:39 2007 +0000 @@ -497,7 +497,7 @@ (gnus-summary-mark-as-read nil \"X\"). If optional 2nd argument ALL is non-nil, articles marked are also applied to. If FIELD is an empty string (or nil), entire article body is searched for. -COMMAND must be a lisp expression or a string representing a key sequence." +COMMAND must be a Lisp expression or a string representing a key sequence." ;; We don't want to change current point nor window configuration. (let ((old-buffer (current-buffer))) (save-excursion @@ -625,7 +625,7 @@ did-kill))) (defun gnus-execute (field regexp form &optional backward unread) - "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). + "If FIELD of article header matches REGEXP, execute Lisp FORM (or a string). If FIELD is an empty string (or nil), entire article body is searched for. If optional 1st argument BACKWARD is non-nil, do backward instead. If optional 2nd argument UNREAD is non-nil, articles which are @@ -691,7 +691,7 @@ (mail-sources nil) (gnus-use-dribble-file nil) (gnus-batch-mode t) - info group newsrc entry + info group newsrc unread ;; Disable verbose message. gnus-novice-user gnus-large-newsgroup gnus-options-subscribe gnus-auto-subscribed-groups @@ -703,11 +703,11 @@ (setq newsrc (cdr gnus-newsrc-alist)) (while (setq info (pop newsrc)) (setq group (gnus-info-group info) - entry (gnus-gethash group gnus-newsrc-hashtb)) + unread (gnus-group-unread group)) (when (and (<= (gnus-info-level info) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry)))))) + (and unread + (or (eq unread t) + (not (zerop unread))))) (ignore-errors (gnus-summary-read-group group nil t nil t)) (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-ml.el --- a/lisp/gnus/gnus-ml.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-ml.el Sun Oct 28 09:18:39 2007 +0000 @@ -102,8 +102,8 @@ ;; Set up the menu. (when (gnus-visual-p 'mailing-list-menu 'menu) (gnus-mailing-list-make-menu-bar)) - (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List" - gnus-mailing-list-mode-map) + (add-minor-mode 'gnus-mailing-list-mode " Mailing-List" + gnus-mailing-list-mode-map) (gnus-run-hooks 'gnus-mailing-list-mode-hook)))) ;;; Commands diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-mlspl.el --- a/lisp/gnus/gnus-mlspl.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-mlspl.el Sun Oct 28 09:18:39 2007 +0000 @@ -34,31 +34,31 @@ (require 'nnmail) (defvar gnus-group-split-updated-hook nil - "Hook called just after nnmail-split-fancy is updated by -gnus-group-split-update.") + "Hook called just after `nnmail-split-fancy' is updated by +`gnus-group-split-update'.") (defvar gnus-group-split-default-catch-all-group "mail.misc" "Group name (or arbitrary fancy split) with default splitting rules. -Used by gnus-group-split and gnus-group-split-update as a fallback +Used by `gnus-group-split' and `gnus-group-split-update' as a fallback split, in case none of the group-based splits matches.") ;;;###autoload (defun gnus-group-split-setup (&optional auto-update catch-all) - "Set up the split for nnmail-split-fancy. + "Set up the split for `nnmail-split-fancy'. Sets things up so that nnmail-split-fancy is used for mail splitting, and defines the variable nnmail-split-fancy according with group parameters. If AUTO-UPDATE is non-nil (prefix argument accepted, if called interactively), it makes sure nnmail-split-fancy is re-computed before -getting new mail, by adding gnus-group-split-update to -nnmail-pre-get-new-mail-hook. +getting new mail, by adding `gnus-group-split-update' to +`nnmail-pre-get-new-mail-hook'. A non-nil CATCH-ALL replaces the current value of -gnus-group-split-default-catch-all-group. This variable is only used +`gnus-group-split-default-catch-all-group'. This variable is only used by gnus-group-split-update, and only when its CATCH-ALL argument is nil. This argument may contain any fancy split, that will be added as -the last split in a `|' split produced by gnus-group-split-fancy, +the last split in a `|' split produced by `gnus-group-split-fancy', unless overridden by any group marked as a catch-all group. Typical uses are as simple as the name of a default mail group, but more elaborate fancy splits may also be useful to split mail that doesn't @@ -78,8 +78,8 @@ It does this by calling by calling (gnus-group-split-fancy nil nil CATCH-ALL). -If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used -instead. This variable is set by gnus-group-split-setup." +If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used +instead. This variable is set by `gnus-group-split-setup'." (interactive) (setq nnmail-split-fancy (gnus-group-split-fancy @@ -89,10 +89,10 @@ ;;;###autoload (defun gnus-group-split () - "Uses information from group parameters in order to split mail. + "Use information from group parameters in order to split mail. See `gnus-group-split-fancy' for more information. -gnus-group-split is a valid value for nnmail-split-methods." +`gnus-group-split' is a valid value for `nnmail-split-methods'." (let (nnmail-split-fancy) (gnus-group-split-update) (nnmail-split-fancy))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-move.el --- a/lisp/gnus/gnus-move.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-move.el Sun Oct 28 09:18:39 2007 +0000 @@ -53,10 +53,8 @@ (save-excursion ;; Go through all groups and translate. - (let ((newsrc gnus-newsrc-alist) - (nntp-nov-gap nil) - info) - (while (setq info (pop newsrc)) + (let ((nntp-nov-gap nil)) + (dolist (info gnus-newsrc-alist) (when (gnus-group-native-p (gnus-info-group info)) (gnus-move-group-to-server info from-server to-server)))))) @@ -177,8 +175,7 @@ (new-name (gnus-group-prefixed-name (gnus-group-real-name group) to-server))) (gnus-info-set-group info new-name) - (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) - gnus-newsrc-hashtb) + (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb) (gnus-sethash group nil gnus-newsrc-hashtb)))) (provide 'gnus-move) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-msg.el --- a/lisp/gnus/gnus-msg.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-msg.el Sun Oct 28 09:18:39 2007 +0000 @@ -255,7 +255,8 @@ :group 'gnus-message :type 'boolean) -(defcustom gnus-confirm-mail-reply-to-news nil +(defcustom gnus-confirm-mail-reply-to-news (and gnus-novice-user + (not gnus-expert-user)) "If non-nil, Gnus requests confirmation when replying to news. This is done because new users often reply by mistake when reading news. @@ -288,6 +289,16 @@ :group 'gnus-message :type 'boolean) +(defcustom gnus-message-highlight-citation + t ;; gnus-treat-highlight-citation ;; gnus-cite dependency + "Enable highlighting of different citation levels in message-mode." + :version "23.0" ;; No Gnus + :group 'gnus-cite + :group 'gnus-message + :type 'boolean) + +(autoload 'gnus-message-citation-mode "gnus-cite" nil t) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -324,11 +335,7 @@ ") (eval-and-compile - (autoload 'gnus-uu-post-news "gnus-uu" nil t) - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'rmail-dont-reply-to "mail-utils") - (autoload 'rmail-output "rmailout")) + (autoload 'gnus-uu-post-news "gnus-uu" nil t)) ;;; @@ -369,10 +376,10 @@ ;;; Internal functions. -(defun gnus-inews-make-draft () +(defun gnus-inews-make-draft (articles) `(lambda () (gnus-inews-make-draft-meta-information - ,gnus-newsgroup-name ',gnus-article-reply))) + ,(gnus-group-decoded-name gnus-newsgroup-name) ',articles))) (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) @@ -421,7 +428,7 @@ (not (string= ,group ""))) (push (cons (intern gnus-draft-meta-information-header) - (gnus-inews-make-draft)) + (gnus-inews-make-draft (or ,yanked ,article))) message-required-headers)) (unwind-protect (progn @@ -432,6 +439,9 @@ (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) (set (make-local-variable 'gnus-newsgroup-name) ,group) + ;; Enable highlighting of different citation levels + (when gnus-message-highlight-citation + (gnus-message-citation-mode 1)) (gnus-run-hooks 'gnus-message-setup-hook) (if (eq major-mode 'message-mode) (let ((mbl1 mml-buffer-list)) @@ -449,12 +459,20 @@ (run-hooks 'post-command-hook) (set-buffer-modified-p nil)))) -(defun gnus-inews-make-draft-meta-information (group article) - (concat "(\"" group "\" " - (if article (number-to-string - (if (listp article) - (car article) - article)) "\"\"") +(defun gnus-inews-make-draft-meta-information (group articles) + (when (numberp articles) + (setq articles (list articles))) + (concat "(\"" group "\"" + (if articles + (concat " " + (mapconcat + (lambda (elem) + (number-to-string + (if (consp elem) + (car elem) + elem))) + articles " ")) + "") ")")) ;;;###autoload @@ -519,7 +537,7 @@ (gnus-make-local-hook 'message-header-hook) (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method - `(lambda (arg) + `(lambda (&optional arg) (gnus-post-method arg ,gnus-newsgroup-name))) (message-add-action `(when (gnus-buffer-exists-p ,buffer) @@ -562,9 +580,9 @@ (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use posting style of group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read + "Use posting style of group: " + nil nil (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -593,9 +611,9 @@ (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; #### see comment in gnus-setup-message -- drv @@ -615,8 +633,8 @@ (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) (gnus-group-group-name)) "")) ;; make sure last viewed article doesn't affect posting styles: @@ -641,9 +659,9 @@ (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -672,9 +690,9 @@ (setq gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Use group: " + nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; #### see comment in gnus-setup-message -- drv @@ -682,9 +700,9 @@ (progn (message-news (gnus-group-real-name gnus-newsgroup-name)) (set (make-local-variable 'gnus-discouraged-post-methods) - (delq + (remove (car (gnus-find-method-for-group gnus-newsgroup-name)) - (copy-sequence gnus-discouraged-post-methods)))))) + gnus-discouraged-post-methods))))) (save-excursion (set-buffer buffer) (setq gnus-newsgroup-name group))))) @@ -699,8 +717,8 @@ (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) + (gnus-group-completing-read "Newsgroup: " nil nil + (gnus-read-active-file-p)) "") gnus-newsgroup-name)) ;; make sure last viewed article doesn't affect posting styles: @@ -784,12 +802,10 @@ prefix `a', cancel using the standard posting method; if not post using the current select method." (interactive (gnus-interactive "P\ny")) - (let ((articles (gnus-summary-work-articles n)) - (message-post-method + (let ((message-post-method `(lambda (arg) - (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) - article) - (while (setq article (pop articles)) + (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))) + (dolist (article (gnus-summary-work-articles n)) (when (gnus-summary-select-article t nil nil article) (when (gnus-eval-in-buffer-window gnus-original-article-buffer (message-cancel-news)) @@ -1254,14 +1270,12 @@ (with-current-buffer gnus-original-article-buffer (nnmail-fetch-field "to")))) current-prefix-arg)) - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend address)) - (gnus-summary-mark-article-as-forwarded article)))) + (dolist (article (gnus-summary-work-articles n)) + (gnus-summary-select-article nil nil nil article) + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-resend address)) + (gnus-summary-mark-article-as-forwarded article))) ;; From: Matthieu Moy (defun gnus-summary-resend-message-edit () @@ -1322,37 +1336,35 @@ (defun gnus-summary-mail-crosspost-complaint (n) "Send a complaint about crossposting to the current article(s)." (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-subject article) - (let ((group (gnus-group-real-name gnus-newsgroup-name)) - newsgroups followup-to) - (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (if (and (<= (length (message-tokenize-header - (setq newsgroups - (mail-fetch-field "newsgroups")) - ", ")) - 1) - (or (not (setq followup-to (mail-fetch-field "followup-to"))) - (not (member group (message-tokenize-header - followup-to ", "))))) - (if followup-to - (gnus-message 1 "Followup-to restricted") - (gnus-message 1 "Not a crossposted article")) - (set-buffer gnus-summary-buffer) - (gnus-summary-reply-with-original 1) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-crosspost-complaint newsgroups group)) - (message-goto-subject) - (re-search-forward " *$") - (replace-match " (crosspost notification)" t t) - (gnus-deactivate-mark) - (when (gnus-y-or-n-p "Send this complaint? ") - (message-send-and-exit))))))) + (dolist (article (gnus-summary-work-articles n)) + (set-buffer gnus-summary-buffer) + (gnus-summary-goto-subject article) + (let ((group (gnus-group-real-name gnus-newsgroup-name)) + newsgroups followup-to) + (gnus-summary-select-article) + (set-buffer gnus-original-article-buffer) + (if (and (<= (length (message-tokenize-header + (setq newsgroups + (mail-fetch-field "newsgroups")) + ", ")) + 1) + (or (not (setq followup-to (mail-fetch-field "followup-to"))) + (not (member group (message-tokenize-header + followup-to ", "))))) + (if followup-to + (gnus-message 1 "Followup-to restricted") + (gnus-message 1 "Not a crossposted article")) + (set-buffer gnus-summary-buffer) + (gnus-summary-reply-with-original 1) + (set-buffer gnus-message-buffer) + (message-goto-body) + (insert (format gnus-crosspost-complaint newsgroups group)) + (message-goto-subject) + (re-search-forward " *$") + (replace-match " (crosspost notification)" t t) + (gnus-deactivate-mark) + (when (gnus-y-or-n-p "Send this complaint? ") + (message-send-and-exit)))))) (defun gnus-mail-parse-comma-list () (let (accumulated @@ -1401,7 +1413,7 @@ (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - (when (gnus-gethash group gnus-newsrc-hashtb) + (when (gnus-group-entry group) (error "No such group: %s" group)) (save-excursion (save-restriction @@ -1667,11 +1679,13 @@ (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) - (unless (setq group-art - (gnus-request-accept-article group method t t)) + (when (or (not (gnus-check-backend-function + 'request-accept-article group)) + (not (setq group-art + (gnus-request-accept-article + group method t t)))) (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) + group (gnus-status-message method))) (when (and group-art ;; FIXME: Should gcc-mark-as-read work when ;; Gnus is not running? @@ -1709,8 +1723,13 @@ (defun gnus-inews-insert-archive-gcc (&optional group) "Insert the Gcc to say where the article is to be archived." + (setq group (cond (group + (gnus-group-decoded-name group)) + (gnus-newsgroup-name + (gnus-group-decoded-name gnus-newsgroup-name)) + (t + ""))) (let* ((var gnus-message-archive-group) - (group (or group gnus-newsgroup-name "")) (gcc-self-val (and gnus-newsgroup-name (not (equal gnus-newsgroup-name "")) @@ -1892,6 +1911,13 @@ ((eq element 'x-face-file) (setq element 'x-face filep t))) + ;; Post-processing for the signature posting-style: + (and (eq element 'signature) filep + message-signature-directory + ;; don't actually use the signature directory + ;; if message-signature-file contains a path. + (not (file-name-directory v)) + (setq v (nnheader-concat message-signature-directory v))) ;; Get the contents of file elems. (when (and filep v) (setq v (with-temp-buffer diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-nocem.el --- a/lisp/gnus/gnus-nocem.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-nocem.el Sun Oct 28 09:18:39 2007 +0000 @@ -129,11 +129,12 @@ (defun gnus-fill-real-hashtb () "Fill up a hash table with the real-name mappings from the user's active file." - (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable - (length gnus-newsrc-alist))) + (if (hash-table-p gnus-nocem-real-group-hashtb) + (clrhash gnus-nocem-real-group-hashtb) + (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) (mapcar (lambda (group) (setq group (gnus-group-real-name (car group))) - (gnus-sethash group t gnus-nocem-real-group-hashtb)) + (puthash group t gnus-nocem-real-group-hashtb)) gnus-newsrc-alist)) ;;;###autoload @@ -191,7 +192,7 @@ (and gnus-nocem-check-from (let ((case-fold-search t)) (catch 'ok - (mapcar + (mapc (lambda (author) (if (consp author) (setq author (car author))) @@ -237,11 +238,11 @@ (gnus-request-article-this-buffer (mail-header-number header) group) (goto-char (point-min)) (when (re-search-forward - "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----" + "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----" nil t) (delete-region (point-min) (match-beginning 0))) (when (re-search-forward - "-----END PGP \\(MESSAGE\\|SIGNATURE\\)-----\n?" + "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?" nil t) (delete-region (match-end 0) (point-max))) (goto-char (point-min)) @@ -304,34 +305,26 @@ (while (search-forward "\t" nil t) (cond ((not (ignore-errors - (setq group (let ((obarray gnus-nocem-real-group-hashtb)) - (read buf))))) + (setq group (gnus-group-real-name (symbol-name (read buf)))) + (gethash group gnus-nocem-real-group-hashtb))) ;; An error. ) - ((not (symbolp group)) - ;; Ignore invalid entries. - ) - ((not (boundp group)) - ;; Make sure all entries in the hashtb are bound. - (set group nil)) (t - (when (gnus-gethash (gnus-group-real-name (symbol-name group)) - gnus-nocem-real-group-hashtb) - ;; Valid group. - (beginning-of-line) - (while (eq (char-after) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (if gnus-nocem-hashtb - (gnus-gethash id gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (gnus-make-hashtable)) - nil) - ;; only store if not already present - (gnus-sethash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (eq (char-after) ?\t) - (forward-line 1)))))) + ;; Valid group. + (beginning-of-line) + (while (eq (char-after) ?\t) + (forward-line -1)) + (setq id (buffer-substring (point) (1- (search-forward "\t")))) + (unless (if (hash-table-p gnus-nocem-hashtb) + (gethash id gnus-nocem-hashtb) + (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) + nil) + ;; only store if not already present + (puthash id t gnus-nocem-hashtb) + (push id ncm)) + (forward-line 1) + (while (eq (char-after) ?\t) + (forward-line 1))))) (when ncm (setq gnus-nocem-touched-alist t) (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) @@ -370,7 +363,9 @@ (prev pprev) (expiry (days-to-time gnus-nocem-expiry-wait)) entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) + (if (hash-table-p gnus-nocem-hashtb) + (clrhash gnus-nocem-hashtb) + (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) (while (setq entry (car alist)) (if (not (time-less-p (time-since (car entry)) expiry)) ;; This entry has expired, so we remove it. @@ -379,7 +374,7 @@ ;; This is ok, so we enter it into the hashtable. (setq entry (cdr entry)) (while entry - (gnus-sethash (car entry) t gnus-nocem-hashtb) + (puthash (car entry) t gnus-nocem-hashtb) (setq entry (cdr entry)))) (setq alist (cdr alist))))) @@ -397,7 +392,7 @@ (defun gnus-nocem-unwanted-article-p (id) "Say whether article ID in the current group is wanted." (and gnus-nocem-hashtb - (gnus-gethash id gnus-nocem-hashtb))) + (gethash id gnus-nocem-hashtb))) (provide 'gnus-nocem) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-picon.el --- a/lisp/gnus/gnus-picon.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-picon.el Sun Oct 28 09:18:39 2007 +0000 @@ -74,6 +74,15 @@ :type '(repeat string) :group 'gnus-picon) +(defcustom gnus-picon-style 'inline + "How should picons be displayed. +If `inline', the textual representation is replaced. If `right', picons are +added right to the textual representation." + ;; FIXME: `right' needs improvement for XEmacs. + :type '(choice (const inline) + (const right)) + :group 'gnus-picon) + (defface gnus-picon-xbm '((t (:foreground "black" :background "white"))) "Face to show xbm picon in." :group 'gnus-picon) @@ -139,14 +148,17 @@ file nil))) -(defun gnus-picon-insert-glyph (glyph category) +(defun gnus-picon-insert-glyph (glyph category &optional nostring) "Insert GLYPH into the buffer. -GLYPH can be either a glyph or a string." +GLYPH can be either a glyph or a string. When NOSTRING, no textual +replacement is added." + ;; Using NOSTRING prevents wrong BBDB entries with `gnus-picon-style' set to + ;; 'right. (if (stringp glyph) (insert glyph) (gnus-add-wash-type category) (gnus-add-image category (car glyph)) - (gnus-put-image (car glyph) (cdr glyph) category))) + (gnus-put-image (car glyph) (unless nostring (cdr glyph)) category))) (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) @@ -157,87 +169,107 @@ (defun gnus-picon-transform-address (header category) (gnus-with-article-headers - (let ((addresses - (mail-header-parse-addresses - ;; mail-header-parse-addresses does not work (reliably) on - ;; decoded headers. - (or - (ignore-errors - (mail-encode-encoded-word-string - (or (mail-fetch-field header) ""))) - (mail-fetch-field header)))) - spec file point cache) - (dolist (address addresses) - (setq address (car address)) - (when (and (stringp address) - (setq spec (gnus-picon-split-address address))) - (if (setq cache (cdr (assoc address gnus-picon-cache))) - (setq spec cache) - (when (setq file (or (gnus-picon-find-face - address gnus-picon-user-directories) - (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (cdr spec) ".")) - gnus-picon-user-directories))) - (setcar spec (cons (gnus-picon-create-glyph file) - (car spec)))) + (let ((addresses + (mail-header-parse-addresses + ;; mail-header-parse-addresses does not work (reliably) on + ;; decoded headers. + (or + (ignore-errors + (mail-encode-encoded-word-string + (or (mail-fetch-field header) ""))) + (mail-fetch-field header)))) + spec file point cache len) + (dolist (address addresses) + (setq address (car address)) + (when (and (stringp address) + (setq spec (gnus-picon-split-address address))) + (if (setq cache (cdr (assoc address gnus-picon-cache))) + (setq spec cache) + (when (setq file (or (gnus-picon-find-face + address gnus-picon-user-directories) + (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (cdr spec) ".")) + gnus-picon-user-directories))) + (setcar spec (cons (gnus-picon-create-glyph file) + (car spec)))) - (dotimes (i (1- (length spec))) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr (1+ i) spec) ".")) - gnus-picon-domain-directories t)) - (setcar (nthcdr (1+ i) spec) - (cons (gnus-picon-create-glyph file) - (nth (1+ i) spec))))) - (setq spec (nreverse spec)) - (push (cons address spec) gnus-picon-cache)) + (dotimes (i (1- (length spec))) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr (1+ i) spec) ".")) + gnus-picon-domain-directories t)) + (setcar (nthcdr (1+ i) spec) + (cons (gnus-picon-create-glyph file) + (nth (1+ i) spec))))) + (setq spec (nreverse spec)) + (push (cons address spec) gnus-picon-cache)) - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (when (search-forward address nil t) - (delete-region (match-beginning 0) (match-end 0)) - (setq point (point)) - (while spec - (goto-char point) - (if (> (length spec) 2) - (insert ".") - (if (= (length spec) 2) - (insert "@"))) - (gnus-picon-insert-glyph (pop spec) category)))))))) + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (case gnus-picon-style + (right + (when (= (length addresses) 1) + (setq len (apply '+ (mapcar (lambda (x) + (condition-case nil + (car (image-size (car x))) + (error 0))) spec))) + (when (> len 0) + (goto-char (point-at-eol)) + (insert (propertize + " " 'display + (cons 'space + (list :align-to (- (window-width) 1 len)))))) + (goto-char (point-at-eol)) + (setq point (point-at-eol)) + (dolist (image spec) + (unless (stringp image) + (goto-char point) + (gnus-picon-insert-glyph image category 'nostring))))) + (inline + (when (search-forward address nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq point (point)) + (while spec + (goto-char point) + (if (> (length spec) 2) + (insert ".") + (if (= (length spec) 2) + (insert "@"))) + (gnus-picon-insert-glyph (pop spec) category)))))))))) (defun gnus-picon-transform-newsgroups (header) (interactive) (gnus-with-article-headers - (gnus-article-goto-header header) - (mail-header-narrow-to-field) - (let ((groups (message-tokenize-header (mail-fetch-field header))) - spec file point) - (dolist (group groups) - (unless (setq spec (cdr (assoc group gnus-picon-cache))) - (setq spec (nreverse (split-string group "[.]"))) - (dotimes (i (length spec)) - (when (setq file (gnus-picon-find-face - (concat "unknown@" - (mapconcat - 'identity (nthcdr i spec) ".")) - gnus-picon-news-directories t)) - (setcar (nthcdr i spec) - (cons (gnus-picon-create-glyph file) - (nth i spec))))) - (push (cons group spec) gnus-picon-cache)) - (when (search-forward group nil t) - (delete-region (match-beginning 0) (match-end 0)) - (save-restriction - (narrow-to-region (point) (point)) - (while spec - (goto-char (point-min)) - (if (> (length spec) 1) - (insert ".")) - (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) - (goto-char (point-max)))))))) + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (let ((groups (message-tokenize-header (mail-fetch-field header))) + spec file point) + (dolist (group groups) + (unless (setq spec (cdr (assoc group gnus-picon-cache))) + (setq spec (nreverse (split-string group "[.]"))) + (dotimes (i (length spec)) + (when (setq file (gnus-picon-find-face + (concat "unknown@" + (mapconcat + 'identity (nthcdr i spec) ".")) + gnus-picon-news-directories t)) + (setcar (nthcdr i spec) + (cons (gnus-picon-create-glyph file) + (nth i spec))))) + (push (cons group spec) gnus-picon-cache)) + (when (search-forward group nil t) + (delete-region (match-beginning 0) (match-end 0)) + (save-restriction + (narrow-to-region (point) (point)) + (while spec + (goto-char (point-min)) + (if (> (length spec) 1) + (insert ".")) + (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon)) + (goto-char (point-max)))))))) ;;; Commands: @@ -251,10 +283,9 @@ (interactive) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) - (gnus-delete-images 'from-picon) - (gnus-picon-transform-address "from" 'from-picon))) - )) + (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types)) + (gnus-delete-images 'from-picon) + (gnus-picon-transform-address "from" 'from-picon))))) ;;;###autoload (defun gnus-treat-mail-picon () @@ -263,11 +294,10 @@ (interactive) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) - (gnus-delete-images 'mail-picon) - (gnus-picon-transform-address "cc" 'mail-picon) - (gnus-picon-transform-address "to" 'mail-picon))) - )) + (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types)) + (gnus-delete-images 'mail-picon) + (gnus-picon-transform-address "cc" 'mail-picon) + (gnus-picon-transform-address "to" 'mail-picon))))) ;;;###autoload (defun gnus-treat-newsgroups-picon () @@ -276,11 +306,10 @@ (interactive) (let ((wash-picon-p buffer-read-only)) (gnus-with-article-buffer - (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) - (gnus-delete-images 'newsgroups-picon) - (gnus-picon-transform-newsgroups "newsgroups") - (gnus-picon-transform-newsgroups "followup-to"))) - )) + (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types)) + (gnus-delete-images 'newsgroups-picon) + (gnus-picon-transform-newsgroups "newsgroups") + (gnus-picon-transform-newsgroups "followup-to"))))) (provide 'gnus-picon) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-range.el --- a/lisp/gnus/gnus-range.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-range.el Sun Oct 28 09:18:39 2007 +0000 @@ -307,7 +307,7 @@ (cdr top))) (defun gnus-compress-sequence (numbers &optional always-list) - "Convert list of numbers to a list of ranges or a single range. + "Convert sorted list of numbers to a list of ranges or a single range. If ALWAYS-LIST is non-nil, this function will always release a list of ranges." (let* ((first (car numbers)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-registry.el --- a/lisp/gnus/gnus-registry.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-registry.el Sun Oct 28 09:18:39 2007 +0000 @@ -25,11 +25,11 @@ ;;; Commentary: -;; This is the gnus-registry.el package, works with other backends -;; besides nnmail. The major issue is that it doesn't go across -;; backends, so for instance if an article is in nnml:sys and you see -;; a reference to it in nnimap splitting, the article will end up in -;; nnimap:sys +;; This is the gnus-registry.el package, which works with all +;; backends, not just nnmail (e.g. NNTP). The major issue is that it +;; doesn't go across backends, so for instance if an article is in +;; nnml:sys and you see a reference to it in nnimap splitting, the +;; article will end up in nnimap:sys ;; gnus-registry.el intercepts article respooling, moving, deleting, ;; and copying for all backends. If it doesn't work correctly for @@ -71,14 +71,19 @@ :version "22.1" :group 'gnus) -(defvar gnus-registry-hashtb nil +(defvar gnus-registry-hashtb (make-hash-table + :size 256 + :test 'equal) "*The article registry by Message ID.") -(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue") - "List of groups that gnus-registry-split-fancy-with-parent won't follow. -The group names are matched, they don't have to be fully qualified." +(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") + "List of groups that gnus-registry-split-fancy-with-parent won't return. +The group names are matched, they don't have to be fully +qualified. This parameter tells the Registry 'never split a +message into a group that matches one of these, regardless of +references.'" :group 'gnus-registry - :type '(repeat string)) + :type '(repeat regexp)) (defcustom gnus-registry-install nil "Whether the registry should be installed." @@ -87,7 +92,8 @@ (defcustom gnus-registry-clean-empty t "Whether the empty registry entries should be deleted. -Registry entries are considered empty when they have no groups." +Registry entries are considered empty when they have no groups +and no extra data." :group 'gnus-registry :type 'boolean) @@ -121,7 +127,10 @@ :group 'gnus-registry :type 'boolean) -(defcustom gnus-registry-cache-file "~/.gnus.registry.eld" +(defcustom gnus-registry-cache-file + (nnheader-concat + (or gnus-dribble-directory gnus-home-directory "~/") + ".gnus.registry.eld") "File where the Gnus registry will be stored." :group 'gnus-registry :type 'file) @@ -132,13 +141,6 @@ :type '(radio (const :format "Unlimited " nil) (integer :format "Maximum number: %v"))) -;; Function(s) missing in Emacs 20 -(when (memq nil (mapcar 'fboundp '(puthash))) - (require 'cl) - (unless (fboundp 'puthash) - ;; alias puthash is missing from Emacs 20 cl-extra.el - (defalias 'puthash 'cl-puthash))) - (defun gnus-registry-track-subject-p () (memq 'subject gnus-registry-track-extra)) @@ -210,7 +212,7 @@ ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -221,7 +223,7 @@ ;; Idea from Dan Christensen ;; Save the gnus-registry file with extra line breaks. (defun gnus-registry-cache-whitespace (filename) - (gnus-message 5 "Adding whitespace to %s" filename) + (gnus-message 7 "Adding whitespace to %s" filename) (save-excursion (goto-char (point-min)) (while (re-search-forward "^(\\|(\\\"" nil t) @@ -244,10 +246,12 @@ ;; remove empty entries (when gnus-registry-clean-empty (gnus-registry-clean-empty-function)) - ;; now trim the registry appropriately - (setq gnus-registry-alist (gnus-registry-trim - (gnus-hashtable-to-alist - gnus-registry-hashtb))) + ;; now trim and clean text properties from the registry appropriately + (setq gnus-registry-alist + (gnus-registry-remove-alist-text-properties + (gnus-registry-trim + (gnus-hashtable-to-alist + gnus-registry-hashtb)))) ;; really save (gnus-registry-cache-save) (setq gnus-registry-entry-caching caching) @@ -256,11 +260,36 @@ (defun gnus-registry-clean-empty-function () "Remove all empty entries from the registry. Returns count thereof." (let ((count 0)) + (maphash (lambda (key value) - (unless (gnus-registry-fetch-group key) - (incf count) - (remhash key gnus-registry-hashtb))) + (when (stringp key) + (dolist (group (gnus-registry-fetch-groups key)) + (when (gnus-parameter-registry-ignore group) + (gnus-message + 10 + "gnus-registry: deleted ignored group %s from key %s" + group key) + (gnus-registry-delete-group key group))) + + (unless (gnus-registry-group-count key) + (gnus-registry-delete-id key)) + + (unless (or + (gnus-registry-fetch-group key) + ;; TODO: look for specific extra data here! + ;; in this example, we look for 'label + (gnus-registry-fetch-extra key 'label)) + (incf count) + (gnus-registry-delete-id key)) + + (unless (stringp key) + (gnus-message + 10 + "gnus-registry key %s was not a string, removing" + key) + (gnus-registry-delete-id key)))) + gnus-registry-hashtb) count)) @@ -269,8 +298,20 @@ (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist)) (setq gnus-registry-dirty nil)) +(defun gnus-registry-remove-alist-text-properties (v) + "Remove text properties from all strings in alist." + (if (stringp v) + (gnus-string-remove-all-properties v) + (if (and (listp v) (listp (cdr v))) + (mapcar 'gnus-registry-remove-alist-text-properties v) + (if (and (listp v) (stringp (cdr v))) + (cons (gnus-registry-remove-alist-text-properties (car v)) + (gnus-registry-remove-alist-text-properties (cdr v))) + v)))) + (defun gnus-registry-trim (alist) - "Trim alist to size, using gnus-registry-max-entries." + "Trim alist to size, using gnus-registry-max-entries. +Also, drop all gnus-registry-ignored-groups matches." (if (null gnus-registry-max-entries) alist ; just return the alist ;; else, when given max-entries, trim the alist @@ -283,27 +324,28 @@ (lambda (key value) (puthash key (gnus-registry-fetch-extra key 'mtime) timehash)) gnus-registry-hashtb) - + ;; we use the return value of this setq, which is the trimmed alist (setq alist - (nthcdr - trim-length - (sort alist - (lambda (a b) - (time-less-p - (cdr (gethash (car a) timehash)) - (cdr (gethash (car b) timehash)))))))))) + (nthcdr + trim-length + (sort alist + (lambda (a b) + (time-less-p + (or (cdr (gethash (car a) timehash)) '(0 0 0)) + (or (cdr (gethash (car b) timehash)) '(0 0 0)))))))))) (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) - (subject (gnus-registry-simplify-subject - (mail-header-subject data-header))) - (sender (mail-header-from data-header)) + (subject (gnus-string-remove-all-properties + (gnus-registry-simplify-subject + (mail-header-subject data-header)))) + (sender (gnus-string-remove-all-properties (mail-header-from data-header))) (from (gnus-group-guess-full-name-from-command-method from)) (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) (to-name (if to to "the Bit Bucket")) (old-entry (gethash id gnus-registry-hashtb))) - (gnus-message 5 "Registry: article %s %s from %s to %s" + (gnus-message 7 "Registry: article %s %s from %s to %s" id (if method "respooling" "going") from @@ -321,7 +363,7 @@ (let ((group (gnus-group-guess-full-name-from-command-method group))) (when (and (stringp id) (string-match "\r$" id)) (setq id (substring id 0 -1))) - (gnus-message 5 "Registry: article %s spooled to %s" + (gnus-message 7 "Registry: article %s spooled to %s" id group) (gnus-registry-add-group id group subject sender))) @@ -334,36 +376,46 @@ in `nnmail-split-fancy' or `nnimap-split-fancy', for example like this: (: gnus-registry-split-fancy-with-parent) +This function tracks ALL backends, unlike +`nnmail-split-fancy-with-parent' which tracks only nnmail +messages. + For a message to be split, it looks for the parent message in the -References or In-Reply-To header and then looks in the registry to -see which group that message was put in. This group is returned. +References or In-Reply-To header and then looks in the registry +to see which group that message was put in. This group is +returned, unless it matches one of the entries in +gnus-registry-unfollowed-groups or +nnmail-split-fancy-with-parent-ignore-groups. See the Info node `(gnus)Fancy Mail Splitting' for more details." - (let ((refstr (or (message-fetch-field "references") - (message-fetch-field "in-reply-to"))) + (let* ((refstr (or (message-fetch-field "references") "")) ; guarantee string + (reply-to (message-fetch-field "in-reply-to")) ; grab reply-to + ;; now, if reply-to is valid, append it to the References + (refstr (if reply-to + (concat refstr " " reply-to) + refstr)) (nnmail-split-fancy-with-parent-ignore-groups (if (listp nnmail-split-fancy-with-parent-ignore-groups) nnmail-split-fancy-with-parent-ignore-groups (list nnmail-split-fancy-with-parent-ignore-groups))) - references res) - (if refstr - (progn - (setq references (nreverse (gnus-split-references refstr))) - (mapcar (lambda (x) - (setq res (or (gnus-registry-fetch-group x) res)) - (when (or (gnus-registry-grep-in-list - res - gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list - res - nnmail-split-fancy-with-parent-ignore-groups)) - (setq res nil))) - references)) + res) + ;; the references string must be valid and parse to valid references + (if (and refstr (gnus-extract-references refstr)) + (dolist (reference (nreverse (gnus-extract-references refstr))) + (setq res (or (gnus-registry-fetch-group reference) res)) + (when (or (gnus-registry-grep-in-list + res + gnus-registry-unfollowed-groups) + (gnus-registry-grep-in-list + res + nnmail-split-fancy-with-parent-ignore-groups)) + (setq res nil))) ;; else: there were no references, now try the extra tracking - (let ((sender (message-fetch-field "from")) - (subject (gnus-registry-simplify-subject - (message-fetch-field "subject"))) + (let ((sender (gnus-string-remove-all-properties(message-fetch-field "from"))) + (subject (gnus-string-remove-all-properties + (gnus-registry-simplify-subject + (message-fetch-field "subject")))) (single-match t)) (when (and single-match (gnus-registry-track-sender-p) @@ -379,13 +431,14 @@ (unless (equal res (gnus-registry-fetch-group key)) (setq single-match nil)) (setq res (gnus-registry-fetch-group key)) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 5 9) - "%s (extra tracking) traced sender %s to group %s" - "gnus-registry-split-fancy-with-parent" - sender - (if res res "nil"))))) + (when (and sender res) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced sender %s to group %s" + "gnus-registry-split-fancy-with-parent" + sender + res))))) gnus-registry-hashtb)) (when (and single-match (gnus-registry-track-subject-p) @@ -402,24 +455,26 @@ (unless (equal res (gnus-registry-fetch-group key)) (setq single-match nil)) (setq res (gnus-registry-fetch-group key)) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 5 9) - "%s (extra tracking) traced subject %s to group %s" - "gnus-registry-split-fancy-with-parent" - subject - (if res res "nil"))))) + (when (and subject res) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced subject %s to group %s" + "gnus-registry-split-fancy-with-parent" + subject + res))))) gnus-registry-hashtb)) (unless single-match (gnus-message - 5 + 3 "gnus-registry-split-fancy-with-parent: too many extra matches for %s" refstr) (setq res nil)))) - (gnus-message - 5 - "gnus-registry-split-fancy-with-parent traced %s to group %s" - refstr (if res res "nil")) + (when (and refstr res) + (gnus-message + 5 + "gnus-registry-split-fancy-with-parent traced %s to group %s" + refstr res)) (when (and res gnus-registry-use-long-group-names) (let ((m1 (gnus-find-method-for-group res)) @@ -436,12 +491,45 @@ (setq res short-res)) ;; else... (gnus-message - 5 + 7 "gnus-registry-split-fancy-with-parent ignored foreign group %s" res) (setq res nil)))) res)) +(defun gnus-registry-wash-for-keywords (&optional force) + (interactive) + (let ((id (gnus-registry-fetch-message-id-fast gnus-current-article)) + word words) + (if (or (not (gnus-registry-fetch-extra id 'keywords)) + force) + (save-excursion + (set-buffer gnus-article-buffer) + (article-goto-body) + (save-window-excursion + (save-restriction + (narrow-to-region (point) (point-max)) + (with-syntax-table gnus-adaptive-word-syntax-table + (while (re-search-forward "\\b\\w+\\b" nil t) + (setq word (gnus-registry-remove-alist-text-properties + (downcase (buffer-substring + (match-beginning 0) (match-end 0))))) + (if (> (length word) 3) + (push word words)))))) + (gnus-registry-store-extra-entry id 'keywords words))))) + +(defun gnus-registry-find-keywords (keyword) + (interactive "skeyword: ") + (let (articles) + (maphash + (lambda (key value) + (when (gnus-registry-grep-in-list + keyword + (cdr (gnus-registry-fetch-extra key 'keywords))) + (push key articles))) + gnus-registry-hashtb) + articles)) + (defun gnus-registry-register-message-ids () "Register the Message-ID of every article in the group" (unless (gnus-parameter-registry-ignore gnus-newsgroup-name) @@ -472,17 +560,19 @@ "Fetch the Subject quickly, using the internal gnus-data-list function" (if (and (numberp article) (assoc article (gnus-data-list nil))) - (gnus-registry-simplify-subject - (mail-header-subject (gnus-data-header - (assoc article (gnus-data-list nil))))) + (gnus-string-remove-all-properties + (gnus-registry-simplify-subject + (mail-header-subject (gnus-data-header + (assoc article (gnus-data-list nil)))))) nil)) (defun gnus-registry-fetch-sender-fast (article) "Fetch the Sender quickly, using the internal gnus-data-list function" (if (and (numberp article) (assoc article (gnus-data-list nil))) - (mail-header-from (gnus-data-header - (assoc article (gnus-data-list nil)))) + (gnus-string-remove-all-properties + (mail-header-from (gnus-data-header + (assoc article (gnus-data-list nil))))) nil)) (defun gnus-registry-grep-in-list (word list) @@ -491,9 +581,36 @@ (mapcar 'not (mapcar (lambda (x) - (string-match x word)) + (string-match word x)) list))))) +;;; if this extends to more than 'flags, it should be improved to be more generic. +(defun gnus-registry-fetch-extra-flags (id) + "Get the flags of a message, based on the message ID. +Returns a list of symbol flags or nil." + (car-safe (cdr (gnus-registry-fetch-extra id 'flags)))) + +(defun gnus-registry-has-extra-flag (id flag) + "Checks if a message has `flag', based on the message ID." + (memq flag (gnus-registry-fetch-extra-flags id))) + +(defun gnus-registry-store-extra-flags (id &rest flag-list) + "Set the flags of a message, based on the message ID. +The `flag-list' can be nil, in which case no flags are left." + (gnus-registry-store-extra-entry id 'flags (list flag-list))) + +(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list) + "Delete the message flags in `flag-delete-list', based on the message ID." + (let ((flags (gnus-registry-fetch-extra-flags id))) + (when flags + (dolist (flag flag-delete-list) + (setq flags (delq flag flags)))) + (gnus-registry-store-extra-flags id (car flags)))) + +(defun gnus-registry-delete-all-extra-flags (id) + "Delete all the flags for a message ID." + (gnus-registry-store-extra-flags id nil)) + (defun gnus-registry-fetch-extra (id &optional entry) "Get the extra data of a message, based on the message ID. Returns the first place where the trail finds a nonstring." @@ -551,11 +668,20 @@ gnus-registry-hashtb) (setq gnus-registry-dirty t))))) +(defun gnus-registry-delete-extra-entry (id key) + "Delete a specific entry in the extras field of the registry entry for id." + (gnus-registry-store-extra-entry id key nil)) + (defun gnus-registry-store-extra-entry (id key value) "Put a specific entry in the extras field of the registry entry for id." (let* ((extra (gnus-registry-fetch-extra id)) - (alist (cons (cons key value) - (gnus-assq-delete-all key (gnus-registry-fetch-extra id))))) + ;; all the entries except the one for `key' + (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) + (alist (if value + (gnus-registry-remove-alist-text-properties + (cons (cons key value) + the-rest)) + the-rest))) (gnus-registry-store-extra id alist))) (defun gnus-registry-fetch-group (id) @@ -570,6 +696,23 @@ crumb (gnus-group-short-name crumb)))))))) +(defun gnus-registry-fetch-groups (id) + "Get the groups of a message, based on the message ID." + (let ((trail (gethash id gnus-registry-hashtb)) + groups) + (dolist (crumb trail) + (when (stringp crumb) + ;; push the group name into the list + (setq + groups + (cons + (if (or (not (stringp crumb)) gnus-registry-use-long-group-names) + crumb + (gnus-group-short-name crumb)) + groups)))) + ;; return the list of groups + groups)) + (defun gnus-registry-group-count (id) "Get the number of groups of a message, based on the message ID." (let ((trail (gethash id gnus-registry-hashtb))) @@ -579,12 +722,11 @@ (defun gnus-registry-delete-group (id group) "Delete a group for a message, based on the message ID." - (when group - (when id + (when (and group id) (let ((trail (gethash id gnus-registry-hashtb)) - (group (gnus-group-short-name group))) + (short-group (gnus-group-short-name group))) (puthash id (if trail - (delete group trail) + (delete short-group (delete group trail)) nil) gnus-registry-hashtb)) ;; now, clear the entry if there are no more groups @@ -593,7 +735,7 @@ (gnus-registry-delete-id id))) ;; is this ID still in the registry? (when (gethash id gnus-registry-hashtb) - (gnus-registry-store-extra-entry id 'mtime (current-time)))))) + (gnus-registry-store-extra-entry id 'mtime (current-time))))) (defun gnus-registry-delete-id (id) "Delete a message ID from the registry." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-salt.el --- a/lisp/gnus/gnus-salt.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-salt.el Sun Oct 28 09:18:39 2007 +0000 @@ -128,7 +128,7 @@ ;; Set up the menu. (when (gnus-visual-p 'pick-menu 'menu) (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) + (add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) (gnus-run-hooks 'gnus-pick-mode-hook)))) (defun gnus-pick-setup-message () @@ -360,7 +360,7 @@ ;; Set up the menu. (when (gnus-visual-p 'binary-menu 'menu) (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) + (add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) (gnus-run-hooks 'gnus-binary-mode-hook)))) (defun gnus-binary-display-article (article &optional all-header) @@ -719,7 +719,7 @@ (unless (zerop level) (gnus-tree-indent level) (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) + (setq col (- (setq beg (point)) (point-at-bol) 1)) ;; Draw "|" lines upwards. (while (progn (forward-line -1) @@ -743,7 +743,7 @@ (defsubst gnus-tree-indent-vertical () (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) + (- (point) (point-at-bol))))) (when (> len 0) (insert (make-string len ? ))))) @@ -1016,11 +1016,11 @@ (setq button (car buttons) buttons (cdr buttons)) (if (stringp button) - (gnus-set-text-properties + (set-text-properties (point) (prog2 (insert button) (point) (insert " ")) (list 'face gnus-carpal-header-face)) - (gnus-set-text-properties + (set-text-properties (point) (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-score.el --- a/lisp/gnus/gnus-score.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-score.el Sun Oct 28 09:18:39 2007 +0000 @@ -37,8 +37,6 @@ (require 'message) (require 'score-mode) -(autoload 'ffap-string-at-point "ffap") - (defcustom gnus-global-score-files nil "List of global score files and directories. Set this variable if you want to use people's score files. One entry @@ -149,9 +147,15 @@ :type 'boolean) (defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores." + "*If non-nil, decay non-permanent scores. + +If it is a regexp, only decay score files matching regexp." :group 'gnus-score-decay - :type 'boolean) + :type `(choice (const :tag "never" nil) + (const :tag "always" t) + (const :tag "adaptive score files" + ,(concat "\\." gnus-adaptive-file-suffix "\\'")) + (regexp))) (defcustom gnus-decay-score-function 'gnus-decay-score "*Function called to decay a score. @@ -318,6 +322,13 @@ :group 'gnus-score-files :type 'regexp) +(defcustom gnus-adaptive-pretty-print nil + "If non-nil, adaptive score files fill are pretty printed." + :group 'gnus-score-files + :group 'gnus-score-adapt + :version "23.0" ;; No Gnus + :type 'boolean) + (defcustom gnus-score-default-header nil "Default header when entering new scores. @@ -411,6 +422,18 @@ :group 'gnus-score-various :type 'boolean) +(defcustom gnus-inhibit-slow-scoring nil + "Inhibit slow scoring, e.g. scoring on headers or body. + +If a regexp, scoring on headers or body is inhibited if the group +matches the regexp. If it is t, scoring on headers or body is +inhibited for all groups." + :group 'gnus-score-various + :version "23.0" ;; No Gnus + :type '(choice (const :tag "All" nil) + (const :tag "None" t) + regexp)) + ;; Internal variables. @@ -753,7 +776,7 @@ (setq i (1+ i)))) (goto-char (point-min)) ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) + (gnus-select-lowest-window) (if (< (/ (window-height) 2) window-min-height) (switch-to-buffer "*Score Help*") (split-window) @@ -1099,6 +1122,16 @@ 4 (substitute-command-keys "\\\\[gnus-score-edit-exit] to save edits")))) +(defun gnus-score-edit-all-score () + "Edit the all.SCORE file." + (interactive) + (find-file (gnus-score-file-name "all")) + (gnus-score-mode) + (setq gnus-score-edit-exit-function 'gnus-score-edit-done) + (gnus-message + 4 (substitute-command-keys + "\\\\[gnus-score-edit-exit] to save edits"))) + (defun gnus-score-edit-file (file) "Edit a score file." (interactive @@ -1128,9 +1161,9 @@ (reg " -> +") (file (save-excursion (end-of-line) - (if (and (re-search-backward reg (gnus-point-at-bol) t) - (re-search-forward reg (gnus-point-at-eol) t)) - (buffer-substring (point) (gnus-point-at-eol)) + (if (and (re-search-backward reg (point-at-bol) t) + (re-search-forward reg (point-at-eol) t)) + (buffer-substring (point) (point-at-eol)) nil)))) (if (or (not file) (string-match "\\<\\(non-file rule\\|A file\\)\\>" file) @@ -1209,7 +1242,9 @@ (decay (car (gnus-score-get 'decay alist))) (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. - (when (and gnus-decay-scores + (when (and (if (stringp gnus-decay-scores) + (string-match gnus-decay-scores file) + gnus-decay-scores) (or cached (file-exists-p file)) (or (not decay) (gnus-decay-scores alist decay))) @@ -1219,8 +1254,7 @@ ;; files. (when (and files (not global)) (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) + (mapcar 'gnus-score-load-file (if adapt-file (cons adapt-file files) files))))) (when (and eval (not global)) @@ -1412,12 +1446,13 @@ (setq score (setcdr entry (gnus-delete-alist 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) "$") - file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. + (if (and (not gnus-adaptive-pretty-print) + (string-match + (concat (regexp-quote gnus-adaptive-file-suffix) "$") + file)) + ;; This is an adaptive score file, so we do not run it through + ;; `pp' unless requested. These files can get huge, and are + ;; not meant to be edited by human hands. (gnus-prin1 score) ;; This is a normal score file, so we print it very ;; prettily. @@ -1518,8 +1553,21 @@ (length (gnus-score-get header score))) scores))) ;; Call the scoring function for this type of "header". - (when (setq new (funcall (nth 2 entry) scores header - now expire trace)) + (when (if (and gnus-inhibit-slow-scoring + (if (and (stringp gnus-inhibit-slow-scoring) + ;; Always true here? + ;; (stringp gnus-newsgroup-name) + (string-match gnus-inhibit-slow-scoring + gnus-newsgroup-name)) + t + nil) + (> 0 (nth 1 (assoc header gnus-header-index)))) + (progn + (gnus-message + 7 "Scoring on headers or body skipped.") + nil) + (setq new (funcall (nth 2 entry) scores header + now expire trace))) (push new news)))) (when (gnus-buffer-live-p gnus-summary-buffer) (let ((scored gnus-newsgroup-scored)) @@ -1860,7 +1908,7 @@ (goto-char (point-min)) (if (= dmt ?e) (while (funcall search-func match nil t) - (and (= (gnus-point-at-bol) + (and (= (point-at-bol) (match-beginning 0)) (= (progn (end-of-line) (point)) (match-end 0)) @@ -2030,7 +2078,7 @@ (funcall search-func match nil t)) ;; Is it really exact? (and (eolp) - (= (gnus-point-at-bol) (match-beginning 0)) + (= (point-at-bol) (match-beginning 0)) ;; Yup. (progn (setq found (setq arts (get-text-property @@ -2120,7 +2168,7 @@ (goto-char (point-min)) (while (and (not (eobp)) (search-forward match nil t)) - (when (and (= (gnus-point-at-bol) (match-beginning 0)) + (when (and (= (point-at-bol) (match-beginning 0)) (eolp)) (setq found (setq arts (get-text-property (point) 'articles))) (if trace @@ -2194,23 +2242,19 @@ (defun gnus-enter-score-words-into-hashtb (hashtb) ;; Find all the words in the buffer and enter them into ;; the hashtable. - (let ((syntab (syntax-table)) - word val) + (let (word val) (goto-char (point-min)) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - (while (re-search-forward "\\b\\w+\\b" nil t) - (setq val - (gnus-gethash - (setq word (downcase (buffer-substring - (match-beginning 0) (match-end 0)))) - hashtb)) - (gnus-sethash - word - (append (get-text-property (gnus-point-at-eol) 'articles) val) - hashtb))) - (set-syntax-table syntab)) + (with-syntax-table gnus-adaptive-word-syntax-table + (while (re-search-forward "\\b\\w+\\b" nil t) + (setq val + (gnus-gethash + (setq word (downcase (buffer-substring + (match-beginning 0) (match-end 0)))) + hashtb)) + (gnus-sethash + word + (append (get-text-property (point-at-eol) 'articles) val) + hashtb))) ;; Make all the ignorable words ignored. (let ((ignored (append gnus-ignored-adaptive-words (if gnus-adaptive-word-no-group-words @@ -2313,39 +2357,35 @@ (let* ((hashtb (gnus-make-hashtable 1000)) (date (date-to-day (current-time-string))) (data gnus-newsgroup-data) - (syntab (syntax-table)) word d score val) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - ;; Go through all articles. - (while (setq d (pop data)) - (when (and - (not (gnus-data-pseudo-p d)) - (setq score - (cdr (assq - (gnus-data-mark d) - gnus-adaptive-word-score-alist)))) - ;; This article has a mark that should lead to - ;; adaptive word rules, so we insert the subject - ;; and find all words in that string. - (insert (mail-header-subject (gnus-data-header d))) - (downcase-region (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "\\b\\w+\\b" nil t) - ;; Put the word and score into the hashtb. - (setq val (gnus-gethash (setq word (match-string 0)) - hashtb)) - (when (or (not gnus-adaptive-word-length-limit) - (> (length word) - gnus-adaptive-word-length-limit)) - (setq val (+ score (or val 0))) - (if (and gnus-adaptive-word-minimum - (< val gnus-adaptive-word-minimum)) - (setq val gnus-adaptive-word-minimum)) - (gnus-sethash word val hashtb))) - (erase-buffer)))) - (set-syntax-table syntab)) + (with-syntax-table gnus-adaptive-word-syntax-table + ;; Go through all articles. + (while (setq d (pop data)) + (when (and + (not (gnus-data-pseudo-p d)) + (setq score + (cdr (assq + (gnus-data-mark d) + gnus-adaptive-word-score-alist)))) + ;; This article has a mark that should lead to + ;; adaptive word rules, so we insert the subject + ;; and find all words in that string. + (insert (mail-header-subject (gnus-data-header d))) + (downcase-region (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "\\b\\w+\\b" nil t) + ;; Put the word and score into the hashtb. + (setq val (gnus-gethash (setq word (match-string 0)) + hashtb)) + (when (or (not gnus-adaptive-word-length-limit) + (> (length word) + gnus-adaptive-word-length-limit)) + (setq val (+ score (or val 0))) + (if (and gnus-adaptive-word-minimum + (< val gnus-adaptive-word-minimum)) + (setq val gnus-adaptive-word-minimum)) + (gnus-sethash word val hashtb))) + (erase-buffer)))) ;; Make all the ignorable words ignored. (let ((ignored (append gnus-ignored-adaptive-words (if gnus-adaptive-word-no-group-words @@ -2373,7 +2413,8 @@ (when winconf (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) + (gnus-score-load-file bufnam) + (run-hooks 'gnus-score-edit-done-hook))) (defun gnus-score-find-trace () "Find all score rules that applies to the current article." @@ -2401,6 +2442,11 @@ (interactive) (bury-buffer nil) (gnus-summary-expand-window))) + (local-set-key "k" + (lambda () + (interactive) + (kill-buffer (current-buffer)) + (gnus-summary-expand-window))) (local-set-key "e" (lambda () "Run `gnus-score-edit-file-at-point'." (interactive) @@ -2429,7 +2475,7 @@ Type `e' to edit score file corresponding to the score rule on current line, `f' to format (pretty print) the score file and edit it, `t' toggle to truncate long lines in this buffer, -`q' to quit. +`q' to quit, `k' to kill score trace buffer. The first sexp on each line is the score rule, followed by the file name of the score file and its full name, including the directory.") @@ -2775,9 +2821,7 @@ (lambda (file) (cons (inline (gnus-score-file-rank file)) file)) files))) - (mapcar - (lambda (f) (cdr f)) - (sort alist 'car-less-than-car))))) + (mapcar 'cdr (sort alist 'car-less-than-car))))) (defun gnus-score-find-alist (group) "Return list of score files for GROUP. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-setup.el --- a/lisp/gnus/gnus-setup.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-setup.el Sun Oct 28 09:18:39 2007 +0000 @@ -140,8 +140,7 @@ (when gnus-use-sc (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite")) + (setq message-cite-function 'sc-cite-original)) ;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) ;;; Generated autoloads from lisp/gnus.el diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-soup.el --- a/lisp/gnus/gnus-soup.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-soup.el Sun Oct 28 09:18:39 2007 +0000 @@ -306,7 +306,7 @@ If NOT-ALL, don't pack ticked articles." (let ((gnus-expert-user t) (gnus-large-newsgroup nil) - (entry (gnus-gethash group gnus-newsrc-hashtb))) + (entry (gnus-group-entry group))) (when (or (null entry) (eq (car entry) t) (and (car entry) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-spec.el --- a/lisp/gnus/gnus-spec.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-spec.el Sun Oct 28 09:18:39 2007 +0000 @@ -140,7 +140,7 @@ (defvar gnus-format-specs `((version . ,emacs-version) (gnus-version . ,(gnus-continuum-version)) - (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) + (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" @@ -198,12 +198,13 @@ (not (equal emacs-version (cdr (assq 'version gnus-format-specs))))) (setq gnus-format-specs nil)) - ;; Flush the group format spec cache if it doesn't support decoded - ;; group names. + ;; 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))) - (unless (string-match " gnus-tmp-decoded-group[ )]" - (gnus-prin1-to-string (nth 2 spec))) + (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. @@ -296,9 +297,7 @@ (defun gnus-correct-length (string) "Return the correct width of STRING." - (let ((length 0)) - (mapcar (lambda (char) (incf length (gnus-char-width char))) string) - length)) + (apply #'+ (mapcar #'char-width string))) (defun gnus-correct-substring (string start &optional end) (let ((wstart 0) @@ -310,14 +309,14 @@ ;; Find the start position. (while (and (< seek length) (< wseek start)) - (incf wseek (gnus-char-width (aref string seek))) + (incf wseek (char-width (aref string seek))) (incf seek)) (setq wstart seek) ;; Find the end position. (while (and (<= seek length) (or (not end) (<= wseek end))) - (incf wseek (gnus-char-width (aref string seek))) + (incf wseek (char-width (aref string seek))) (incf seek)) (setq wend seek) (substring string wstart (1- wend)))) @@ -622,6 +621,9 @@ ?s))) ;; Find the specification from `spec-alist'. ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) + ;; We used to use "%l" for displaying the grouplens score. + ((eq spec ?l) + (setq elem '("" ?s))) (t (setq elem '("*" ?s)))) (setq elem-type (cadr elem)) @@ -672,7 +674,7 @@ (list (car flist))) ;; A single number. ((string= fstring "%d") - (setq dontinsert) + (setq dontinsert t) (if insert (list `(princ ,(car flist))) (list `(int-to-string ,(car flist))))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-srvr.el --- a/lisp/gnus/gnus-srvr.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-srvr.el Sun Oct 28 09:18:39 2007 +0000 @@ -52,7 +52,7 @@ The following specs are understood: -%h backend +%h back end %n name %w address %s status @@ -116,6 +116,7 @@ ["Copy" gnus-server-copy-server t] ["Edit" gnus-server-edit-server t] ["Regenerate" gnus-server-regenerate-server t] + ["Compact" gnus-server-compact-server t] ["Exit" gnus-server-exit t])) (easy-menu-define @@ -165,6 +166,8 @@ "g" gnus-server-regenerate-server + "z" gnus-server-compact-server + "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) @@ -189,7 +192,7 @@ (defface gnus-server-closed '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) (((class color) (background dark)) - (:foreground "Light Steel Blue" :italic t)) + (:foreground "LightBlue" :italic t)) (t (:italic t))) "Face used for displaying CLOSED servers" :group 'gnus-server-visual) @@ -299,7 +302,6 @@ (gnus-set-format 'server t) (let ((alist gnus-server-alist) (buffer-read-only nil) - (opened gnus-opened-servers) done server op-ser) (erase-buffer) (setq gnus-inserted-opened-servers nil) @@ -314,27 +316,26 @@ (pop alist))) ;; Then we insert the list of servers that have been opened in ;; this session. - (while opened - (when (and (not (member (caar opened) done)) + (dolist (open gnus-opened-servers) + (when (and (not (member (car open) done)) ;; Just ignore ephemeral servers. - (not (member (caar opened) gnus-ephemeral-servers))) - (push (caar opened) done) + (not (member (car open) gnus-ephemeral-servers))) + (push (car open) done) (gnus-server-insert-server-line - (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) - (caar opened)) - (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) - (setq opened (cdr opened)))) + (setq op-ser (format "%s:%s" (caar open) (nth 1 (car open)))) + (car open)) + (push (list op-ser (car open)) gnus-inserted-opened-servers)))) (goto-char (point-min)) (gnus-server-position-point)) (defun gnus-server-server-name () - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) + (let ((server (get-text-property (point-at-bol) 'gnus-server))) (and server (symbol-name server)))) (defun gnus-server-named-server () - "Returns a server name that matches one of the names returned by -gnus-method-to-server." - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server))) + "Return a server name that matches one of the names returned by +`gnus-method-to-server'." + (let ((server (get-text-property (point-at-bol) 'gnus-named-server))) (and server (symbol-name server)))) (defalias 'gnus-server-position-point 'gnus-goto-colon) @@ -377,7 +378,14 @@ (if cached (setq gnus-server-method-cache (delq cached gnus-server-method-cache))) - (if entry (setcdr entry info) + (if entry + (progn + ;; Remove the server from `gnus-opened-servers' since + ;; it has never been opened with the new `info' yet. + (gnus-opened-servers-remove (cdr entry)) + ;; Don't make a new Lisp object. + (setcar (cdr entry) (car info)) + (setcdr (cdr entry) (cdr info))) (setq gnus-server-alist (nconc gnus-server-alist (list (cons server info)))))))) @@ -478,9 +486,8 @@ (defun gnus-server-open-all-servers () "Open all servers." (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-open-server (car (pop servers)))))) + (dolist (server gnus-inserted-opened-servers) + (gnus-server-open-server (car server)))) (defun gnus-server-close-server (server) "Close SERVER." @@ -510,6 +517,8 @@ "Close all servers." (interactive) (dolist (server gnus-inserted-opened-servers) + (gnus-server-close-server (car server))) + (dolist (server gnus-server-alist) (gnus-server-close-server (car server)))) (defun gnus-server-deny-server (server) @@ -586,7 +595,8 @@ `(lambda (form) (gnus-server-set-info ,server form) (gnus-server-list-servers) - (gnus-server-position-point))))) + (gnus-server-position-point)) + 'edit-server))) (defun gnus-server-scan-server (server) "Request a scan from the current server." @@ -717,11 +727,12 @@ (while (not (eobp)) (ignore-errors (push (cons - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) + (mm-string-as-unibyte + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point)))) (let ((last (read cur))) (cons (read cur) last))) groups)) @@ -729,18 +740,19 @@ (while (not (eobp)) (ignore-errors (push (cons - (if (eq (char-after) ?\") - (read cur) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - name)) + (mm-string-as-unibyte + (if (eq (char-after) ?\") + (read cur) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + name))) (let ((last (read cur))) (cons (read cur) last))) groups)) @@ -783,18 +795,26 @@ (prog1 (1+ (point)) (insert (format "%c%7d: %s\n" - (let ((level (gnus-group-level - (concat prefix (setq name (car group)))))) - (cond - ((<= level gnus-level-subscribed) ? ) - ((<= level gnus-level-unsubscribed) ?U) - ((= level gnus-level-zombie) ?Z) - (t ?K))) + (let ((level + (if (string= prefix "") + (gnus-group-level (setq name (car group))) + (gnus-group-level + (concat prefix (setq name (car group))))))) + (cond + ((<= level gnus-level-subscribed) ? ) + ((<= level gnus-level-unsubscribed) ?U) + ((= level gnus-level-zombie) ?Z) + (t ?K))) (max 0 (- (1+ (cddr group)) (cadr group))) - (mm-decode-coding-string - name - (inline (gnus-group-name-charset method name)))))) - (list 'gnus-group name)))) + ;; Don't decode if name is ASCII + (if (and (fboundp 'detect-coding-string) + (eq (detect-coding-string name t) 'undecided)) + name + (mm-decode-coding-string + name + (inline (gnus-group-name-charset method name))))))) + (list 'gnus-group name) + ))) (switch-to-buffer (current-buffer))) (goto-char (point-min)) (gnus-group-position-point) @@ -885,7 +905,7 @@ (save-excursion (beginning-of-line) (let ((name (get-text-property (point) 'gnus-group))) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) + (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t) (concat (gnus-method-to-server-name gnus-browse-current-method) ":" (or name (match-string-no-properties 1))))))) @@ -926,8 +946,7 @@ gnus-browse-current-method)))) gnus-level-default-subscribed (gnus-group-level group) (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) + (gnus-group-entry (car (nth 1 gnus-newsrc-alist)))) (null (gnus-group-entry group))) (delete-char 1) (insert ? )) @@ -966,7 +985,7 @@ (gnus-get-function (gnus-server-to-method server) 'request-regenerate) (error - (error "This backend doesn't support regeneration"))) + (error "This back end doesn't support regeneration"))) (gnus-message 5 "Requesting regeneration of %s..." server) (unless (gnus-open-server server) (error "Couldn't open server")) @@ -974,6 +993,40 @@ (gnus-message 5 "Requesting regeneration of %s...done" server) (gnus-message 5 "Couldn't regenerate %s" server)))) + +;;; +;;; Server compaction. -- dvl +;;; + +;; #### FIXME: this function currently fails to update the Group buffer's +;; #### appearance. +(defun gnus-server-compact-server () + "Issue a command to the server to compact all its groups. + +Note: currently only implemented in nnml." + (interactive) + (let ((server (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + (condition-case () + (gnus-get-function (gnus-server-to-method server) + 'request-compact) + (error + (error "This back end doesn't support compaction"))) + (gnus-message 5 "\ +Requesting compaction of %s... (this may take a long time)" + server) + (unless (gnus-open-server server) + (error "Couldn't open server")) + (if (not (gnus-request-compact server)) + (gnus-message 5 "Couldn't compact %s" server) + (gnus-message 5 "Requesting compaction of %s...done" server) + ;; Invalidate the original article buffer which might be out of date. + ;; #### NOTE: Yes, this might be a bit rude, but since compaction + ;; #### will not happen very often, I think this is acceptable. + (let ((original (get-buffer gnus-original-article-buffer))) + (and original (gnus-kill-buffer original)))))) + (provide 'gnus-srvr) ;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-start.el --- a/lisp/gnus/gnus-start.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-start.el Sun Oct 28 09:18:39 2007 +0000 @@ -506,19 +506,23 @@ (defun gnus-subscribe-hierarchical-interactive (groups) (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) + prefixes prefix start ans group starts real-group) (while groups (setq prefixes (list "^")) (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) + (while (not (string-match (car prefixes) + (gnus-group-real-name (car groups)))) (setq prefixes (cdr prefixes))) (setq prefix (car prefixes)) (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) + (if (and (string-match "[^\\.]\\." (gnus-group-real-name (car groups)) + start) (cdr groups) (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) + (concat "^" (substring + (gnus-group-real-name (car groups)) + 0 (match-end 0)))) + (string-match prefix (gnus-group-real-name (cadr groups)))) (progn (push prefix prefixes) (message "Descend hierarchy %s? ([y]nsq): " @@ -530,16 +534,18 @@ (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (push group gnus-killed-list) (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups))) (setq starts (cdr starts))) ((= ans ?s) (while (and groups - (string-match prefix - (setq group (car groups)))) + (setq group (car groups) + real-group (gnus-group-real-name group)) + (string-match prefix real-group)) (gnus-sethash group group gnus-killed-hashtb) (gnus-subscribe-alphabetically (car groups)) (setq groups (cdr groups))) @@ -632,8 +638,7 @@ ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) + gnus-level-killed (gnus-group-entry (or next "dummy.group"))) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) t)) @@ -755,6 +760,13 @@ (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + + ;; Add "native" to gnus-predefined-server-alist just to have a + ;; name for the native select method. + (when gnus-select-method + (push (cons "native" gnus-select-method) + gnus-predefined-server-alist)) + (if gnus-agent (gnus-agentize)) @@ -787,11 +799,6 @@ (when (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file)) - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - ;; Do the actual startup. (if gnus-agent (gnus-request-create-group "queue" '(nndraft ""))) @@ -809,8 +816,7 @@ (defun gnus-start-draft-setup () "Make sure the draft group exists." (gnus-request-create-group "drafts" '(nndraft "")) - (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb) - (gnus-message 3 "Subscribing drafts group") + (unless (gnus-group-entry "nndraft:drafts") (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group "nndraft:drafts" nil '(nndraft "")))) (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t) @@ -891,7 +897,7 @@ (when (and (file-exists-p gnus-current-startup-file) (file-exists-p dribble-file) (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) + (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) (when (search-forward "Gnus was exited on purpose" nil t) (setq purpose t)) @@ -961,30 +967,34 @@ (gnus-read-newsrc-file rawfile)) ;; Make sure the archive server is available to all and sundry. - (when gnus-message-archive-method - (unless (assoc "archive" gnus-server-alist) - (let ((method (or (and (stringp gnus-message-archive-method) - (gnus-server-to-method - gnus-message-archive-method)) - gnus-message-archive-method))) - ;; Check whether the archive method is writable. - (unless (or (stringp method) - (memq 'respool (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - (setq method "archive")) ;; The default. - (push (if (stringp method) - `("archive" - nnfolder - ,method - (nnfolder-directory - ,(nnheader-concat message-directory method)) - (nnfolder-active-file - ,(nnheader-concat message-directory - (concat method "/active"))) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - (cons "archive" method)) - gnus-server-alist)))) + (let ((method (or (and (stringp gnus-message-archive-method) + (gnus-server-to-method + gnus-message-archive-method)) + gnus-message-archive-method))) + ;; Check whether the archive method is writable. + (unless (or (not method) + (stringp method) + (memq 'respool (assoc (format "%s" (car method)) + gnus-valid-select-methods))) + (setq method "archive")) ;; The default. + (when (stringp method) + (setq method `(nnfolder + ,method + (nnfolder-directory + ,(nnheader-concat message-directory method)) + (nnfolder-active-file + ,(nnheader-concat message-directory + (concat method "/active"))) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)))) + (if (assoc "archive" gnus-server-alist) + (when gnus-update-message-archive-method + (if method + (setcdr (assoc "archive" gnus-server-alist) method) + (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) + gnus-server-alist)))) + (when method + (push (cons "archive" method) gnus-server-alist)))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -1334,16 +1344,16 @@ (when (and (stringp entry) oldlevel (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) + (setq entry (gnus-group-entry entry))) (if (and (not oldlevel) (consp entry)) (setq oldlevel (gnus-info-level (nth 2 entry))) (setq oldlevel (or oldlevel gnus-level-killed))) (when (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) + (setq previous (gnus-group-entry previous))) (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) + (gnus-group-entry group)) ;; We are trying to subscribe a group that is already ;; subscribed. () ; Do nothing. @@ -1367,8 +1377,7 @@ entry) (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) (when (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) + (setcdr (gnus-group-entry (car (nth 3 entry))) (cdr entry))) (setcdr (cdr entry) (cdddr entry))))) @@ -1428,7 +1437,7 @@ (gnus-sethash group (cons num previous) gnus-newsrc-hashtb)) (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) + (setcdr (gnus-group-entry (caadr entry)) entry)) (gnus-dribble-enter (format "(gnus-group-set-info '%S)" info))))) @@ -1439,7 +1448,7 @@ (defun gnus-kill-newsgroup (newsgroup) "Obsolete function. Kills a newsgroup." (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) + (gnus-group-entry newsgroup) gnus-level-killed)) (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. @@ -1467,14 +1476,14 @@ (lambda (group) ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (when (setq entry (gnus-group-entry group)) (gnus-group-change-level entry gnus-level-killed) (setq gnus-killed-list (delete group gnus-killed-list)))) bogus '("group" "groups" "remove")) (while (setq group (pop bogus)) ;; Remove all bogus subscribed groups by first killing them, and ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (when (setq entry (gnus-group-entry group)) (gnus-group-change-level entry gnus-level-killed) (setq gnus-killed-list (delete group gnus-killed-list))))) ;; Then we remove all bogus groups from the list of killed and @@ -1543,8 +1552,8 @@ ;; command may have responded with the `(0 . 0)'. We ;; ignore this if we already have an active entry ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) + (if (and (zerop (or (car active) 0)) + (zerop (or (cdr active) 0)) (gnus-active group)) (gnus-active group) @@ -1652,8 +1661,8 @@ (setq num (max 0 (- (cdr active) num))))) ;; Set the number of unread articles. (when (and info - (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb)) - (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) + (gnus-group-entry (gnus-info-group info))) + (setcar (gnus-group-entry (gnus-info-group info)) num)) num))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' @@ -1674,12 +1683,12 @@ (methods-cache nil) (type-cache nil) scanned-methods info group active method retrieve-groups cmethod - method-type) + method-type ignore) (gnus-message 6 "Checking new news...") (while newsrc (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) + (setq info (pop newsrc)))))) ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't @@ -1702,28 +1711,30 @@ (when (and method (not (setq method-type (cdr (assoc method type-cache))))) (setq method-type - (cond - ((gnus-secondary-method-p method) - 'secondary) - ((inline (gnus-server-equal gnus-select-method method)) - 'primary) - (t - 'foreign))) + (cond + ((gnus-secondary-method-p method) + 'secondary) + ((inline (gnus-server-equal gnus-select-method method)) + 'primary) + (t + 'foreign))) (push (cons method method-type) type-cache)) + (setq ignore nil) (cond ((and method (eq method-type 'foreign)) ;; These groups are foreign. Check the level. - (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method))))) + (if (<= (gnus-info-level info) foreign-level) + (when (setq active (gnus-activate-group group 'scan)) + ;; Let the Gnus agent save the active file. + (when (and gnus-agent active (gnus-online method)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) active)) + (unless (inline (gnus-virtual-group-p group)) + (inline (gnus-close-group group))) + (when (fboundp (intern (concat (symbol-name (car method)) + "-request-update-info"))) + (inline (gnus-request-update-info info method)))) + (setq ignore t))) ;; These groups are native or secondary. ((> (gnus-info-level info) level) ;; We don't want these groups. @@ -1762,13 +1773,17 @@ ((eq active 'ignore) ;; Don't do anything. ) + ((and active ignore) + ;; The level of the foreign group is higher than the specified + ;; value. + ) (active (inline (gnus-get-unread-articles-in-group info active t))) (t ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) - (let ((tmp (gnus-gethash group gnus-newsrc-hashtb))) + (let ((tmp (gnus-group-entry group))) (when tmp (setcar tmp t)))))) @@ -1782,8 +1797,8 @@ (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) + (mapcar (lambda (group) (gnus-group-real-name group)) groups) + method) (dolist (group groups) (cond ((setq active (gnus-active (gnus-info-group @@ -1793,7 +1808,7 @@ ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) + (setcar (gnus-group-entry group) t))))))) (gnus-message 6 "Checking new news...done"))) @@ -1802,7 +1817,7 @@ (defun gnus-make-hashtable-from-newsrc-alist () (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) - prev) + prev info method rest methods) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) (setq alist (setq prev (setq gnus-newsrc-alist @@ -1811,14 +1826,26 @@ gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist + (setq info (car alist)) + ;; Make the same select-methods identical Lisp objects. + (when (setq method (gnus-info-method info)) + (if (setq rest (member method methods)) + (gnus-info-set-method info (car rest)) + (push method methods))) (gnus-sethash - (caar alist) + (car info) ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) + (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) prev) gnus-newsrc-hashtb) (setq prev alist - alist (cdr alist))))) + alist (cdr alist))) + ;; Make the same select-methods in `gnus-server-alist' identical + ;; as well. + (while methods + (setq method (pop methods)) + (when (setq rest (rassoc method gnus-server-alist)) + (setcdr rest method))))) (defun gnus-make-hashtable-from-killed () "Create a hash table from the killed and zombie lists." @@ -1845,9 +1872,9 @@ (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) + (let* ((info (nth 2 (or (gnus-group-entry group) + (gnus-group-entry + (gnus-group-real-name group))))) (ranges (gnus-info-read info)) news article) (while articles @@ -1867,9 +1894,8 @@ (defun gnus-make-ascending-articles-unread (group articles) "Mark ascending ARTICLES in GROUP as unread." - (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb))) + (let* ((entry (or (gnus-group-entry group) + (gnus-group-entry (gnus-group-real-name group)))) (info (nth 2 entry)) (ranges (gnus-info-read info)) (r ranges) @@ -1941,7 +1967,7 @@ (while lists (setq killed (car lists)) (while killed - (gnus-sethash (car killed) nil hashtb) + (gnus-sethash (mm-string-as-unibyte (car killed)) nil hashtb) (setq killed (cdr killed))) (setq lists (cdr lists))))) @@ -2118,7 +2144,7 @@ (while (not (eobp)) (condition-case () (progn - (narrow-to-region (point) (gnus-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) ;; group gets set to a symbol interned in the hash table ;; (what a hack!!) - jwz (setq group (let ((obarray hashtb)) (read cur))) @@ -2150,7 +2176,7 @@ (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol)))))) + (point-at-bol) (point-at-eol)))))) (widen) (forward-line 1))))) @@ -2387,6 +2413,8 @@ (setq gnus-format-specs gnus-default-format-specs))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) + (dolist (elem gnus-newsrc-alist) + (setcar elem (mm-string-as-unibyte (car elem)))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -2502,10 +2530,10 @@ ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options (buffer-substring - (gnus-point-at-bol) + (point-at-bol) ;; Options may continue on the next line. (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) + (point-at-bol)) (point))))) (forward-line -1)) (symbol @@ -2573,8 +2601,8 @@ ;; The line was buggy. (setq group nil) (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol)))) + (buffer-substring (point-at-bol) + (point-at-eol)))) nil)) ;; Skip past ", ". Spaces are invalid in these ranges, but ;; we allow them, because it's a common mistake to put a @@ -2683,9 +2711,9 @@ (while (re-search-forward "[ \t]-n" nil t) (setq eol (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) + (and (re-search-forward "[ \t]-n" (point-at-eol) t) (- (point) 2))) - (gnus-point-at-eol))) + (point-at-eol))) ;; Search for all "words"... (while (re-search-forward "[^ \t,\n]+" eol t) (if (eq (char-after (match-beginning 0)) ?!) @@ -2793,7 +2821,7 @@ ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes))) (condition-case nil (delete-file working-file) (file-error nil))))) @@ -2845,7 +2873,7 @@ (while variables (when (and (boundp (setq variable (pop variables))) (symbol-value variable)) - (princ "(setq ") + (princ "\n(setq ") (princ (symbol-name variable)) (princ " '") (prin1 (symbol-value variable)) @@ -2872,6 +2900,10 @@ (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) + ;; Use a unibyte buffer since group names are unibyte strings; + ;; in particular, non-ASCII group names are the ones encoded by + ;; a certain coding system. + (mm-disable-multibyte) ;; Write options. (when gnus-newsrc-options (insert gnus-newsrc-options)) @@ -2914,7 +2946,8 @@ (delete-file gnus-startup-file) (clear-visited-file-modtime)) (gnus-run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) + (let ((coding-system-for-write 'raw-text)) + (save-buffer)) (kill-buffer (current-buffer))))) @@ -2926,7 +2959,7 @@ (defun gnus-slave-mode () "Minor mode for slave Gnusae." - (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) + (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap)) (gnus-run-hooks 'gnus-slave-mode-hook)) (defun gnus-slave-save-newsrc () @@ -2939,7 +2972,7 @@ (let ((coding-system-for-write gnus-ding-file-coding-system)) (gnus-write-buffer slave-name)) (when modes - (set-file-modes slave-name modes))))) + (gnus-set-file-modes slave-name modes))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files @@ -3117,6 +3150,41 @@ (symbol-value 'nnimap-mailbox-info) (make-vector 1 0))))) +(defun gnus-check-reasonable-setup () + ;; Check whether nnml and nnfolder share a directory. + (let ((display-warn + (if (fboundp 'display-warning) + 'display-warning + (lambda (type message) + (if noninteractive + (message "Warning (%s): %s" type message) + (let (window) + (with-current-buffer (get-buffer-create "*Warnings*") + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "Warning (%s): %s\n" type message)) + (setq window (display-buffer (current-buffer))) + (set-window-start + window + (prog2 + (forward-line (- 1 (window-height window))) + (point) + (goto-char (point-max)))))))))) + method active actives match) + (dolist (server gnus-server-alist) + (setq method (gnus-server-to-method server) + active (intern (format "%s-active-file" (car method)))) + (when (and (member (car method) '(nnml nnfolder)) + (gnus-server-opened method) + (boundp active)) + (when (setq match (assoc (symbol-value active) actives)) + (funcall display-warn 'gnus-server + (format "%s and %s share the same active file %s" + (car method) + (cadr match) + (car match)))) + (push (list (symbol-value active) method) actives))))) (provide 'gnus-start) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Oct 28 09:18:39 2007 +0000 @@ -62,19 +62,31 @@ :group 'gnus-summary-exit :type 'boolean) +(defcustom gnus-summary-next-group-on-exit t + "If non-nil, go to the next unread newsgroup on summary exit. +See `gnus-group-goto-unread'." + :link '(custom-manual "(gnus)Group Maneuvering") + :group 'gnus-summary-exit + :version "23.0" ;; No Gnus + :type 'boolean) + (defcustom gnus-fetch-old-headers nil "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is t, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. This -variable can also be a number. In that case, no more than that number -of old headers will be fetched. If it has the value `invisible', all +If an unread article in the group refers to an older, already +read (or just marked as read) article, the old article will not +normally be displayed in the Summary buffer. If this variable is +t, Gnus will attempt to grab the headers to the old articles, and +thereby build complete threads. If it has the value `some', all +old headers will be fetched but only enough headers to connect +otherwise loose threads will be displayed. This variable can +also be a number. In that case, no more than that number of old +headers will be fetched. If it has the value `invisible', all old headers will be fetched, but none will be displayed. -The server has to support NOV for any of this to work." +The server has to support NOV for any of this to work. + +This feature can seriously impact performance it ignores all +locally cached header entries." :group 'gnus-thread :type '(choice (const :tag "off" nil) (const :tag "on" t) @@ -83,7 +95,7 @@ number (sexp :menu-tag "other" t))) -(defcustom gnus-refer-thread-limit 200 +(defcustom gnus-refer-thread-limit 500 "*The number of old headers to fetch when doing \\\\[gnus-summary-refer-thread]. If t, fetch all the available old headers." :group 'gnus-thread @@ -366,6 +378,28 @@ :group 'gnus-summary-maneuvering :type 'boolean) +(defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect + "What article should be selected after exiting an ephemeral group. +Valid values include: + +`next' + Select the next article. +`next-unread' + Select the next unread article. +`next-noselect' + Move the cursor to the next article. This is the default. +`next-unread-noselect' + Move the cursor to the next unread article. + +If it has any other value or there is no next (unread) article, the +article selected before entering to the ephemeral group will appear." + :version "23.0" ;; No Gnus + :group 'gnus-summary-maneuvering + :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" + (const next) (const next-unread) + (const next-noselect) (const next-unread-noselect) + (sexp :tag "other" :value nil))) + (defcustom gnus-auto-goto-ignores 'unfetched "*Says how to handle unfetched articles when maneuvering. @@ -391,7 +425,7 @@ :group 'gnus-summary-maneuvering :type 'boolean) -(defcustom gnus-auto-center-summary t +(defcustom gnus-auto-center-summary 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." @@ -438,6 +472,13 @@ (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) +(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix + "Function used to compute default prefix for article move/copy/etc prompts. +The function should take one argument, a group name, and return a +string with the suggested prefix." + :group 'gnus-summary-mail + :type 'function) + ;; FIXME: Although the custom type is `character' for the following variables, ;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs @@ -697,6 +738,40 @@ :group 'gnus-score-default :type 'integer) +(defun gnus-widget-reversible-match (widget value) + "Ignoring WIDGET, convert VALUE to internal form. +VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." + ;; (debug value) + (or (symbolp value) + (and (listp value) + (eq (length value) 2) + (eq (nth 0 value) 'not) + (symbolp (nth 1 value))))) + +(defun gnus-widget-reversible-to-internal (widget value) + "Ignoring WIDGET, convert VALUE to internal form. +VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom. +FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." + ;; (debug value) + (if (atom value) + (list value nil) + (list (nth 1 value) t))) + +(defun gnus-widget-reversible-to-external (widget value) + "Ignoring WIDGET, convert VALUE to external form. +VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom. +\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)." + ;; (debug value) + (if (nth 1 value) + (list 'not (nth 0 value)) + (nth 0 value))) + +(define-widget 'gnus-widget-reversible 'group + "A `group' that convert values." + :match 'gnus-widget-reversible-match + :value-to-internal 'gnus-widget-reversible-to-internal + :value-to-external 'gnus-widget-reversible-to-external) + (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) "*List of functions used for sorting articles in the summary buffer. @@ -709,6 +784,9 @@ very similar. (Sorting by date means sorting by the time the message was sent, sorting by number means sorting by arrival time.) +Each item can also be a list `(not F)' where F is a function; +this reverses the sort order. + Ready-made functions include `gnus-article-sort-by-number', `gnus-article-sort-by-author', `gnus-article-sort-by-subject', `gnus-article-sort-by-date', `gnus-article-sort-by-random' @@ -717,13 +795,16 @@ When threading is turned on, the variable `gnus-thread-sort-functions' controls how articles are sorted." :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-article-sort-by-number) - (function-item gnus-article-sort-by-author) - (function-item gnus-article-sort-by-subject) - (function-item gnus-article-sort-by-date) - (function-item gnus-article-sort-by-score) - (function-item gnus-article-sort-by-random) - (function :tag "other")))) + :type '(repeat (gnus-widget-reversible + (choice (function-item gnus-article-sort-by-number) + (function-item gnus-article-sort-by-author) + (function-item gnus-article-sort-by-subject) + (function-item gnus-article-sort-by-date) + (function-item gnus-article-sort-by-score) + (function-item gnus-article-sort-by-random) + (function :tag "other")) + (boolean :tag "Reverse order")))) + (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) "*List of functions used for sorting threads in the summary buffer. @@ -738,25 +819,34 @@ very similar. (Sorting by date means sorting by the time the message was sent, sorting by number means sorting by arrival time.) +Each list item can also be a list `(not F)' where F is a +function; this specifies reversed sort order. + Ready-made functions include `gnus-thread-sort-by-number', -`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', -`gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', -`gnus-thread-sort-by-random', and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). +`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient' +`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', +`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', +`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random', +and `gnus-thread-sort-by-total-score' (see +`gnus-thread-score-function'). When threading is turned off, the variable `gnus-article-sort-functions' controls how articles are sorted." :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-thread-sort-by-number) - (function-item gnus-thread-sort-by-author) - (function-item gnus-thread-sort-by-subject) - (function-item gnus-thread-sort-by-date) - (function-item gnus-thread-sort-by-score) - (function-item gnus-thread-sort-by-total-score) - (function-item gnus-thread-sort-by-random) - (function :tag "other")))) + :type '(repeat + (gnus-widget-reversible + (choice (function-item gnus-thread-sort-by-number) + (function-item gnus-thread-sort-by-author) + (function-item gnus-thread-sort-by-recipient) + (function-item gnus-thread-sort-by-subject) + (function-item gnus-thread-sort-by-date) + (function-item gnus-thread-sort-by-score) + (function-item gnus-thread-sort-by-most-recent-number) + (function-item gnus-thread-sort-by-most-recent-date) + (function-item gnus-thread-sort-by-random) + (function-item gnus-thread-sort-by-total-score) + (function :tag "other")) + (boolean :tag "Reverse order")))) (defcustom gnus-thread-score-function '+ "*Function used for calculating the total score of a thread. @@ -1016,10 +1106,29 @@ (and user-mail-address (not (string= user-mail-address "")) (regexp-quote user-mail-address)) - "*Regexp of From headers that may be suppressed in favor of To headers." + "*From headers that may be suppressed in favor of To headers. +This can be a regexp or a list of regexps." :version "21.1" :group 'gnus-summary - :type 'regexp) + :type '(choice regexp + (repeat :tag "Regexp List" regexp))) + +(defsubst gnus-ignored-from-addresses () + (gmm-regexp-concat gnus-ignored-from-addresses)) + +(defcustom gnus-summary-to-prefix "-> " + "*String prefixed to the To field in the summary line when +using `gnus-ignored-from-addresses'." + :version "22.1" + :group 'gnus-summary + :type 'string) + +(defcustom gnus-summary-newsgroup-prefix "=> " + "*String prefixed to the Newsgroup field in the summary +line when using `gnus-ignored-from-addresses'." + :version "22.1" + :group 'gnus-summary + :type 'string) (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "List of charsets that should be ignored. @@ -1127,12 +1236,12 @@ :group 'gnus-summary :type 'string) -(defcustom gnus-article-loose-mime nil +(defcustom gnus-article-loose-mime t "If non-nil, don't require MIME-Version header. Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not supply the MIME-Version header or deliberately strip it from the mail. -Set it to non-nil, Gnus will treat some articles as MIME even if -the MIME-Version header is missed." +If non-nil (the default), Gnus will treat some articles as MIME +even if the MIME-Version header is missing." :version "22.1" :type 'boolean :group 'gnus-article-mime) @@ -1214,7 +1323,6 @@ (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) (?i gnus-tmp-score ?d) (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) @@ -1463,7 +1571,6 @@ nil (load "gnus-sum.el" t t t)) (require 'gnus) - (require 'gnus-agent) (require 'gnus-art))) ;; MIME stuff. @@ -1490,19 +1597,15 @@ (eq gnus-newsgroup-name (car gnus-decode-encoded-word-methods-cache))) (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) - (mapcar (lambda (x) - (if (symbolp x) - (nconc gnus-decode-encoded-word-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-encoded-word-methods-cache - (list (cdr x)))))) - gnus-decode-encoded-word-methods)) - (let ((xlist gnus-decode-encoded-word-methods-cache)) - (pop xlist) - (while xlist - (setq string (funcall (pop xlist) string)))) - string) + (dolist (method gnus-decode-encoded-word-methods) + (if (symbolp method) + (nconc gnus-decode-encoded-word-methods-cache (list method)) + (if (and gnus-newsgroup-name + (string-match (car method) gnus-newsgroup-name)) + (nconc gnus-decode-encoded-word-methods-cache + (list (cdr method))))))) + (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string) + (setq string (funcall method string)))) ;; Subject simplification. @@ -1574,8 +1677,8 @@ (setq modified-tick (buffer-modified-tick)) (cond ((listp gnus-simplify-subject-fuzzy-regexp) - (mapcar 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) + (mapc 'gnus-simplify-buffer-fuzzy-step + gnus-simplify-subject-fuzzy-regexp)) (gnus-simplify-subject-fuzzy-regexp (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") @@ -1612,8 +1715,8 @@ ((eq gnus-summary-gather-subject-limit 'fuzzy) (gnus-simplify-subject-fuzzy subject)) ((numberp gnus-summary-gather-subject-limit) - (gnus-limit-string (gnus-simplify-subject-re subject) - gnus-summary-gather-subject-limit)) + (truncate-string-to-width (gnus-simplify-subject-re subject) + gnus-summary-gather-subject-limit)) (t subject))) @@ -1665,6 +1768,8 @@ "," gnus-summary-best-unread-article "\M-s" gnus-summary-search-article-forward "\M-r" gnus-summary-search-article-backward + "\M-S" gnus-summary-repeat-search-article-forward + "\M-R" gnus-summary-repeat-search-article-backward "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "j" gnus-summary-goto-article @@ -1704,6 +1809,7 @@ "\C-c\C-s\C-l" gnus-summary-sort-by-lines "\C-c\C-s\C-c" gnus-summary-sort-by-chars "\C-c\C-s\C-a" gnus-summary-sort-by-author + "\C-c\C-s\C-t" gnus-summary-sort-by-recipient "\C-c\C-s\C-s" gnus-summary-sort-by-subject "\C-c\C-s\C-d" gnus-summary-sort-by-date "\C-c\C-s\C-i" gnus-summary-sort-by-score @@ -1795,6 +1901,8 @@ (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) "/" gnus-summary-limit-to-subject "n" gnus-summary-limit-to-articles + "b" gnus-summary-limit-to-bodies + "h" gnus-summary-limit-to-headers "w" gnus-summary-pop-limit "s" gnus-summary-limit-to-subject "a" gnus-summary-limit-to-author @@ -1814,7 +1922,11 @@ "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read "o" gnus-summary-insert-old-articles - "N" gnus-summary-insert-new-articles) + "N" gnus-summary-insert-new-articles + "S" gnus-summary-limit-to-singletons + "r" gnus-summary-limit-to-replied + "R" gnus-summary-limit-to-recipient + "A" gnus-summary-limit-to-address) (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) "n" gnus-summary-next-unread-article @@ -1834,11 +1946,13 @@ (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) "k" gnus-summary-kill-thread + "E" gnus-summary-expire-thread "l" gnus-summary-lower-thread "i" gnus-summary-raise-thread "T" gnus-summary-toggle-threads "t" gnus-summary-rethread-current "^" gnus-summary-reparent-thread + "\M-^" gnus-summary-reparent-children "s" gnus-summary-show-thread "S" gnus-summary-show-all-threads "h" gnus-summary-hide-thread @@ -1854,7 +1968,8 @@ (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) "g" gnus-summary-prepare "c" gnus-summary-insert-cached-articles - "d" gnus-summary-insert-dormant-articles) + "d" gnus-summary-insert-dormant-articles + "t" gnus-summary-insert-ticked-articles) (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) "c" gnus-summary-catchup-and-exit @@ -1863,6 +1978,7 @@ "Q" gnus-summary-exit "Z" gnus-summary-exit "n" gnus-summary-catchup-and-goto-next-group + "p" gnus-summary-catchup-and-goto-prev-group "R" gnus-summary-reselect-current-group "G" gnus-summary-rescan-group "N" gnus-summary-next-group @@ -1889,6 +2005,7 @@ "g" gnus-summary-show-article "s" gnus-summary-isearch-article "P" gnus-summary-print-article + "S" gnus-sticky-article "M" gnus-mailing-list-insinuate "t" gnus-article-babel) @@ -1899,11 +2016,13 @@ "e" gnus-article-emphasize "w" gnus-article-fill-cited-article "Q" gnus-article-fill-long-lines + "L" gnus-article-toggle-truncate-lines "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr "q" gnus-article-de-quoted-unreadable "6" gnus-article-de-base64-unreadable "Z" gnus-article-decode-HZ + "A" gnus-article-treat-ansi-sequences "h" gnus-article-wash-html "u" gnus-article-unsplit-urls "s" gnus-summary-force-verify-and-decrypt @@ -1916,7 +2035,8 @@ "v" gnus-summary-verbose-headers "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-dumbquotes) + "d" gnus-article-treat-dumbquotes + "i" gnus-summary-idna-message) (gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map) ;; mnemonic: deuglif*Y* @@ -2028,9 +2148,15 @@ "m" gnus-summary-repair-multipart "v" gnus-article-view-part "o" gnus-article-save-part + "O" gnus-article-save-part-and-strip + "r" gnus-article-replace-part + "d" gnus-article-delete-part + "t" gnus-article-view-part-as-type + "j" gnus-article-jump-to-part "c" gnus-article-copy-part "C" gnus-article-view-part-as-charset "e" gnus-article-view-part-externally + "H" gnus-article-browse-html-article "E" gnus-article-encrypt-body "i" gnus-article-inline-part "|" gnus-article-pipe-part) @@ -2174,11 +2300,13 @@ ["Repair multipart" gnus-summary-repair-multipart t] ["Pipe part..." gnus-article-pipe-part t] ["Inline part" gnus-article-inline-part t] + ["View part as type..." gnus-article-view-part-as-type t] ["Encrypt body" gnus-article-encrypt-body :active (not (gnus-group-read-only-p)) ,@(if (featurep 'xemacs) nil '(:help "Encrypt the message body on disk"))] ["View part externally" gnus-article-view-part-externally t] + ["View HTML parts in browser" gnus-article-browse-html-article t] ["View part with charset..." gnus-article-view-part-as-charset t] ["Copy part" gnus-article-copy-part t] ["Save part..." gnus-article-save-part t] @@ -2233,6 +2361,7 @@ ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] ["Fill long lines" gnus-article-fill-long-lines t] + ["Toggle truncate long lines" gnus-article-toggle-truncate-lines t] ["Capitalize sentences" gnus-article-capitalize-sentences t] ["Remove CR" gnus-article-remove-cr t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] @@ -2240,6 +2369,7 @@ ["Rot 13" gnus-summary-caesar-message ,@(if (featurep 'xemacs) '(t) '(:help "\"Caesar rotate\" article by 13"))] + ["De-IDNA" gnus-summary-idna-message t] ["Morse decode" gnus-summary-morse-message t] ["Unix pipe..." gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] @@ -2253,6 +2383,7 @@ ["Unsplit URLs" gnus-article-unsplit-urls t] ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["Decode HZ" gnus-article-decode-HZ t] + ["ANSI sequences" gnus-article-treat-ansi-sequences t] ("(Outlook) Deuglify" ["Unwrap lines" gnus-article-outlook-unwrap-lines t] ["Repair attribution" gnus-article-outlook-repair-attribution t] @@ -2322,6 +2453,7 @@ ["Remove article" gnus-cache-remove-article t]) ["Translate" gnus-article-babel t] ["Select article buffer" gnus-summary-select-article-buffer t] + ["Make article buffer sticky" gnus-sticky-article t] ["Enter digest buffer" gnus-summary-enter-digest-group t] ["Isearch article..." gnus-summary-isearch-article t] ["Beginning of the article" gnus-summary-beginning-of-article t] @@ -2362,6 +2494,7 @@ ["Go up thread" gnus-summary-up-thread t] ["Top of thread" gnus-summary-top-thread t] ["Mark thread as read" gnus-summary-kill-thread t] + ["Mark thread as expired" gnus-summary-expire-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] ["Rethread current" gnus-summary-rethread-current t])) @@ -2450,12 +2583,16 @@ ["Marks..." gnus-summary-limit-to-marks t] ["Subject..." gnus-summary-limit-to-subject t] ["Author..." gnus-summary-limit-to-author t] + ["Recipient..." gnus-summary-limit-to-recipient t] + ["Address..." gnus-summary-limit-to-address t] ["Age..." gnus-summary-limit-to-age t] ["Extra..." gnus-summary-limit-to-extra t] ["Score..." gnus-summary-limit-to-score t] ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] ["Unseen" gnus-summary-limit-to-unseen t] + ["Singletons" gnus-summary-limit-to-singletons t] + ["Replied" gnus-summary-limit-to-replied t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] ["Next or process marked articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] @@ -2469,6 +2606,7 @@ ["Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] ["Remove all marks" gnus-summary-unmark-all-processable t] + ["Invert marks" gnus-uu-invert-processable t] ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] ["Mark region" gnus-uu-mark-region (gnus-mark-active-p)] @@ -2512,6 +2650,7 @@ ("Sort" ["Sort by number" gnus-summary-sort-by-number t] ["Sort by author" gnus-summary-sort-by-author t] + ["Sort by recipient" gnus-summary-sort-by-recipient t] ["Sort by subject" gnus-summary-sort-by-subject t] ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t] @@ -2536,6 +2675,7 @@ ["Regenerate" gnus-summary-prepare t] ["Insert cached articles" gnus-summary-insert-cached-articles t] ["Insert dormant articles" gnus-summary-insert-dormant-articles t] + ["Insert ticked articles" gnus-summary-insert-ticked-articles t] ["Toggle threading" gnus-summary-toggle-threads t]) ["See old articles" gnus-summary-insert-old-articles t] ["See new articles" gnus-summary-insert-new-articles t] @@ -2559,6 +2699,7 @@ '(:help "Mark unread articles in this group as read, then exit"))] ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] + ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t] ["Exit group" gnus-summary-exit ,@(if (featurep 'xemacs) '(t) '(:help "Exit current group, return to group selection mode"))] @@ -2602,7 +2743,7 @@ (const :tag "Retro look" gnus-summary-tool-bar-retro) (repeat :tag "User defined list" gmm-tool-bar-item) (symbol)) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-summary-tool-bar-update :group 'gnus-summary) @@ -2653,7 +2794,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-summary-tool-bar-update :group 'gnus-summary) @@ -2688,7 +2829,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-summary-tool-bar-update :group 'gnus-summary) @@ -2699,7 +2840,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'gnus-summary-tool-bar-update :group 'gnus-summary) @@ -2838,12 +2979,13 @@ \\{gnus-summary-mode-map}" (interactive) (kill-all-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-make-local-variables)) + (gnus-summary-make-local-variables) + (setq gnus-newsgroup-name group) (when (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar) (gnus-summary-make-tool-bar)) - (gnus-summary-make-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-make-local-variables)) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) (setq major-mode 'gnus-summary-mode) @@ -2851,13 +2993,13 @@ (make-local-variable 'minor-mode-alist) (use-local-map gnus-summary-mode-map) (buffer-disable-undo) - (setq buffer-read-only t) ;Disable modification + (setq buffer-read-only t ;Disable modification + show-trailing-whitespace nil) (setq truncate-lines t) (setq selective-display t) (setq selective-display-ellipses t) ;Display `...' (gnus-summary-set-display-table) (gnus-set-default-directory) - (setq gnus-newsgroup-name group) (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) (make-local-variable 'gnus-summary-dummy-line-format) @@ -2890,9 +3032,9 @@ (let ((locals gnus-summary-local-variables)) (while locals (if (consp (car locals)) - (and (vectorp (caar locals)) + (and (symbolp (caar locals)) (set (caar locals) nil)) - (and (vectorp (car locals)) + (and (symbolp (car locals)) (set (car locals) nil))) (setq locals (cdr locals))))) @@ -2964,10 +3106,9 @@ (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) (when offset (gnus-data-update-list odata offset))) - ;; Find the last element in the list to be spliced into the main + ;; Find the last element in the list to be spliced into the main ;; list. - (while (cdr list) - (setq list (cdr list))) + (setq list (last list)) (if (not data) (progn (setcdr list gnus-newsgroup-data) @@ -3283,10 +3424,11 @@ (gnus-summary-mode group) (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) - (unless gnus-single-article-buffer - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer)) + (when (gnus-group-quit-config group) + (set (make-local-variable 'gnus-single-article-buffer) nil)) + (make-local-variable 'gnus-article-buffer) + (make-local-variable 'gnus-article-current) + (make-local-variable 'gnus-original-article-buffer) (setq gnus-newsgroup-name group) ;; Set any local variables in the group parameters. (gnus-summary-set-local-parameters gnus-newsgroup-name) @@ -3319,8 +3461,7 @@ (push (eval (car locals)) vlist)) (setq locals (cdr locals))) (setq vlist (nreverse vlist))) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked gnus-newsgroup-spam-marked spam @@ -3444,25 +3585,33 @@ (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) (let ((mail-parse-charset gnus-newsgroup-charset) + (ignored-from-addresses (gnus-ignored-from-addresses)) ; Is it really necessary to do this next part for each summary line? ; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (or - (and gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses gnus-tmp-from) + (and ignored-from-addresses + (string-match ignored-from-addresses gnus-tmp-from) (let ((extra-headers (mail-header-extra header)) to newsgroups) (cond ((setq to (cdr (assq 'To extra-headers))) - (concat "-> " + (concat gnus-summary-to-prefix (inline (gnus-summary-extract-address-component (funcall gnus-decode-encoded-address-function to))))) - ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) - (concat "=> " newsgroups))))) + ((setq newsgroups + (or + (cdr (assq 'Newsgroups extra-headers)) + (and + (memq 'Newsgroups gnus-extra-headers) + (eq (car (gnus-find-method-for-group + gnus-newsgroup-name)) 'nntp) + (gnus-group-real-name gnus-newsgroup-name)))) + (concat gnus-summary-newsgroup-prefix newsgroups))))) (inline (gnus-summary-extract-address-component gnus-tmp-from))))) (defun gnus-summary-insert-line (gnus-tmp-header @@ -3613,12 +3762,8 @@ (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." - (let ((params (gnus-group-find-parameter group)) - (vars '(quit-config)) ; Ignore quit-config. - elem) - (while params - (setq elem (car params) - params (cdr params)) + (let ((vars '(quit-config))) ; Ignore quit-config. + (dolist (elem (gnus-group-find-parameter group)) (and (consp elem) ; Has to be a cons. (consp (cdr elem)) ; The cdr has to be a list. (symbolp (car elem)) ; Has to be a symbol in there. @@ -4140,21 +4285,19 @@ (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. - (mapcar - (lambda (relation) - (when (gnus-dependencies-add-header - (make-full-mail-header - gnus-reffed-article-number - (nth 3 relation) "" (or (nth 4 relation) "") - (nth 1 relation) - (or (nth 2 relation) "") 0 0 "") - gnus-newsgroup-dependencies nil) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number))) - (sort relations 'car-less-than-car)) + (dolist (relation (sort relations 'car-less-than-car)) + (when (gnus-dependencies-add-header + (make-full-mail-header + gnus-reffed-article-number + (nth 3 relation) "" (or (nth 4 relation) "") + (nth 1 relation) + (or (nth 2 relation) "") 0 0 "") + gnus-newsgroup-dependencies nil) + (push gnus-reffed-article-number gnus-newsgroup-limit) + (push gnus-reffed-article-number gnus-newsgroup-sparse) + (push (cons gnus-reffed-article-number gnus-sparse-mark) + gnus-newsgroup-reads) + (decf gnus-reffed-article-number))) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -4182,13 +4325,12 @@ "Translate STRING into something that doesn't contain weird characters." (mm-subst-char-in-string ?\r ?\- - (mm-subst-char-in-string - ?\n ?\- string))) + (mm-subst-char-in-string ?\n ?\- string t) t)) ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) + (let ((eol (point-at-eol)) (buffer (current-buffer)) header references in-reply-to) @@ -4213,7 +4355,7 @@ (setq x (nnheader-nov-field)))) (error x)) (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id + (nnheader-nov-read-message-id number) ; id (setq references (nnheader-nov-field)) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines @@ -4287,8 +4429,7 @@ (setq article (read (current-buffer)) header (gnus-nov-parse-line article dependencies))) (when header - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (push header gnus-newsgroup-headers) (if (memq (setq article (mail-header-number header)) gnus-newsgroup-unselected) @@ -4385,7 +4526,7 @@ (setq thread (list (car (gnus-id-to-thread id)))) ;; Get the thread this article is part of. (setq thread (gnus-remove-thread id))) - (setq old-pos (gnus-point-at-bol)) + (setq old-pos (point-at-bol)) (setq current (save-excursion (and (re-search-backward "[\r\n]" nil t) (gnus-summary-article-number)))) @@ -4567,9 +4708,9 @@ (gnus-summary-show-thread) (gnus-data-remove number - (- (gnus-point-at-bol) + (- (point-at-bol) (prog1 - (1+ (gnus-point-at-eol)) + (1+ (point-at-eol)) (gnus-delete-line))))))) (defun gnus-sort-threads-recursive (threads func) @@ -4689,6 +4830,23 @@ (gnus-article-sort-by-author (gnus-thread-header h1) (gnus-thread-header h2))) +(defsubst gnus-article-sort-by-recipient (h1 h2) + "Sort articles by recipient." + (gnus-string< + (let ((extract (funcall + gnus-extract-address-components + (or (cdr (assq 'To (mail-header-extra h1))) "")))) + (or (car extract) (cadr extract))) + (let ((extract (funcall + gnus-extract-address-components + (or (cdr (assq 'To (mail-header-extra h2))) "")))) + (or (car extract) (cadr extract))))) + +(defun gnus-thread-sort-by-recipient (h1 h2) + "Sort threads by root recipient." + (gnus-article-sort-by-recipient + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-subject (h1 h2) "Sort articles by root subject." (gnus-string< @@ -4809,33 +4967,39 @@ :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-false-root "> " "With %B spec, used for a false root of a thread. If nil, use subject instead." :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-single-indent "" "With %B spec, used for a thread with just one message. If nil, use subject instead." :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-vertical "| " "With %B spec, used for drawing a vertical line." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-indent " " "With %B spec, used for indenting." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-leaf-with-other "+-> " "With %B spec, used for a leaf with brothers." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-single-leaf "\\-> " "With %B spec, used for a leaf without brothers." :version "22.1" @@ -5194,23 +5358,20 @@ gnus-list-identifiers)) changed subject) (when regexp + (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) (dolist (header gnus-newsgroup-headers) (setq subject (mail-header-subject header) changed nil) - (while (string-match - (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)") - subject) + (while (string-match regexp subject) (setq subject - (concat (substring subject 0 (match-beginning 2)) + (concat (substring subject 0 (match-beginning 1)) (substring subject (match-end 0))) changed t)) - (when (and changed - (string-match - "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject)) - (setq subject - (concat (substring subject 0 (match-beginning 1)) - (substring subject (match-end 1))))) (when changed + (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject) + (setq subject + (concat (substring subject 0 (match-beginning 1)) + (substring subject (match-end 1))))) (mail-header-set-subject header subject)))))) (defun gnus-fetch-headers (articles) @@ -5238,33 +5399,37 @@ "Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected. If SELECT-ARTICLES, only select those articles from GROUP." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry group)) ;;!!! Dirty hack; should be removed. (gnus-summary-ignore-duplicates (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) - articles fetched-articles cached) + charset articles fetched-articles cached) (unless (gnus-check-server (set (make-local-variable 'gnus-current-select-method) (gnus-find-method-for-group group))) (error "Couldn't open server")) + (setq charset (gnus-group-name-charset gnus-current-select-method group)) (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) - (error "Couldn't activate group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group)))) + (error + "Couldn't activate group %s: %s" + (mm-decode-coding-string group charset) + (mm-decode-coding-string (gnus-status-message group) charset)))) (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) - (gnus-kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - (gnus-group-decoded-name group) (gnus-status-message group))) + (when (equal major-mode 'gnus-summary-mode) + (gnus-kill-buffer (current-buffer))) + (error "Couldn't request group %s: %s" + (mm-decode-coding-string group charset) + (mm-decode-coding-string (gnus-status-message group) charset))) (when gnus-agent (gnus-agent-possibly-alter-active group (gnus-active group) info) @@ -5387,7 +5552,8 @@ (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) ;; Set up the article buffer now, if necessary. - (unless gnus-single-article-buffer + (unless (and gnus-single-article-buffer + (equal gnus-article-buffer "*Article*")) (gnus-article-setup-buffer)) ;; First and last article in this newsgroup. (when gnus-newsgroup-headers @@ -5521,9 +5687,7 @@ (read-string (format "How many articles from %s (%s %d): " - (gnus-limit-string - (gnus-group-decoded-name gnus-newsgroup-name) - 35) + (gnus-group-decoded-name gnus-newsgroup-name) (if initial "max" "default") number) (if initial @@ -5849,7 +6013,7 @@ (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name entry info xref-hashtb idlist method nth4) + name info xref-hashtb idlist method nth4) (save-excursion (set-buffer gnus-group-buffer) (when (setq xref-hashtb @@ -5860,8 +6024,7 @@ (setq idlist (symbol-value group)) ;; Dead groups are not updated. (and (prog1 - (setq entry (gnus-gethash name gnus-newsrc-hashtb) - info (nth 2 entry)) + (setq info (gnus-get-info name)) (when (stringp (setq nth4 (gnus-info-method info))) (setq nth4 (gnus-server-to-method nth4)))) ;; Only do the xrefs if the group has the same @@ -5883,7 +6046,7 @@ xref-hashtb))))) (defun gnus-compute-read-articles (group articles) - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (let* ((entry (gnus-group-entry group)) (info (nth 2 entry)) (active (gnus-active group)) ninfo) @@ -5920,14 +6083,13 @@ (defun gnus-group-make-articles-read (group articles) "Update the info of GROUP to say that ARTICLES are read." (let* ((num 0) - (entry (gnus-gethash group gnus-newsrc-hashtb)) + (entry (gnus-group-entry group)) (info (nth 2 entry)) (active (gnus-active group)) range) (when entry (setq range (gnus-compute-read-articles group articles)) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (gnus-undo-register `(progn (gnus-info-set-marks ',info ',(gnus-info-marks info) t) @@ -5966,9 +6128,9 @@ (let ((cur nntp-server-buffer) (dependencies (or dependencies - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - headers id end ref + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-dependencies))) + headers id end ref number (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case nil @@ -6001,7 +6163,7 @@ (vector ;; Number. (prog1 - (read cur) + (setq number (read cur)) (end-of-line) (setq p (point)) (narrow-to-region (point) @@ -6038,7 +6200,7 @@ (match-end 1)) ;; If there was no message-id, we just fake one ;; to make subsequent routines simpler. - (nnheader-generate-fake-message-id)))) + (nnheader-generate-fake-message-id number)))) ;; References. (progn (goto-char p) @@ -6185,8 +6347,8 @@ (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. This is meant to be called in `gnus-article-internal-prepare-hook'." - (let ((headers (save-excursion (set-buffer gnus-summary-buffer) - gnus-current-headers))) + (let ((headers (with-current-buffer gnus-summary-buffer + gnus-current-headers))) (or (not gnus-use-cross-reference) (not headers) (and (mail-header-xref headers) @@ -6201,7 +6363,7 @@ (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) (gnus-point-at-eol))) + (setq xref (buffer-substring (point) (point-at-eol))) (mail-header-set-xref headers xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) @@ -6229,9 +6391,9 @@ (goto-char (gnus-data-pos d)) (gnus-data-remove number - (- (gnus-point-at-bol) + (- (point-at-bol) (prog1 - (1+ (gnus-point-at-eol)) + (1+ (point-at-eol)) (gnus-delete-line)))))) ;; Remove list identifiers from subject. (when gnus-list-identifiers @@ -6345,8 +6507,7 @@ (defun gnus-summary-process-mark-set (set) "Make SET into the current process marked articles." (gnus-summary-unmark-all-processable) - (while set - (gnus-summary-set-process-mark (pop set)))) + (mapc 'gnus-summary-set-process-mark set)) ;;; Searching and stuff @@ -6362,8 +6523,7 @@ (defun gnus-summary-best-group (&optional exclude-group) "Find the name of the best unread group. If EXCLUDE-GROUP, do not go to this group." - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (save-excursion (gnus-group-best-unread-group exclude-group)))) @@ -6494,7 +6654,7 @@ ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) gnus-auto-center-summary - 2)))) + (/ (1- (window-height)) 2))))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) @@ -6508,7 +6668,7 @@ (let ((top-pos (save-excursion (forward-line (- top)) (point)))) (if (> bottom top-pos) ;; Keep the second line from the top visible - (set-window-start window top-pos t) + (set-window-start window top-pos) ;; Try to keep the bottom line visible; if it's partially ;; obscured, either scroll one more line to make it fully ;; visible, or revert to using TOP-POS. @@ -6552,7 +6712,8 @@ (defun gnus-list-of-unread-articles (group) (let* ((read (gnus-info-read (gnus-get-info group))) (active (or (gnus-active group) (gnus-activate-group group))) - (last (cdr active)) + (last (or (cdr active) + (error "Group %s couldn't be activated " group))) (bottom (if gnus-newsgroup-maximum-articles (max (car active) (- last gnus-newsgroup-maximum-articles -1)) @@ -6752,8 +6913,7 @@ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) ;; Set the new ranges of read articles. - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (gnus-undo-force-boundary)) (gnus-update-read-articles group (gnus-sorted-union @@ -6813,8 +6973,13 @@ (gnus-run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + ;; Don't kill sticky article buffers + (unless (eq major-mode 'gnus-sticky-article-mode) + (gnus-kill-buffer gnus-article-buffer) + (setq gnus-article-current nil)))) + (gnus-kill-buffer gnus-original-article-buffer)) (when gnus-use-cache (gnus-cache-possibly-remove-articles) (gnus-cache-save-buffers)) @@ -6838,6 +7003,7 @@ (gnus-group-jump-to-group group)) (gnus-run-hooks 'gnus-summary-exit-hook) (unless (or quit-config + (not gnus-summary-next-group-on-exit) ;; If this group has disappeared from the summary ;; buffer, don't skip forwards. (not (string= group (gnus-group-group-name)))) @@ -6845,11 +7011,6 @@ (setq group-point (point)) (if temporary nil ;Nothing to do. - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) (set-buffer buf) (if (not gnus-kill-summary-on-exit) (progn @@ -6864,12 +7025,6 @@ (gnus-summary-clear-local-variables)) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) - ;; We clear the global counterparts of the buffer-local - ;; variables as well, just to be on the safe side. - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) ;; Return to group mode buffer. (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) @@ -6919,10 +7074,6 @@ (gnus-summary-clear-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-clear-local-variables)) - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-clear-local-variables)) (gnus-kill-buffer gnus-summary-buffer)) (unless gnus-single-article-buffer (setq gnus-article-current nil)) @@ -6961,19 +7112,26 @@ (gnus-set-global-variables)))) (if (or (eq (cdr quit-config) 'article) (eq (cdr quit-config) 'pick)) - (progn - ;; The current article may be from the ephemeral group - ;; thus it is best that we reload this article - ;; - ;; If we're exiting from a large digest, this can be - ;; extremely slow. So, it's better not to reload it. -- jh. - ;;(gnus-summary-show-article) - (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) - (gnus-configure-windows 'pick 'force) - (gnus-configure-windows (cdr quit-config) 'force))) + (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) + (gnus-configure-windows 'pick 'force) + (gnus-configure-windows (cdr quit-config) 'force)) (gnus-configure-windows (cdr quit-config) 'force)) (when (eq major-mode 'gnus-summary-mode) - (gnus-summary-next-subject 1 nil t) + (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect + next-unread-noselect)) + (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit + 'next-noselect) + (gnus-summary-next-subject 1 nil t)) + ((eq gnus-auto-select-on-ephemeral-exit + 'next-unread-noselect) + (gnus-summary-next-subject 1 t t)))) + ;; Hide the article buffer which displays the article different + ;; from the one that the cursor points to in the summary buffer. + (gnus-configure-windows 'summary 'force)) + (cond ((eq gnus-auto-select-on-ephemeral-exit 'next) + (gnus-summary-next-subject 1)) + ((eq gnus-auto-select-on-ephemeral-exit 'next-unread) + (gnus-summary-next-subject 1 t)))) (gnus-summary-recenter) (gnus-summary-position-point)))) @@ -7004,7 +7162,7 @@ (if (null arg) (not gnus-dead-summary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-dead-summary-mode - (gnus-add-minor-mode + (add-minor-mode 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) (defun gnus-deaden-summary () @@ -7012,8 +7170,7 @@ ;; Kill any previous dead summary buffer. (when (and gnus-dead-summary (buffer-name gnus-dead-summary)) - (save-excursion - (set-buffer gnus-dead-summary) + (with-current-buffer gnus-dead-summary (when gnus-dead-summary-mode (kill-buffer (current-buffer))))) ;; Make this the current dead summary. @@ -7032,8 +7189,7 @@ (save-excursion (when (and (buffer-name buffer) (not gnus-single-article-buffer)) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer))) (cond @@ -7073,7 +7229,7 @@ (when current-prefix-arg (completing-read "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar (lambda (file) (list file)) + (mapcar 'list gnus-group-faq-directory)))))) (let (gnus-faq-buffer) (when (setq gnus-faq-buffer @@ -7287,15 +7443,15 @@ (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (mm-enable-multibyte))) + (unless (and (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (eq major-mode 'gnus-article-mode))) + (gnus-article-setup-buffer)) (gnus-set-global-variables) - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (setq gnus-article-charset gnus-newsgroup-charset) - (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) - (mm-enable-multibyte))) + (with-current-buffer gnus-article-buffer + (setq gnus-article-charset gnus-newsgroup-charset) + (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) + (mm-enable-multibyte)) (if (null article) nil (prog1 @@ -7402,8 +7558,7 @@ (gnus-summary-jump-to-group gnus-newsgroup-name)) (let ((cmd last-command-char) (point - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (point))) (group (if (eq gnus-keep-same-level 'best) @@ -7456,7 +7611,7 @@ (format " (Type %s for %s [%s])" (single-key-description cmd) (gnus-group-decoded-name group) - (car (gnus-gethash group gnus-newsrc-hashtb))) + (gnus-group-unread group)) (format " (Type %s to exit %s)" (single-key-description cmd) (gnus-group-decoded-name gnus-newsgroup-name))))) @@ -7844,6 +7999,123 @@ current-prefix-arg)) (gnus-summary-limit-to-subject from "from" not-matching)) +(defun gnus-summary-limit-to-recipient (recipient &optional not-matching) + "Limit the summary buffer to articles with the given RECIPIENT. + +If NOT-MATCHING, exclude RECIPIENT. + +To and Cc headers are checked. You need to include them in +`nnmail-extra-headers'." + ;; Unlike `rmail-summary-by-recipients', doesn't include From. + (interactive + (list (read-string (format "%s recipient (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg)) + (when (not (equal "" recipient)) + (prog1 (let* ((to + (if (memq 'To nnmail-extra-headers) + (gnus-summary-find-matching + (cons 'extra 'To) recipient 'all nil nil + not-matching) + (gnus-message + 1 "`To' isn't present in `nnmail-extra-headers'") + (sit-for 1) + nil)) + (cc + (if (memq 'Cc nnmail-extra-headers) + (gnus-summary-find-matching + (cons 'extra 'Cc) recipient 'all nil nil + not-matching) + (gnus-message + 1 "`Cc' isn't present in `nnmail-extra-headers'") + (sit-for 1) + nil)) + (articles + (if not-matching + ;; We need the numbers that are in both lists: + (mapcar (lambda (a) + (and (memq a to) a)) + cc) + (nconc to cc)))) + (unless articles + (error "Found no matches for \"%s\"" recipient)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + +(defun gnus-summary-limit-to-address (address &optional not-matching) + "Limit the summary buffer to articles with the given ADDRESS. + +If NOT-MATCHING, exclude ADDRESS. + +To, Cc and From headers are checked. You need to include `To' and `Cc' +in `nnmail-extra-headers'." + (interactive + (list (read-string (format "%s address (regexp): " + (if current-prefix-arg "Exclude" "Limit to"))) + current-prefix-arg)) + (when (not (equal "" address)) + (prog1 (let* ((to + (if (memq 'To nnmail-extra-headers) + (gnus-summary-find-matching + (cons 'extra 'To) address 'all nil nil + not-matching) + (gnus-message + 1 "`To' isn't present in `nnmail-extra-headers'") + (sit-for 1) + t)) + (cc + (if (memq 'Cc nnmail-extra-headers) + (gnus-summary-find-matching + (cons 'extra 'Cc) address 'all nil nil + not-matching) + (gnus-message + 1 "`Cc' isn't present in `nnmail-extra-headers'") + (sit-for 1) + t)) + (from + (gnus-summary-find-matching "from" address + 'all nil nil not-matching)) + (articles + (if not-matching + ;; We need the numbers that are in all lists: + (if (eq cc t) + (if (eq to t) + from + (mapcar (lambda (a) (car (memq a from))) to)) + (if (eq to t) + (mapcar (lambda (a) (car (memq a from))) cc) + (mapcar (lambda (a) (car (memq a from))) + (mapcar (lambda (a) (car (memq a to))) + cc)))) + (nconc (if (eq to t) nil to) + (if (eq cc t) nil cc) + from)))) + (unless articles + (error "Found no matches for \"%s\"" address)) + (gnus-summary-limit articles)) + (gnus-summary-position-point)))) + +(defun gnus-summary-limit-strange-charsets-predicate (header) + (let ((string (concat (mail-header-subject header) + (mail-header-from header))) + charset found) + (dotimes (i (1- (length string))) + (setq charset (format "%s" (char-charset (aref string (1+ i))))) + (when (string-match "unicode\\|big\\|japanese" charset) + (setq found t))) + found)) + +(defun gnus-summary-limit-to-predicate (predicate) + "Limit to articles where PREDICATE returns non-nil. +PREDICATE will be called with the header structures of the +articles." + (let ((articles nil) + (case-fold-search t)) + (dolist (header gnus-newsgroup-headers) + (when (funcall predicate header) + (push (mail-header-number header) articles))) + (gnus-summary-limit (nreverse articles)))) + (defun gnus-summary-limit-to-age (age &optional younger-p) "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to @@ -7862,10 +8134,9 @@ (if (numberp days) (progn (setq days-got t) - (if (< days 0) - (progn - (setq younger (not younger)) - (setq days (* days -1))))) + (when (< days 0) + (setq younger (not younger)) + (setq days (* days -1)))) (message "Please enter a number.") (sleep-for 1))) (list days younger))) @@ -7950,6 +8221,81 @@ gnus-duplicate-mark gnus-souped-mark) 'reverse))) +(defun gnus-summary-limit-to-headers (match &optional reverse) + "Limit the summary buffer to articles that have headers that match MATCH. +If REVERSE (the prefix), limit to articles that don't match." + (interactive "sMatch headers (regexp): \nP") + (gnus-summary-limit-to-bodies match reverse t)) + +(defun gnus-summary-limit-to-bodies (match &optional reverse headersp) + "Limit the summary buffer to articles that have bodies that match MATCH. +If REVERSE (the prefix), limit to articles that don't match." + (interactive "sMatch body (regexp): \nP") + (let ((articles nil) + (gnus-select-article-hook nil) ;Disable hook. + (gnus-article-prepare-hook nil) + (gnus-use-article-prefetch nil) + (gnus-keep-backlog nil) + (gnus-break-pages nil) + (gnus-summary-display-arrow nil) + (gnus-updated-mode-lines nil) + (gnus-auto-center-summary nil) + (gnus-display-mime-function nil)) + (dolist (data gnus-newsgroup-data) + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil (gnus-data-number data))) + (save-excursion + (set-buffer gnus-article-buffer) + (article-goto-body) + (let* ((case-fold-search t) + (found (if headersp + (re-search-backward match nil t) + (re-search-forward match nil t)))) + (when (or (and found + (not reverse)) + (and (not found) + reverse)) + (push (gnus-data-number data) articles))))) + (if (not articles) + (message "No messages matched") + (gnus-summary-limit articles))) + (gnus-summary-position-point)) + +(defun gnus-summary-limit-to-singletons (&optional threadsp) + "Limit the summary buffer to articles that aren't part on any thread. +If THREADSP (the prefix), limit to articles that are in threads." + (interactive "P") + (let ((articles nil) + thread-articles + threads) + (dolist (thread gnus-newsgroup-threads) + (if (stringp (car thread)) + (dolist (thread (cdr thread)) + (push thread threads)) + (push thread threads))) + (dolist (thread threads) + (setq thread-articles (gnus-articles-in-thread thread)) + (when (or (and threadsp + (> (length thread-articles) 1)) + (and (not threadsp) + (= (length thread-articles) 1))) + (setq articles (nconc thread-articles articles)))) + (if (not articles) + (message "No messages matched") + (gnus-summary-limit articles)) + (gnus-summary-position-point))) + +(defun gnus-summary-limit-to-replied (&optional unreplied) + "Limit the summary buffer to replied articles. +If UNREPLIED (the prefix), limit to unreplied articles." + (interactive "P") + (if unreplied + (gnus-summary-limit + (gnus-set-difference gnus-newsgroup-articles + gnus-newsgroup-replied)) + (gnus-summary-limit gnus-newsgroup-replied)) + (gnus-summary-position-point)) + (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) @@ -8035,6 +8381,14 @@ (gnus-message 3 "No dormant articles for this group") (gnus-summary-goto-subjects gnus-newsgroup-dormant)))) +(defun gnus-summary-insert-ticked-articles () + "Insert ticked articles for this group into the current buffer." + (interactive) + (let ((gnus-verbose (max 6 gnus-verbose))) + (if (not gnus-newsgroup-marked) + (gnus-message 3 "No ticked articles for this group") + (gnus-summary-goto-subjects gnus-newsgroup-marked)))) + (defun gnus-summary-limit-include-dormant () "Display all the hidden articles that are marked as dormant. Note that this command only works on a subset of the articles currently @@ -8295,13 +8649,12 @@ (and gnus-newsgroup-display (not (funcall gnus-newsgroup-display))) ;; Check NoCeM things. - (if (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (progn - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t)))) + (when (and gnus-use-nocem + (gnus-nocem-unwanted-article-p + (mail-header-id (car thread)))) + (setq gnus-newsgroup-unreads + (delq number gnus-newsgroup-unreads)) + t))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit @@ -8513,8 +8866,7 @@ (let* ((name (format "%s-%d" (gnus-group-prefixed-name gnus-newsgroup-name (list 'nndoc "")) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer gnus-current-article))) (ogroup gnus-newsgroup-name) (params (append (gnus-info-params (gnus-get-info ogroup)) @@ -8572,12 +8924,11 @@ documents as newsgroups. Obeys the standard process/prefix convention." (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (ogroup gnus-newsgroup-name) + (let* ((ogroup gnus-newsgroup-name) (params (append (gnus-info-params (gnus-get-info ogroup)) (list (cons 'to-group ogroup)))) - article group egroup groups vgroup) - (while (setq article (pop articles)) + group egroup groups vgroup) + (dolist (article (gnus-summary-work-articles n)) (setq group (format "%s-%d" gnus-newsgroup-name article)) (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) @@ -8588,7 +8939,7 @@ ;; the wrong guess. (message-narrow-to-head) (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") + (delete-matching-lines "^Path:\\|^From ") (widen) (if (setq egroup (gnus-group-read-ephemeral-group @@ -8627,6 +8978,20 @@ (widen) (isearch-forward regexp-p)))) +(defun gnus-summary-repeat-search-article-forward () + "Repeat the previous search forwards." + (interactive) + (unless gnus-last-search-regexp + (error "No previous search")) + (gnus-summary-search-article-forward gnus-last-search-regexp)) + +(defun gnus-summary-repeat-search-article-backward () + "Repeat the previous search backwards." + (interactive) + (unless gnus-last-search-regexp + (error "No previous search")) + (gnus-summary-search-article-forward gnus-last-search-regexp t)) + (defun gnus-summary-search-article-forward (regexp &optional backward) "Search for an article containing REGEXP forward. If BACKWARD, search backward instead." @@ -8929,8 +9294,7 @@ (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (mm-read-coding-system "View as charset: " ;; actually it is coding system. - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (mm-detect-coding-region (point) (point-max)))))) (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) @@ -9054,8 +9418,8 @@ (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. -The numerical prefix specifies how many places to rotate each letter -forward." +With a non-numerical prefix, also rotate headers. A numerical +prefix specifies how many places to rotate each letter forward." (interactive "P") (gnus-summary-select-article) (let ((mail-header-separator "")) @@ -9064,14 +9428,38 @@ (widen) (let ((start (window-start)) buffer-read-only) - (message-caesar-buffer-body arg) + (if (equal arg '(4)) + (message-caesar-buffer-body nil t) + (message-caesar-buffer-body arg)) (set-window-start (get-buffer-window (current-buffer)) start))))) ;; Create buttons and stuff... (gnus-treat-article nil)) -(autoload 'unmorse-region "morse" - "Convert morse coded text in region to ordinary ASCII text." - t) +(defun gnus-summary-idna-message (&optional arg) + "Decode IDNA encoded domain names in the current articles. +IDNA encoded domain names looks like `xn--bar'. If a string +remain unencoded after running this function, it is likely an +invalid IDNA string (`xn--bar' is invalid). + +You must have GNU Libidn (`http://www.gnu.org/software/libidn/') +installed for this command to work." + (interactive "P") + (if (not (and (condition-case nil (require 'idna) + (file-error)) + (mm-coding-system-p 'utf-8) + (executable-find (symbol-value 'idna-program)))) + (gnus-message + 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)") + (gnus-summary-select-article) + (let ((mail-header-separator "")) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (let ((start (window-start)) + buffer-read-only) + (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t) + (replace-match (idna-to-unicode (match-string 1)))) + (set-window-start (get-buffer-window (current-buffer)) start))))))) (defun gnus-summary-morse-message (&optional arg) "Morse decode the current article." @@ -9088,7 +9476,7 @@ (when (message-goto-body) (gnus-narrow-to-body)) (goto-char (point-min)) - (while (re-search-forward "·" (point-max) t) + (while (search-forward "·" (point-max) t) (replace-match ".")) (unmorse-region (point-min) (point-max)) (widen) @@ -9141,14 +9529,16 @@ (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) - (gnus-group-real-prefix gnus-newsgroup-name) + (funcall gnus-move-group-prefix-function + gnus-newsgroup-name) "")) (names '((move "Move" "Moving") (copy "Copy" "Copying") (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) + art-group to-method new-xref article to-groups + articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) ;; Read the newsgroup name. @@ -9166,15 +9556,27 @@ (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil)) (gnus-summary-select-article nil nil nil (car articles)))) - (setq to-newsgroup - (gnus-read-move-group-name - (cadr (assq action names)) - (symbol-value (intern (format "gnus-current-%s-group" action))) - articles prefix)) - (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method - (gnus-server-to-method - (gnus-group-method to-newsgroup)))) + (setq to-newsgroup (gnus-read-move-group-name + (cadr (assq action names)) + (symbol-value + (intern (format "gnus-current-%s-group" action))) + articles prefix) + encoded to-newsgroup + to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) + (set (intern (format "gnus-current-%s-group" action)) + (mm-decode-coding-string + to-newsgroup + (gnus-group-name-charset to-method to-newsgroup)))) + (unless to-method + (setq to-method (or select-method + (gnus-server-to-method + (gnus-group-method to-newsgroup))))) + (setq to-newsgroup + (or encoded + (and to-newsgroup + (mm-encode-coding-string + to-newsgroup + (gnus-group-name-charset to-method to-newsgroup))))) ;; Check the method we are to move this article to... (unless (gnus-check-backend-function 'request-accept-article (car to-method)) @@ -9183,7 +9585,9 @@ (error "Can't open server %s" (car to-method))) (gnus-message 6 "%s to %s: %s..." (caddr (assq action names)) - (or (car select-method) to-newsgroup) articles) + (or (car select-method) + (gnus-group-decoded-name to-newsgroup)) + articles) (while articles (setq article (pop articles)) (setq @@ -9193,20 +9597,30 @@ ((eq action 'move) ;; Remove this article from future suppression. (gnus-dup-unsuppress-article article) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgroup - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form - (not articles))) ; Only save nov last time + (let* ((from-method (gnus-find-method-for-group + gnus-newsgroup-name)) + (to-method (or select-method + (gnus-find-method-for-group to-newsgroup))) + (move-is-internal (gnus-method-equal from-method to-method))) + (gnus-request-move-article + article ; Article to move + gnus-newsgroup-name ; From newsgroup + (nth 1 (gnus-find-method-for-group + gnus-newsgroup-name)) ; Server + (list 'gnus-request-accept-article + to-newsgroup (list 'quote select-method) + (not articles) t) ; Accept form + (not articles) ; Only save nov last time + move-is-internal))) ; is this move internal? ;; Copy the article. ((eq action 'copy) (save-excursion (set-buffer copy-buf) (when (gnus-request-article-this-buffer article gnus-newsgroup-name) + (save-restriction + (nnheader-narrow-to-headers) + (dolist (hdr gnus-copy-article-ignored-headers) + (message-remove-header hdr t))) (gnus-request-accept-article to-newsgroup select-method (not articles) t)))) ;; Crosspost the article. @@ -9259,9 +9673,7 @@ (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) - (entry - (gnus-gethash pto-group gnus-newsrc-hashtb)) - (info (nth 2 entry)) + (info (gnus-get-info pto-group)) (to-group (gnus-info-group info)) to-marks) ;; Update the group that has been moved to. @@ -9353,7 +9765,9 @@ (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) - (gnus-summary-remove-process-mark article)) + (push article articles-to-update-marks)) + + (apply 'gnus-summary-remove-process-mark articles-to-update-marks) ;; Re-activate all groups that have been moved to. (save-excursion (set-buffer gnus-group-buffer) @@ -9629,10 +10043,10 @@ (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (let* ((article (car articles)) - (id (mail-header-id (gnus-data-header - (assoc article (gnus-data-list nil)))))) + (ghead (gnus-data-header + (assoc article (gnus-data-list nil))))) (run-hook-with-args 'gnus-summary-article-delete-hook - 'delete id gnus-newsgroup-name nil + 'delete ghead gnus-newsgroup-name nil nil)) (setq articles (cdr articles))) (when not-deleted @@ -9705,7 +10119,16 @@ (message-options message-options) (message-options-set-recipient) (mail-parse-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) + ',gnus-newsgroup-ignored-charsets) + (rfc2047-header-encoding-alist + ',(let ((charset (gnus-group-name-charset + (gnus-find-method-for-group + gnus-newsgroup-name) + gnus-newsgroup-name))) + (append (list (cons "Newsgroups" charset) + (cons "Followup-To" charset) + (cons "Xref" charset)) + rfc2047-header-encoding-alist)))) ,(if (not raw) '(progn (mml-to-mime) (mml-destroy-buffers) @@ -10013,8 +10436,7 @@ ;; (article-number . line-number-in-body). (push (cons article - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (count-lines (min (point) (save-excursion @@ -10051,13 +10473,15 @@ (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) +(defun gnus-summary-remove-process-mark (&rest articles) + "Remove the process mark from ARTICLES and update the summary line." + (dolist (article articles) + (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) + (when (gnus-summary-goto-subject article) + (gnus-summary-show-thread) + (gnus-summary-goto-subject article) + (gnus-summary-update-secondary-mark article))) + t) (defun gnus-summary-set-saved-mark (article) "Set the process mark on ARTICLE and update the summary line." @@ -10258,7 +10682,7 @@ (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil)) - (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) + (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit) (when forward (when (looking-at "\r") (incf forward)) @@ -10501,9 +10925,8 @@ (goto-char (point-min)) (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) - (mapcar (lambda (x) (push (mail-header-number x) - gnus-newsgroup-limit)) - headers) + (dolist (x headers) + (push (mail-header-number x) gnus-newsgroup-limit)) (gnus-summary-prepare-unthreaded (nreverse headers)) (goto-char (point-min)) (gnus-summary-position-point) @@ -10628,6 +11051,15 @@ (gnus-summary-catchup all)) (gnus-summary-next-group)) +(defun gnus-summary-catchup-and-goto-prev-group (&optional all) + "Mark all articles in this group as read and select the previous group. +If given a prefix, mark all articles, unread as well as ticked, as +read." + (interactive "P") + (save-excursion + (gnus-summary-catchup all)) + (gnus-summary-next-group nil nil t)) + ;;; ;;; with article ;;; @@ -10720,41 +11152,51 @@ (error "The current newsgroup does not support article editing")) (unless (<= (length gnus-newsgroup-processable) 1) (error "No more than one article may be marked")) - (save-window-excursion - (let ((gnus-article-buffer " *reparent*") - (current-article (gnus-summary-article-number)) - ;; First grab the marked article, otherwise one line up. - (parent-article (if (not (null gnus-newsgroup-processable)) - (car gnus-newsgroup-processable) - (save-excursion - (if (eq (forward-line -1) 0) - (gnus-summary-article-number) - (error "Beginning of summary buffer")))))) - (unless (not (eq current-article parent-article)) - (error "An article may not be self-referential")) - (let ((message-id (mail-header-id - (gnus-summary-article-header parent-article)))) - (unless (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent")) - (gnus-with-article current-article - (save-restriction - (goto-char (point-min)) - (message-narrow-to-head) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")))) - (set-buffer gnus-summary-buffer) - (gnus-summary-unmark-all-processable) - (gnus-summary-update-article current-article) - (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (let ((child (gnus-summary-article-number)) + ;; First grab the marked article, otherwise one line up. + (parent (if (not (null gnus-newsgroup-processable)) + (car gnus-newsgroup-processable) + (save-excursion + (if (eq (forward-line -1) 0) + (gnus-summary-article-number) + (error "Beginning of summary buffer")))))) + (gnus-summary-reparent-children parent (list child)))) + +(defun gnus-summary-reparent-children (parent children) + "Make PARENT the parent of CHILDREN. +When called interactively, PARENT is the current article and CHILDREN +are the process-marked articles." + (interactive + (list (gnus-summary-article-number) + (gnus-summary-work-articles nil))) + (dolist (child children) + (save-window-excursion + (let ((gnus-article-buffer " *reparent*")) + (unless (not (eq parent child)) + (error "An article may not be self-referential")) + (let ((message-id (mail-header-id + (gnus-summary-article-header parent)))) + (unless (and message-id (not (equal message-id ""))) + (error "No message-id in desired parent")) + (gnus-with-article child + (save-restriction + (goto-char (point-min)) + (message-narrow-to-head) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n")))) + (set-buffer gnus-summary-buffer) + (gnus-summary-unmark-all-processable) + (gnus-summary-update-article child) + (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t) (gnus-summary-update-secondary-mark (cdr gnus-article-current))) - (gnus-summary-rethread-current) - (gnus-message 3 "Article %d is now the child of article %d" - current-article parent-article))))) + (gnus-summary-rethread-current) + (gnus-message 3 "Article %d is now the child of article %d" + child parent)))))) (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. @@ -10783,7 +11225,7 @@ (interactive) (let ((buffer-read-only nil) (orig (point)) - (end (gnus-point-at-eol)) + (end (point-at-eol)) ;; Leave point at bol (beg (progn (beginning-of-line) (point)))) (prog1 @@ -10947,14 +11389,21 @@ (while (gnus-summary-go-up-thread)) (gnus-summary-article-number)) +(defun gnus-summary-expire-thread () + "Mark articles under current thread as expired." + (interactive) + (gnus-summary-kill-thread 0)) + (defun gnus-summary-kill-thread (&optional unmark) "Mark articles under current thread as read. If the prefix argument is positive, remove any kinds of marks. +If the prefix argument is zero, mark thread as expired. If the prefix argument is negative, tick articles instead." (interactive "P") (when unmark (setq unmark (prefix-numeric-value unmark))) - (let ((articles (gnus-summary-articles-in-thread))) + (let ((articles (gnus-summary-articles-in-thread)) + (hide (or (null unmark) (= unmark 0)))) (save-excursion ;; Expand the thread. (gnus-summary-show-thread) @@ -10965,15 +11414,17 @@ (gnus-summary-mark-article-as-read gnus-killed-mark)) ((> unmark 0) (gnus-summary-mark-article-as-unread gnus-unread-mark)) + ((= unmark 0) + (gnus-summary-mark-article-as-unread gnus-expirable-mark)) (t (gnus-summary-mark-article-as-unread gnus-ticked-mark))) (setq articles (cdr articles)))) - ;; Hide killed subtrees. - (and (null unmark) + ;; Hide killed subtrees when hide is true. + (and hide gnus-thread-hide-killed (gnus-summary-hide-thread)) - ;; If marked as read, go to next unread subject. - (when (null unmark) + ;; If hide is t, go to next unread subject. + (when hide ;; Go to next unread subject. (gnus-summary-next-subject 1 t))) (gnus-set-mode-line 'summary)) @@ -10999,6 +11450,13 @@ (interactive "P") (gnus-summary-sort 'author reverse)) +(defun gnus-summary-sort-by-recipient (&optional reverse) + "Sort the summary buffer by recipient name alphabetically. +If `case-fold-search' is non-nil, case of letters is ignored. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-sort 'recipient reverse)) + (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. If `case-fold-search' is non-nil, case of letters is ignored. @@ -11287,46 +11745,51 @@ (format "these %d articles" (length articles)) "this article"))) (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read-with-default - default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read-with-default - (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) - (t - (gnus-completing-read-with-default - nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history)))) - (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) + (let (active group) + (when (or (null split-name) (= 1 (length split-name))) + (setq active (gnus-make-hashtable (length gnus-active-hashtb))) + (mapatoms (lambda (symbol) + (setq group (symbol-name symbol)) + (when (string-match "[^\000-\177]" group) + (setq group (gnus-group-decoded-name group))) + (set (intern group active) group)) + gnus-active-hashtb)) + (cond + ((null split-name) + (gnus-completing-read-with-default + default prom active 'gnus-valid-move-group-p nil prefix + 'gnus-group-history)) + ((= 1 (length split-name)) + (gnus-completing-read-with-default + (car split-name) prom active 'gnus-valid-move-group-p nil nil + 'gnus-group-history)) + (t + (gnus-completing-read-with-default + nil prom (mapcar 'list (nreverse split-name)) nil nil nil + 'gnus-group-history))))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) + encoded) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) (setq to-newsgroup default)) (unless to-newsgroup (error "No group name entered")) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup nil nil to-method) + (setq encoded (mm-encode-coding-string + to-newsgroup + (gnus-group-name-charset to-method to-newsgroup))) + (or (gnus-active encoded) + (gnus-activate-group encoded nil nil to-method) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group to-newsgroup to-method) - (gnus-activate-group - to-newsgroup nil nil to-method) - (gnus-subscribe-group to-newsgroup)) + (or (and (gnus-request-create-group encoded to-method) + (gnus-activate-group encoded nil nil to-method) + (gnus-subscribe-group encoded)) (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup))) - to-newsgroup)) + (error "No such group: %s" to-newsgroup)) + encoded))) + +(defvar gnus-summary-save-parts-counter) (defun gnus-summary-save-parts (type dir n &optional reverse) "Save parts matching TYPE to DIR. @@ -11350,7 +11813,8 @@ (let ((handles (or gnus-article-mime-handles (mm-dissect-buffer nil gnus-article-loose-mime) (and gnus-article-emulate-mime - (mm-uu-dissect))))) + (mm-uu-dissect)))) + (gnus-summary-save-parts-counter 1)) (when handles (gnus-summary-save-parts-1 type dir handles reverse) (unless gnus-article-mime-handles ;; Don't destroy this case. @@ -11372,10 +11836,11 @@ (mm-handle-disposition handle) 'filename) (mail-content-type-get (mm-handle-type handle) 'name) - (concat gnus-newsgroup-name - "." (number-to-string - (cdr gnus-article-current)))))) + (format "%s.%d.%d" gnus-newsgroup-name + (cdr gnus-article-current) + gnus-summary-save-parts-counter)))) dir))) + (incf gnus-summary-save-parts-counter) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -11414,7 +11879,7 @@ (lambda (f) (if (equal f " ") f - (mm-quote-arg f))) + (shell-quote-argument f))) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) @@ -11530,11 +11995,14 @@ () ; Malformed head. (unless (gnus-summary-article-sparse-p (mail-header-number header)) (when (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. + (or + (not (string= (gnus-group-real-name group) + (car where))) + (not (gnus-server-equal gnus-override-method + (gnus-group-method group))))) + ;; If we fetched by Message-ID and the article came from + ;; a different group (or server), we fudge some bogus + ;; article numbers for this article. (mail-header-set-number header gnus-reffed-article-number)) (save-excursion (set-buffer gnus-summary-buffer) @@ -11566,8 +12034,8 @@ ;; Added by Per Abrahamsen . (when gnus-summary-selected-face (save-excursion - (let* ((beg (gnus-point-at-bol)) - (end (gnus-point-at-eol)) + (let* ((beg (point-at-bol)) + (end (point-at-eol)) ;; Fix by Mike Dugan . (from (if (get-text-property beg gnus-mouse-face-prop) beg @@ -11616,7 +12084,7 @@ (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." - (let* ((beg (gnus-point-at-bol)) + (let* ((beg (point-at-bol)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article gnus-newsgroup-scored)) @@ -11632,7 +12100,7 @@ (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) (gnus-put-text-property-excluding-characters-with-faces - beg (gnus-point-at-eol) 'face + beg (point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))))) @@ -11640,11 +12108,10 @@ (defun gnus-update-read-articles (group unread &optional compute) "Update the list of read articles in GROUP. UNREAD is a sorted list." - (let* ((active (or gnus-newsgroup-active (gnus-active group))) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (prev 1) - read) + (let ((active (or gnus-newsgroup-active (gnus-active group))) + (info (gnus-get-info group)) + (prev 1) + read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ;; killed. Gnus stores no information on killed groups, so @@ -11712,8 +12179,7 @@ (dolist (buffer (buffer-list)) (when (and (setq buffer (buffer-name buffer)) (string-match "Summary" buffer) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer ;; We check that this is, indeed, a summary buffer. (and (eq major-mode 'gnus-summary-mode) ;; Also make sure this isn't bogus. @@ -11774,7 +12240,7 @@ (insert "Mime-Version: 1.0\n") (widen) (when (search-forward "\n--" nil t) - (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) + (let ((separator (buffer-substring (point) (point-at-eol)))) (message-narrow-to-head) (message-remove-header "Content-Type") (goto-char (point-max)) @@ -11885,12 +12351,24 @@ (when gnus-suppress-duplicates (gnus-dup-suppress-articles)) - ;; We might want to build some more threads first. - (when (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov)) - (if (eq gnus-fetch-old-headers 'invisible) - (gnus-build-all-threads) - (gnus-build-old-threads))) + (if (and gnus-fetch-old-headers + (eq gnus-headers-retrieved-by 'nov)) + ;; We might want to build some more threads first. + (if (eq gnus-fetch-old-headers 'invisible) + (gnus-build-all-threads) + (gnus-build-old-threads)) + ;; Mark the inserted articles that are unread as unread. + (setq gnus-newsgroup-unreads + (gnus-sorted-nunion + gnus-newsgroup-unreads + (gnus-sorted-nintersection + (gnus-list-of-unread-articles gnus-newsgroup-name) + articles))) + ;; Mark the inserted articles as selected so that the information + ;; of the marks having been changed by a user may be updated when + ;; exiting this group. See `gnus-summary-update-info'. + (dolist (art articles) + (setq gnus-newsgroup-unselected (delq art gnus-newsgroup-unselected)))) ;; Let the Gnus agent mark articles as read. (when gnus-agent (gnus-agent-get-undownloaded-list)) @@ -11950,8 +12428,7 @@ (read-string (format "How many articles from %s (%s %d): " - (gnus-limit-string - (gnus-group-decoded-name gnus-newsgroup-name) 35) + (gnus-group-decoded-name gnus-newsgroup-name) (if initial "max" "default") len) (if initial @@ -11994,7 +12471,7 @@ (push i new) (decf i)) (if (not new) - (message "No gnus is bad news.") + (message "No gnus is bad news") (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads (gnus-sorted-nunion gnus-newsgroup-unreads new)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-topic.el --- a/lisp/gnus/gnus-topic.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-topic.el Sun Oct 28 09:18:39 2007 +0000 @@ -105,16 +105,16 @@ (defun gnus-group-topic-name () "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) + (let ((topic (get-text-property (point-at-bol) 'gnus-topic))) (and topic (symbol-name topic)))) (defun gnus-group-topic-level () "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) + (get-text-property (point-at-bol) 'gnus-topic-level)) (defun gnus-group-topic-unread () "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) + (get-text-property (point-at-bol) 'gnus-topic-unread)) (defun gnus-topic-unread (topic) "Return the number of unread articles in TOPIC." @@ -127,7 +127,7 @@ (defun gnus-topic-visible-p () "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) + (get-text-property (point-at-bol) 'gnus-topic-visible)) (defun gnus-topic-articles-in-topic (entries) (let ((total 0) @@ -167,9 +167,11 @@ (list (completing-read "Go to topic: " (mapcar 'list (gnus-topic-list)) nil t))) - (dolist (topic (gnus-current-topics topic)) - (gnus-topic-goto-topic topic) - (gnus-topic-fold t)) + (let ((buffer-read-only nil)) + (dolist (topic (gnus-current-topics topic)) + (unless (gnus-topic-goto-topic topic) + (gnus-topic-goto-missing-topic topic) + (gnus-topic-display-missing-topic topic)))) (gnus-topic-goto-topic topic)) (defun gnus-current-topic () @@ -196,9 +198,7 @@ (defun gnus-group-active-topic-p () "Say whether the current topic comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) + (get-text-property (point-at-bol) 'gnus-active)) (defun gnus-topic-find-groups (topic &optional level all lowest recursive) "Return entries for all visible groups in TOPIC. @@ -210,7 +210,7 @@ ;; We go through the newsrc to look for matches. (while groups (when (setq group (pop groups)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb) + (setq entry (gnus-group-entry group) info (nth 2 entry) params (gnus-info-params info) active (gnus-active group) @@ -244,13 +244,12 @@ (when recursive (if (eq recursive t) (setq recursive (cdr (gnus-topic-find-topology topic)))) - (mapcar (lambda (topic-topology) - (setq visible-groups - (nconc visible-groups - (gnus-topic-find-groups - (caar topic-topology) - level all lowest topic-topology)))) - (cdr recursive))) + (dolist (topic-topology (cdr recursive)) + (setq visible-groups + (nconc visible-groups + (gnus-topic-find-groups + (caar topic-topology) + level all lowest topic-topology))))) visible-groups)) (defun gnus-topic-goto-previous-topic (n) @@ -351,7 +350,7 @@ (setq topology gnus-topic-topology gnus-tmp-topics nil)) (push (caar topology) gnus-tmp-topics) - (mapcar 'gnus-topic-list (cdr topology)) + (mapc 'gnus-topic-list (cdr topology)) gnus-tmp-topics) ;;; Topic parameter jazz @@ -378,39 +377,50 @@ (format "(gnus-topic-set-parameters %S '%S)" topic parameters)))) (defun gnus-group-topic-parameters (group) - "Compute the group parameters for GROUP taking into account inheritance from topics." + "Compute the group parameters for GROUP in topic mode. +Possibly inherit parameters from topics above GROUP." (let ((params-list (copy-sequence (gnus-group-get-parameter group)))) (save-excursion - (nconc params-list - (gnus-topic-hierarchical-parameters - ;; First we try to go to the group within the group - ;; buffer and find the topic for the group that way. - ;; This hopefully copes well with groups that are in - ;; more than one topic. Failing that (i.e. when the - ;; group isn't visible in the group buffer) we find a - ;; topic for the group via gnus-group-topic. - (or (and (gnus-group-goto-group group) - (gnus-current-topic)) - (gnus-group-topic group))))))) + (gnus-topic-hierarchical-parameters + ;; First we try to go to the group within the group buffer and find the + ;; topic for the group that way. This hopefully copes well with groups + ;; that are in more than one topic. Failing that (i.e. when the group + ;; isn't visible in the group buffer) we find a topic for the group via + ;; gnus-group-topic. + (or (and (gnus-group-goto-group group) + (gnus-current-topic)) + (gnus-group-topic group)) + params-list)))) -(defun gnus-topic-hierarchical-parameters (topic) - "Return a topic list computed for TOPIC." - (let ((topics (gnus-current-topics topic)) - params-list param out params) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) +(defun gnus-topic-hierarchical-parameters (topic &optional group-params-list) + "Compute the topic parameters for TOPIC. +Possibly inherit parameters from topics above TOPIC. +If optional argument GROUP-PARAMS-LIST is non-nil, use it as the basis for +inheritance." + (let ((params-list + ;; We probably have lots of nil elements here, so we remove them. + ;; Probably faster than doing this "properly". + (delq nil (cons group-params-list + (mapcar 'gnus-topic-parameters + (gnus-current-topics topic))))) + param out params) ;; Now we have all the parameters, so we go through them ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (gnus-pull (car param) out) - (push param out))) + (let (posting-style) + (while (setq params (pop params-list)) + (while (setq param (pop params)) + (when (atom param) + (setq param (cons param t))) + (cond ((eq (car param) 'posting-style) + (let ((param (cdr param)) + elt) + (while (setq elt (pop param)) + (unless (assoc (car elt) posting-style) + (push elt posting-style))))) + (t + (unless (assq (car param) out) + (push param out)))))) + (and posting-style (push (cons 'posting-style posting-style) out))) ;; Return the resulting parameter list. out)) @@ -465,7 +475,7 @@ (gnus-make-hashtable-from-killed)) (gnus-group-prepare-flat-list-dead (gnus-remove-if (lambda (group) - (or (gnus-gethash group gnus-newsrc-hashtb) + (or (gnus-group-entry group) (gnus-gethash group gnus-killed-hashtb))) not-in-list) gnus-level-killed ?K regexp))) @@ -727,6 +737,9 @@ (not (gnus-topic-goto-missing-topic (caadr parent)))) (gnus-topic-display-missing-topic (caadr parent)))) (gnus-topic-goto-missing-topic topic) + ;; Skip past all groups in the topic we're in. + (while (gnus-group-group-name) + (forward-line 1)) (let* ((top (gnus-topic-find-topology topic)) (children (cddr top)) (type (cadr top)) @@ -848,8 +861,7 @@ (pop topics))) ;; Go through all living groups and make sure that ;; they belong to some topic. - (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) - gnus-topic-alist))) + (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist))) (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) (newsrc (cdr gnus-newsrc-alist)) group) @@ -863,7 +875,7 @@ (while (setq topic (pop alist)) (while (cdr topic) (if (and (cadr topic) - (gnus-gethash (cadr topic) gnus-newsrc-hashtb)) + (gnus-group-entry (cadr topic))) (setq topic (cdr topic)) (setcdr topic (cddr topic))))))) @@ -893,7 +905,7 @@ (let ((topic-name (pop topic)) group filtered-topic) (while (setq group (pop topic)) - (when (and (or (gnus-gethash group gnus-active-hashtb) + (when (and (or (gnus-active group) (gnus-info-method (gnus-get-info group))) (not (gnus-gethash group gnus-killed-hashtb))) (push group filtered-topic))) @@ -1142,7 +1154,7 @@ (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) + (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) (set (make-local-variable 'gnus-group-prepare-function) 'gnus-group-prepare-topics) @@ -1297,15 +1309,13 @@ entry) (if (and (not groups) (not copyp) start-topic) (gnus-topic-move start-topic topic) - (mapcar - (lambda (g) - (gnus-group-remove-mark g use-marked) - (when (and - (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) + (dolist (g groups) + (gnus-group-remove-mark g use-marked) + (when (and + (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) + (not copyp)) + (setcdr entry (gnus-delete-first g (cdr entry)))) + (nconc topicl (list g))) (gnus-topic-enter-dribble) (if start-group (gnus-group-goto-group start-group) @@ -1318,7 +1328,7 @@ (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) - (mapcar + (mapc (lambda (group) (gnus-group-remove-mark group use-marked) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) @@ -1735,9 +1745,7 @@ (if (gnus-topic-find-topology to current-top 0);; Don't care the level (error "Can't move `%s' to its sub-level" current)) (gnus-topic-find-topology current nil nil 'delete) - (while (cdr to-top) - (setq to-top (cdr to-top))) - (setcdr to-top (list current-top)) + (setcdr (last to-top) (list current-top)) (gnus-topic-enter-dribble) (gnus-group-list-groups) (gnus-topic-goto-topic current))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-undo.el --- a/lisp/gnus/gnus-undo.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-undo.el Sun Oct 28 09:18:39 2007 +0000 @@ -50,7 +50,6 @@ (require 'gnus-util) (require 'gnus) -(require 'custom) (defgroup gnus-undo nil "Undoing in Gnus buffers." @@ -113,7 +112,7 @@ ;; Set up the menu. (when (gnus-visual-p 'undo-menu 'menu) (gnus-undo-make-menu-bar)) - (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) + (add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) (gnus-make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'gnus-undo-boundary nil t) (gnus-run-hooks 'gnus-undo-mode-hook))) @@ -187,8 +186,7 @@ (error "Nothing further to undo")) (setq gnus-undo-actions (delq action gnus-undo-actions)) (setq gnus-undo-boundary t) - (while action - (funcall (pop action))))) + (mapc 'funcall action))) (provide 'gnus-undo) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-util.el --- a/lisp/gnus/gnus-util.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-util.el Sun Oct 28 09:18:39 2007 +0000 @@ -31,11 +31,10 @@ ;; Gnus first. ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the -;; autoloads below...] +;; autoloads and defvars below...] ;;; Code: -(require 'custom) (eval-when-compile (require 'cl) ;; Fixme: this should be a gnus variable, not nnmail-. @@ -67,7 +66,7 @@ ;; (replace-in-string "foo" "/*$" "/") ;; (replace-in-string "xe" "\\(x\\)?" "") ((fboundp 'replace-regexp-in-string) - (defun gnus-replace-in-string (string regexp newtext &optional literal) + (defun gnus-replace-in-string (string regexp newtext &optional literal) "Replace all matches for REGEXP with NEWTEXT in STRING. If LITERAL is non-nil, insert NEWTEXT literally. Return a new string containing the replacements. @@ -75,25 +74,7 @@ This is a compatibility function for different Emacsen." (replace-regexp-in-string regexp newtext string nil literal))) ((fboundp 'replace-in-string) - (defalias 'gnus-replace-in-string 'replace-in-string)) - (t - (defun gnus-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (let ((start 0) tail) - (while (string-match regexp string start) - (setq tail (- (length string) (match-end 0))) - (setq string (replace-match newtext nil literal string)) - (setq start (- (length string) tail)))) - string)))) - -;;; bring in the netrc functions as aliases -(defalias 'gnus-netrc-get 'netrc-get) -(defalias 'gnus-netrc-machine 'netrc-machine) -(defalias 'gnus-parse-netrc 'netrc-parse) + (defalias 'gnus-replace-in-string 'replace-in-string)))) (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." @@ -128,15 +109,6 @@ (set symbol nil)) symbol)) -;; Added by Geoffrey T. Dairiki . A safe way -;; to limit the length of a string. This function is necessary since -;; `(substr "abc" 0 30)' pukes with "Args out of range". -;; Fixme: Why not `truncate-string-to-width'? -(defsubst gnus-limit-string (str width) - (if (> (length str) width) - (substring str 0 width) - str)) - (defsubst gnus-goto-char (point) (and point (goto-char point))) @@ -146,16 +118,6 @@ (funcall (if (stringp buffer) 'get-buffer 'buffer-name) buffer)))) -(defalias 'gnus-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - -(defalias 'gnus-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position)) - ;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and ;; XEmacs. In Emacs we don't need to call `make-local-hook' first. ;; It's harmless, though, so the main purpose of this alias is to shut @@ -180,7 +142,7 @@ ;; Delete the current line (and the next N lines). (defmacro gnus-delete-line (&optional n) - `(delete-region (gnus-point-at-bol) + `(delete-region (point-at-bol) (progn (forward-line ,(or n 1)) (point)))) (defun gnus-byte-code (func) @@ -235,8 +197,7 @@ "Return the value of the header FIELD of current article." (save-excursion (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) + (let ((inhibit-point-motion-hooks t)) (nnheader-narrow-to-headers) (message-fetch-field field))))) @@ -248,7 +209,7 @@ (defun gnus-goto-colon () (beginning-of-line) - (let ((eol (gnus-point-at-eol))) + (let ((eol (point-at-eol))) (goto-char (or (text-property-any (point) eol 'gnus-position t) (search-forward ":" eol t) (point))))) @@ -263,12 +224,15 @@ (defun gnus-remove-text-with-property (prop) "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) + (let ((start (point-min)) + end) + (unless (get-text-property start prop) + (setq start (next-single-property-change start prop))) + (while start + (setq end (text-property-any start (point-max) prop nil)) + (delete-region start (or end (point-max))) + (setq start (when end + (next-single-property-change start prop)))))) (defun gnus-newsgroup-directory-form (newsgroup) "Make hierarchical directory name from NEWSGROUP name." @@ -501,6 +465,79 @@ :group 'gnus-start :type 'integer) +(defcustom gnus-add-timestamp-to-message nil + "Non-nil means add timestamps to messages that Gnus issues. +If it is `log', add timestamps to only the messages that go into the +\"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer). +If it is neither nil nor `log', add timestamps not only to log messages +but also to the ones displayed in the echo area." + :version "23.0" ;; No Gnus + :group 'gnus-various + :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" + (const :tag "Logged messages only" log) + (sexp :tag "All messages" + :match (lambda (widget value) value) + :value t) + (const :tag "No timestamp" nil))) + +(eval-when-compile + (defmacro gnus-message-with-timestamp-1 (format-string args) + (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time) + "." (format "%03d" (/ (nth 2 time) 1000)) "> "))) + (if (featurep 'xemacs) + `(let (str time) + (if (or (and (null ,format-string) (null ,args)) + (progn + (setq str (apply 'format ,format-string ,args)) + (zerop (length str)))) + (prog1 + (and ,format-string str) + (clear-message nil)) + (cond ((eq gnus-add-timestamp-to-message 'log) + (setq time (current-time)) + (display-message 'no-log str) + (log-message 'message (concat ,@timestamp str))) + (gnus-add-timestamp-to-message + (setq time (current-time)) + (display-message 'message (concat ,@timestamp str))) + (t + (display-message 'message str)))) + str) + `(let (str time) + (cond ((eq gnus-add-timestamp-to-message 'log) + (setq str (let (message-log-max) + (apply 'message ,format-string ,args))) + (when (and message-log-max + (> message-log-max 0) + (/= (length str) 0)) + (setq time (current-time)) + (with-current-buffer (get-buffer-create "*Messages*") + (goto-char (point-max)) + (insert ,@timestamp str "\n") + (forward-line (- message-log-max)) + (delete-region (point-min) (point)) + (goto-char (point-max)))) + str) + (gnus-add-timestamp-to-message + (if (or (and (null ,format-string) (null ,args)) + (progn + (setq str (apply 'format ,format-string ,args)) + (zerop (length str)))) + (prog1 + (and ,format-string str) + (message nil)) + (setq time (current-time)) + (message "%s" (concat ,@timestamp str)) + str)) + (t + (apply 'message ,format-string ,args)))))))) + +(defun gnus-message-with-timestamp (format-string &rest args) + "Display message with timestamp. Arguments are the same as `message'. +The `gnus-add-timestamp-to-message' variable controls how to add +timestamp to message." + (gnus-message-with-timestamp-1 format-string args)) + (defun gnus-message (level &rest args) "If LEVEL is lower than `gnus-verbose' print ARGS using `message'. @@ -509,7 +546,9 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages inside loops." (if (<= level gnus-verbose) - (apply 'message args) + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)) ;; We have to do this format thingy here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. @@ -530,12 +569,23 @@ (defun gnus-split-references (references) "Return a list of Message-IDs in REFERENCES." (let ((beg 0) + (references (or references "")) ids) (while (string-match "<[^<]+[^< \t]" references beg) (push (substring references (match-beginning 0) (setq beg (match-end 0))) ids)) (nreverse ids))) +(defun gnus-extract-references (references) + "Return a list of Message-IDs in REFERENCES (in In-Reply-To + format), trimmed to only contain the Message-IDs." + (let ((ids (gnus-split-references references)) + refs) + (dolist (id ids) + (when (string-match "<[^<>]+>" id) + (push (match-string 0 id) refs))) + refs)) + (defsubst gnus-parent-id (references &optional n) "Return the last Message-ID in REFERENCES. If N, return the Nth ancestor instead." @@ -709,11 +759,11 @@ `print-level' to nil. See also `gnus-bind-print-variables'." (gnus-bind-print-variables (prin1-to-string form))) -(defun gnus-pp (form) +(defun gnus-pp (form &optional stream) "Use `pp' on FORM in the current buffer. Bind `print-quoted' and `print-readably' to t, and `print-length' and `print-level' to nil. See also `gnus-bind-print-variables'." - (gnus-bind-print-variables (pp form (current-buffer)))) + (gnus-bind-print-variables (pp form (or stream (current-buffer))))) (defun gnus-pp-to-string (form) "The same as `pp-to-string'. @@ -732,9 +782,9 @@ (defun gnus-write-buffer (file) "Write the current buffer's contents to FILE." - ;; Make sure the directory exists. - (gnus-make-directory (file-name-directory file)) (let ((file-name-coding-system nnmail-pathname-coding-system)) + ;; Make sure the directory exists. + (gnus-make-directory (file-name-directory file)) ;; Write the buffer. (write-region (point-min) (point-max) file nil 'quietly))) @@ -1149,8 +1199,12 @@ t)) (defun gnus-write-active-file (file hashtb &optional full-names) + ;; `coding-system-for-write' should be `raw-text' or equivalent. (let ((coding-system-for-write nnmail-active-file-coding-system)) (with-temp-file file + ;; The buffer should be in the unibyte mode because group names + ;; are ASCII text or encoded non-ASCII text (i.e., unibyte). + (mm-disable-multibyte) (mapatoms (lambda (sym) (when (and sym @@ -1236,6 +1290,13 @@ (remove-text-properties start end properties object)) t)) +(defun gnus-string-remove-all-properties (string) + (condition-case () + (let ((s string)) + (set-text-properties 0 (length string) nil string) + s) + (error string))) + ;; This might use `compare-strings' to reduce consing in the ;; case-insensitive case, but it has to cope with null args. ;; (`string-equal' uses symbol print names.) @@ -1350,32 +1411,12 @@ `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) -(defun gnus-local-map-property (map) - "Return a list suitable for a text property list specifying keymap MAP." - (cond - ((featurep 'xemacs) - (list 'keymap map)) - ((>= emacs-major-version 21) - (list 'keymap map)) - (t - (list 'local-map map)))) - -(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate - require-match initial-contents - history default) - "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen." - `(completing-read ,prompt ,table ,predicate ,require-match - ,initial-contents ,history - ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2)) - () - (list default)))) - (defun gnus-completing-read (prompt table &optional predicate require-match history) (when (and history (not (boundp history))) (set history nil)) - (gnus-completing-read-maybe-default + (completing-read (if (symbol-value history) (concat prompt " (" (car (symbol-value history)) "): ") (concat prompt ": ")) @@ -1616,13 +1657,16 @@ ((or (featurep 'sxemacs) (featurep 'xemacs)) ;; XEmacs or SXEmacs: (concat emacsname "/" emacs-program-version - " (" - (when (and (memq 'codename lst) - codename) - (concat codename - (when system-v ", "))) - (when system-v system-v) - ")")) + (let (plst) + (when (memq 'codename lst) + (push codename plst)) + (when system-v + (push system-v plst)) + (unless (featurep 'mule) + (push "no MULE" plst)) + (when (> (length plst) 0) + (concat + " (" (mapconcat 'identity (reverse plst) ", ") ")"))))) (t emacs-version)))) (defun gnus-rename-file (old-path new-path &optional trim) @@ -1646,6 +1690,11 @@ (file-truename (concat old-dir ".."))))))))) +(defun gnus-set-file-modes (filename mode) + "Wrapper for set-file-modes." + (ignore-errors + (set-file-modes filename mode))) + (if (fboundp 'set-process-query-on-exit-flag) (defalias 'gnus-set-process-query-on-exit-flag 'set-process-query-on-exit-flag) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-uu.el --- a/lisp/gnus/gnus-uu.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-uu.el Sun Oct 28 09:18:39 2007 +0000 @@ -393,7 +393,7 @@ (list current-prefix-arg (read-file-name (if gnus-uu-save-separate-articles - "Save articles is dir: " + "Save articles in dir: " "Save articles in file: ") gnus-uu-default-dir gnus-uu-default-dir))) @@ -482,11 +482,24 @@ (setq message-forward-as-mime (not message-forward-as-mime) n nil)) (let ((gnus-article-reply (gnus-summary-work-articles n))) + (when (and (not n) + (= (length gnus-article-reply) 1)) + ;; The case where neither a number of articles nor a region is + ;; specified. + (gnus-summary-top-thread) + (setq gnus-article-reply (nreverse (gnus-uu-find-articles-matching)))) (gnus-setup-message 'forward (setq gnus-uu-digest-from-subject nil) (setq gnus-uu-digest-buffer (gnus-get-buffer-create " *gnus-uu-forward*")) - (gnus-uu-decode-save n file) + ;; Specify articles to be forwarded. Note that they should be + ;; reversed; see `gnus-uu-get-list-of-articles'. + (let ((gnus-newsgroup-processable (reverse gnus-article-reply))) + (gnus-uu-decode-save n file) + (setq gnus-article-reply gnus-newsgroup-processable)) + ;; Restore the value of `gnus-newsgroup-processable' to which + ;; it should be set when it is not `let'-bound. + (setq gnus-newsgroup-processable (reverse gnus-article-reply)) (switch-to-buffer gnus-uu-digest-buffer) (let ((fs gnus-uu-digest-from-subject)) (when fs @@ -511,11 +524,11 @@ "Various")))) (goto-char (point-min)) (when (re-search-forward "^Subject: ") - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) (insert subject)) (goto-char (point-min)) (when (re-search-forward "^From:") - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) (insert " " from)) (let ((message-forward-decoded-p t)) (message-forward post t)))) @@ -530,19 +543,19 @@ (defun gnus-message-process-mark (unmarkp new-marked) (let ((old (- (length gnus-newsgroup-processable) (length new-marked)))) - (message "%d mark%s %s%s" - (length new-marked) - (if (= (length new-marked) 1) "" "s") - (if unmarkp "removed" "added") - (cond - ((and (zerop old) - (not unmarkp)) - "") - (unmarkp - (format ", %d remain marked" - (length gnus-newsgroup-processable))) - (t - (format ", %d already marked" old)))))) + (gnus-message 6 "%d mark%s %s%s" + (length new-marked) + (if (= (length new-marked) 1) "" "s") + (if unmarkp "removed" "added") + (cond + ((and (zerop old) + (not unmarkp)) + "") + (unmarkp + (format ", %d remain marked" + (length gnus-newsgroup-processable))) + (t + (format ", %d already marked" old)))))) (defun gnus-new-processable (unmarkp articles) (if unmarkp @@ -570,16 +583,18 @@ (interactive "sUnmark (regexp): ") (gnus-uu-mark-by-regexp regexp t)) -(defun gnus-uu-mark-series () +(defun gnus-uu-mark-series (&optional silent) "Mark the current series with the process mark." (interactive) (let* ((articles (gnus-uu-find-articles-matching)) - (l (length articles))) + (l (length articles))) (while articles (gnus-summary-set-process-mark (car articles)) (setq articles (cdr articles))) - (message "Marked %d articles" l)) - (gnus-summary-position-point)) + (unless silent + (gnus-message 6 "Marked %d articles" l)) + (gnus-summary-position-point) + l)) (defun gnus-uu-mark-region (beg end &optional unmark) "Set the process mark on all articles between point and mark." @@ -687,14 +702,16 @@ (setq gnus-newsgroup-processable nil) (save-excursion (let ((data gnus-newsgroup-data) + (count 0) number) (while data (when (and (not (memq (setq number (gnus-data-number (car data))) gnus-newsgroup-processable)) (vectorp (gnus-data-header (car data)))) (gnus-summary-goto-subject number) - (gnus-uu-mark-series)) - (setq data (cdr data))))) + (setq count (+ count (gnus-uu-mark-series t)))) + (setq data (cdr data))) + (gnus-message 6 "Marked %d articles" count))) (gnus-summary-position-point)) ;; All PostScript functions written by Erik Selberg . @@ -852,7 +869,7 @@ (save-restriction (set-buffer buffer) (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) (put-text-property (point-min) (point-max) 'intangible nil)) @@ -862,7 +879,7 @@ (mm-enable-multibyte) (mime-to-mml)) (goto-char (point-min)) - (re-search-forward "\n\n") + (search-forward "\n\n") (unless (and message-forward-as-mime gnus-uu-digest-buffer) ;; Quote all 30-dash lines. (save-excursion @@ -1153,7 +1170,7 @@ ;; Expand numbers, sort, and return the list of article ;; numbers. - (mapcar (lambda (sub) (cdr sub)) + (mapcar 'cdr (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) @@ -1406,7 +1423,7 @@ (setq part (match-string 0 subject)) (setq subject (substring subject (match-end 0))))) (or part - (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject) + (while (string-match "[0-9]+[^0-9]+[0-9]+" subject) (setq part (match-string 0 subject)) (setq subject (substring subject (match-end 0))))) (or part ""))) @@ -1708,8 +1725,7 @@ (defun gnus-uu-check-correct-stripped-uucode (start end) (save-excursion (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () + (unless gnus-uu-correct-stripped-uucode (goto-char start) (if (re-search-forward " \\|`" end t) @@ -1722,19 +1738,15 @@ (forward-line 1)))) (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () + (unless (looking-at (concat gnus-uu-begin-string "\\|" + gnus-uu-end-string)) (when (not found) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg))) + (setq length (- (point-at-eol) (point-at-bol)))) (setq found t) (beginning-of-line) (setq beg (point)) (end-of-line) - (when (not (= length (- (point) beg))) + (unless (= length (- (point) beg)) (insert (make-string (- length (- (point) beg)) ? )))) (forward-line 1))))))) @@ -1759,7 +1771,7 @@ (setq gnus-uu-work-dir (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) - (set-file-modes gnus-uu-work-dir 448) + (gnus-set-file-modes gnus-uu-work-dir 448) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) gnus-uu-tmp-alist)))) @@ -1779,7 +1791,7 @@ ;; that the filename will be treated as a single argument when the shell ;; executes the command. (defun gnus-uu-command (action file) - (let ((quoted-file (mm-quote-arg file))) + (let ((quoted-file (shell-quote-argument file))) (if (string-match "%s" action) (format action quoted-file) (concat action " " quoted-file)))) @@ -1903,7 +1915,7 @@ (when (gnus-uu-post-encode-file "uuencode" path file-name) (goto-char (point-min)) (forward-line 1) - (while (re-search-forward " " nil t) + (while (search-forward " " nil t) (replace-match "`")) t)) @@ -2034,8 +2046,7 @@ (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring (point-min) (point))) + (setq header (buffer-substring (point-min) (point-at-bol))) (goto-char (point-min)) (when gnus-uu-post-separate-description @@ -2111,8 +2122,7 @@ (when (not gnus-uu-post-separate-description) (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) + (bury-buffer)))) (provide 'gnus-uu) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus-win.el --- a/lisp/gnus/gnus-win.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus-win.el Sun Oct 28 09:18:39 2007 +0000 @@ -120,6 +120,10 @@ (vertical 1.0 (summary 0.25) (edit-score 1.0 point))) + (edit-server + (vertical 1.0 + (server 0.5) + (edit-form 1.0 point))) (post (vertical 1.0 (post 1.0 point))) @@ -166,8 +170,12 @@ (article 0.5) (message 1.0 point))) (display-term - (vertical 1.0 - ("*display*" 1.0)))) + (vertical 1.0 + ("*display*" 1.0))) + (mml-preview + (vertical 1.0 + (message 0.5) + (mml-preview 1.0 point)))) "Window configuration for all possible Gnus buffers. See the Gnus manual for an explanation of the syntax used.") @@ -195,7 +203,8 @@ (info . gnus-info-buffer) (category . gnus-category-buffer) (article-copy . gnus-article-copy) - (draft . gnus-draft-buffer)) + (draft . gnus-draft-buffer) + (mml-preview . mml-preview-buffer)) "Mapping from short symbols to buffer names or buffer variables.") (defcustom gnus-configure-windows-hook nil diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/gnus.el --- a/lisp/gnus/gnus.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/gnus.el Sun Oct 28 09:18:39 2007 +0000 @@ -289,10 +289,10 @@ :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.11" +(defconst gnus-version-number "0.7" "Version number for this version of Gnus.") -(defconst gnus-version (format "Gnus v%s" gnus-version-number) +(defconst gnus-version (format "No Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil @@ -310,9 +310,6 @@ (unless (fboundp 'gnus-group-remove-excess-properties) (defalias 'gnus-group-remove-excess-properties 'ignore)) -(unless (fboundp 'gnus-set-text-properties) - (defalias 'gnus-set-text-properties 'set-text-properties)) - (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) @@ -323,7 +320,6 @@ (defalias 'gnus-overlay-end 'overlay-end) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) (defalias 'gnus-character-to-event 'identity) (defalias 'gnus-assq-delete-all 'assq-delete-all) @@ -563,7 +559,7 @@ (defface gnus-group-mail-1 '((((class color) (background dark)) - (:foreground "aquamarine1" :bold t)) + (:foreground "#e1ffe1" :bold t)) (((class color) (background light)) (:foreground "DeepPink3" :bold t)) @@ -577,7 +573,7 @@ (defface gnus-group-mail-1-empty '((((class color) (background dark)) - (:foreground "aquamarine1")) + (:foreground "#e1ffe1")) (((class color) (background light)) (:foreground "DeepPink3")) @@ -591,7 +587,7 @@ (defface gnus-group-mail-2 '((((class color) (background dark)) - (:foreground "aquamarine2" :bold t)) + (:foreground "DarkSeaGreen1" :bold t)) (((class color) (background light)) (:foreground "HotPink3" :bold t)) @@ -605,7 +601,7 @@ (defface gnus-group-mail-2-empty '((((class color) (background dark)) - (:foreground "aquamarine2")) + (:foreground "DarkSeaGreen1")) (((class color) (background light)) (:foreground "HotPink3")) @@ -619,7 +615,7 @@ (defface gnus-group-mail-3 '((((class color) (background dark)) - (:foreground "aquamarine3" :bold t)) + (:foreground "aquamarine1" :bold t)) (((class color) (background light)) (:foreground "magenta4" :bold t)) @@ -633,7 +629,7 @@ (defface gnus-group-mail-3-empty '((((class color) (background dark)) - (:foreground "aquamarine3")) + (:foreground "aquamarine1")) (((class color) (background light)) (:foreground "magenta4")) @@ -647,7 +643,7 @@ (defface gnus-group-mail-low '((((class color) (background dark)) - (:foreground "aquamarine4" :bold t)) + (:foreground "aquamarine2" :bold t)) (((class color) (background light)) (:foreground "DeepPink4" :bold t)) @@ -661,7 +657,7 @@ (defface gnus-group-mail-low-empty '((((class color) (background dark)) - (:foreground "aquamarine4")) + (:foreground "aquamarine2")) (((class color) (background light)) (:foreground "DeepPink4")) @@ -923,7 +919,7 @@ (defface gnus-splash '((((class color) (background dark)) - (:foreground "#888888")) + (:foreground "#cccccc")) (((class color) (background light)) (:foreground "#888888")) @@ -978,12 +974,12 @@ (storm "#666699" "#99ccff") (pdino "#9999cc" "#99ccff") (purp "#9999cc" "#666699") - (no "#000000" "#ff0000") + (no "#ff0000" "#ffff00") (neutral "#b4b4b4" "#878787") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") -(defcustom gnus-logo-color-style 'oort +(defcustom gnus-logo-color-style 'no "*Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) @@ -1034,23 +1030,23 @@ (t (insert (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ " "")) @@ -1294,12 +1290,30 @@ (defcustom gnus-message-archive-method "archive" "*Method used for archiving messages you've sent. -This should be a mail method." +This should be a mail method. + +See also `gnus-update-message-archive-method'." :group 'gnus-server :group 'gnus-message :type '(choice (const :tag "Default archive method" "archive") gnus-select-method)) +(defcustom gnus-update-message-archive-method nil + "Non-nil means always update the saved \"archive\" method. + +The archive method is initially set according to the value of +`gnus-message-archive-method' and is saved in the \"~/.newsrc.eld\" file +so that it may be used as a real method of the server which is named +\"archive\" ever since. If it once has been saved, it will never be +updated if the value of this variable is nil, even if you change the +value of `gnus-message-archive-method' afterward. If you want the +saved \"archive\" method to be updated whenever you change the value of +`gnus-message-archive-method', set this variable to a non-nil value." + :version "23.0" ;; No Gnus + :group 'gnus-server + :group 'gnus-message + :type 'boolean) + (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. This can either be a string; a list of strings; or an alist @@ -1566,11 +1580,6 @@ :group 'gnus-meta :type 'boolean) -(defcustom gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings." - :group 'gnus-meta - :type 'boolean) - (defcustom gnus-keep-backlog 20 "*If non-nil, Gnus will keep read articles for later re-retrieval. If it is a number N, then Gnus will only keep the last N articles @@ -2007,6 +2016,42 @@ spam. There is other behavior associated with ham and no classification when spam.el is loaded - see the manual.") + (gnus-define-group-parameter + spam-resend-to + :type list + :function-document + "The address to get spam resent (through spam-report-resend)." + :variable gnus-spam-resend-to + :variable-default nil + :variable-document + "The address to get spam resent (through spam-report-resend)." + :variable-group spam + :variable-type '(repeat + (list :tag "Group address for resending spam" + (regexp :tag "Group") + (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"))) + :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)" + :parameter-document + "The address to get spam resent (through spam-report-resend).") + + (gnus-define-group-parameter + ham-resend-to + :type list + :function-document + "The address to get ham resent (through spam-report-resend)." + :variable gnus-ham-resend-to + :variable-default nil + :variable-document + "The address to get ham resent (through spam-report-resend)." + :variable-group spam + :variable-type '(repeat + (list :tag "Group address for resending ham" + (regexp :tag "Group") + (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"))) + :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)" + :parameter-document + "The address to get ham resent (through spam-report-resend).") + (defvar gnus-group-spam-exit-processor-ifile "ifile" "OBSOLETE: The ifile summary exit spam processor.") @@ -2063,6 +2108,27 @@ :value nil (list :tag "Spam Summary Exit Processor Choices" (set + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Resend Message"(spam spam-use-resend)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin)) + (const :tag "Spam: CRM114" (spam spam-use-crm114)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Resend Message" (ham spam-use-resend)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) + (const :tag "Ham: CRM114" (ham spam-use-crm114)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) (variable-item gnus-group-spam-exit-processor-ifile) (variable-item gnus-group-spam-exit-processor-stat) (variable-item gnus-group-spam-exit-processor-bogofilter) @@ -2075,20 +2141,7 @@ (variable-item gnus-group-ham-exit-processor-whitelist) (variable-item gnus-group-ham-exit-processor-BBDB) (variable-item gnus-group-ham-exit-processor-spamoracle) - (variable-item gnus-group-ham-exit-processor-copy) - (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) - (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) - (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) - (const :tag "Spam: ifile" (spam spam-use-ifile)) - (const :tag "Spam: Spam-stat" (spam spam-use-stat)) - (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) - (const :tag "Ham: ifile" (ham spam-use-ifile)) - (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) - (const :tag "Ham: Spam-stat" (ham spam-use-stat)) - (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) - (const :tag "Ham: BBDB" (ham spam-use-BBDB)) - (const :tag "Ham: Copy" (ham spam-use-ham-copy)) - (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) + (variable-item gnus-group-ham-exit-processor-copy)))) :function-document "Which spam or ham processors will be applied when the summary is exited." :variable gnus-spam-process-newsgroups @@ -2105,6 +2158,27 @@ (regexp :tag "Group Regexp") (set :tag "Spam/Ham Summary Exit Processor" + (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) + (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) + (const :tag "Spam: Bsfilter" (spam spam-use-bsfilter)) + (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) + (const :tag "Spam: Resend Message"(spam spam-use-resend)) + (const :tag "Spam: ifile" (spam spam-use-ifile)) + (const :tag "Spam: Spam-stat" (spam spam-use-stat)) + (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) + (const :tag "Spam: SpamAssassin" (spam spam-use-spamassassin)) + (const :tag "Spam: CRM114" (spam spam-use-crm114)) + (const :tag "Ham: BBDB" (ham spam-use-BBDB)) + (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) + (const :tag "Ham: Bsfilter" (ham spam-use-bsfilter)) + (const :tag "Ham: Copy" (ham spam-use-ham-copy)) + (const :tag "Ham: Resend Message" (ham spam-use-resend)) + (const :tag "Ham: ifile" (ham spam-use-ifile)) + (const :tag "Ham: Spam-stat" (ham spam-use-stat)) + (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)) + (const :tag "Ham: SpamAssassin" (ham spam-use-spamassassin)) + (const :tag "Ham: CRM114" (ham spam-use-crm114)) + (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) (variable-item gnus-group-spam-exit-processor-ifile) (variable-item gnus-group-spam-exit-processor-stat) (variable-item gnus-group-spam-exit-processor-bogofilter) @@ -2117,20 +2191,7 @@ (variable-item gnus-group-ham-exit-processor-whitelist) (variable-item gnus-group-ham-exit-processor-BBDB) (variable-item gnus-group-ham-exit-processor-spamoracle) - (variable-item gnus-group-ham-exit-processor-copy) - (const :tag "Spam: Gmane Report" (spam spam-use-gmane)) - (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter)) - (const :tag "Spam: Blacklist" (spam spam-use-blacklist)) - (const :tag "Spam: ifile" (spam spam-use-ifile)) - (const :tag "Spam: Spam-stat" (spam spam-use-stat)) - (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle)) - (const :tag "Ham: ifile" (ham spam-use-ifile)) - (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter)) - (const :tag "Ham: Spam-stat" (ham spam-use-stat)) - (const :tag "Ham: Whitelist" (ham spam-use-whitelist)) - (const :tag "Ham: BBDB" (ham spam-use-BBDB)) - (const :tag "Ham: Copy" (ham spam-use-ham-copy)) - (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle))))) + (variable-item gnus-group-ham-exit-processor-copy)))) :parameter-document "Which spam or ham processors will be applied when the summary is exited.") @@ -2169,12 +2230,18 @@ (const default) (set :tag "Use specific methods" (variable-item spam-use-blacklist) + (variable-item spam-use-gmane-xref) (variable-item spam-use-regex-headers) (variable-item spam-use-regex-body) (variable-item spam-use-whitelist) (variable-item spam-use-BBDB) (variable-item spam-use-ifile) (variable-item spam-use-spamoracle) + (variable-item spam-use-crm114) + (variable-item spam-use-spamassassin) + (variable-item spam-use-spamassassin-headers) + (variable-item spam-use-bsfilter) + (variable-item spam-use-bsfilter-headers) (variable-item spam-use-stat) (variable-item spam-use-blackholes) (variable-item spam-use-hashcash) @@ -2200,15 +2267,21 @@ (const default) (set :tag "Use specific methods" (variable-item spam-use-blacklist) + (variable-item spam-use-gmane-xref) (variable-item spam-use-regex-headers) (variable-item spam-use-regex-body) (variable-item spam-use-whitelist) (variable-item spam-use-BBDB) (variable-item spam-use-ifile) (variable-item spam-use-spamoracle) + (variable-item spam-use-crm114) (variable-item spam-use-stat) (variable-item spam-use-blackholes) (variable-item spam-use-hashcash) + (variable-item spam-use-spamassassin) + (variable-item spam-use-spamassassin-headers) + (variable-item spam-use-bsfilter) + (variable-item spam-use-bsfilter-headers) (variable-item spam-use-bogofilter-headers) (variable-item spam-use-bogofilter))))) :parameter-document @@ -2387,8 +2460,7 @@ summary-menu group-menu article-menu tree-highlight menu highlight browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu) + page-marker tree-menu binary-menu pick-menu) "*Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of the visual customization options below will be ignored. Gnus will use @@ -2402,8 +2474,7 @@ Valid elements include `summary-highlight', `group-highlight', `article-highlight', `mouse-face', `summary-menu', `group-menu', `article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', -and `grouplens-menu'." +`server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'." :group 'gnus-meta :group 'gnus-visual :type '(set (const summary-highlight) @@ -2421,8 +2492,7 @@ (const page-marker) (const tree-menu) (const binary-menu) - (const pick-menu) - (const grouplens-menu))) + (const pick-menu))) ;; Byte-compiler warning. (defvar gnus-visual) @@ -2527,7 +2597,7 @@ (const codename :tag "Emacs codename"))) (string))) -;; Convert old (No Gnus < 2005-01-10, v5-10 < 2005-09-05) symbol type values: +;; Convert old (< 2005-01-10) symbol type values: (when (symbolp gnus-user-agent) (setq gnus-user-agent (cond ((eq gnus-user-agent 'emacs-gnus-config) @@ -2642,7 +2712,6 @@ (defvar gnus-headers-retrieved-by nil) (defvar gnus-article-reply nil) (defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) (defvar gnus-opened-servers nil) (defvar gnus-current-kill-article nil) @@ -2737,7 +2806,7 @@ ;; This little mapcar goes through the list below and marks the ;; symbols in question as autoloaded functions. - (mapcar + (mapc (lambda (package) (let ((interactive (nth 1 (memq ':interactive package)))) (mapcar @@ -2836,7 +2905,7 @@ gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view gnus-uu-decode-binhex-view gnus-uu-unmark-thread - gnus-uu-mark-over gnus-uu-post-news) + gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable) ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread) ("gnus-msg" (gnus-summary-send-map keymap) gnus-article-mail gnus-copy-article-buffer gnus-extended-version) @@ -2854,8 +2923,6 @@ gnus-summary-post-forward gnus-summary-wide-reply-with-original gnus-summary-post-forward) ("gnus-picon" :interactive t gnus-treat-from-picon) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) ("smiley" :interactive t smiley-region) ("gnus-win" gnus-configure-windows gnus-add-configuration) ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group @@ -2890,14 +2957,15 @@ gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed -;; gnus-article-show-all-headers + ;;gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-article-decode-encoded-words gnus-start-date-timer gnus-stop-date-timer gnus-mime-view-all-parts) ("gnus-int" gnus-request-type) ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 - gnus-dribble-enter gnus-read-init-file gnus-dribble-touch) + gnus-dribble-enter gnus-read-init-file gnus-dribble-touch + gnus-check-reasonable-setup) ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article gnus-dup-enter-articles) ("gnus-range" gnus-copy-sequence) @@ -2967,7 +3035,6 @@ %z Article zcore (character) %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). -%l GroupLens score (string). %V Total thread score (number). %P The line number (number). %O Download mark (character). @@ -3146,11 +3213,9 @@ (defun gnus-shutdown (symbol) "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) + (dolist (entry gnus-shutdown-alist) + (when (memq symbol (cdr entry)) + (funcall (car entry))))) ;;; @@ -3416,7 +3481,7 @@ (defun gnus-generate-new-group-name (leaf) (let ((name leaf) (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) + (while (gnus-group-entry name) (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) name)) @@ -3459,30 +3524,27 @@ ;; Perhaps it is already in the cache. (mapc (lambda (name-method) - (if (equal (cdr name-method) method) - (throw 'server-name (car name-method)))) - gnus-server-method-cache) + (if (equal (cdr name-method) method) + (throw 'server-name (car name-method)))) + gnus-server-method-cache) (mapc (lambda (server-alist) (mapc (lambda (name-method) - (when (gnus-methods-equal-p (cdr name-method) method) - (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) - (throw 'server-name (car name-method)))) - server-alist)) - (let ((alists (list gnus-server-alist - gnus-predefined-server-alist))) - (if gnus-select-method - (push (list (cons "native" gnus-select-method)) alists)) - alists)) + (when (gnus-methods-equal-p (cdr name-method) method) + (unless (member name-method gnus-server-method-cache) + (push name-method gnus-server-method-cache)) + (throw 'server-name (car name-method)))) + server-alist)) + (list gnus-server-alist + gnus-predefined-server-alist)) (let* ((name (if (member (cadr method) '(nil "")) - (format "%s" (car method)) - (format "%s:%s" (car method) (cadr method)))) - (name-method (cons name method))) + (format "%s" (car method)) + (format "%s:%s" (car method) (cadr method)))) + (name-method (cons name method))) (unless (member name-method gnus-server-method-cache) - (push name-method gnus-server-method-cache)) + (push name-method gnus-server-method-cache)) name))) (defsubst gnus-server-to-method (server) @@ -3795,7 +3857,7 @@ (if simple-results ;; Found results; return them. (car simple-results) - ;; We didn't found it there, try `gnus-parameters'. + ;; We didn't find it there, try `gnus-parameters'. (let ((result nil) (head nil) (tail gnus-parameters)) @@ -4082,12 +4144,12 @@ (and (not group) gnus-select-method) (and (not (gnus-group-entry group)) - ;; Killed or otherwise unknown group. - (or - ;; If we know a virtual server by that name, return its method. - (gnus-server-to-method (gnus-group-server group)) - ;; Guess a new method as last resort. - (gnus-group-name-to-method group))) + ;; Killed or otherwise unknown group. + (or + ;; If we know a virtual server by that name, return its method. + (gnus-server-to-method (gnus-group-server group)) + ;; Guess a new method as last resort. + (gnus-group-name-to-method group))) (let ((info (or info (gnus-get-info group))) method) (if (or (not info) @@ -4193,10 +4255,10 @@ "Say whether METHOD is covered by the agent." (or (eq (car gnus-agent-method-p-cache) method) (setq gnus-agent-method-p-cache - (cons method - (member (if (stringp method) - method - (gnus-method-to-server method)) gnus-agent-covered-methods)))) + (cons method + (member (if (stringp method) + method + (gnus-method-to-server method)) gnus-agent-covered-methods)))) (cdr gnus-agent-method-p-cache)) (defun gnus-online (method) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/hashcash.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/hashcash.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,370 @@ +;;; hashcash.el --- Add hashcash payments to email + +;; Copyright (C) 2003, 2004, 2005, 2007 Free Software Foundation + +;; Written by: Paul Foley (1997-2002) +;; Maintainer: Paul Foley +;; Keywords: mail, hashcash + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The hashcash binary is at http://www.hashcash.org/. +;; +;; Call mail-add-payment to add a hashcash payment to a mail message +;; in the current buffer. +;; +;; Call mail-add-payment-async after writing the addresses but before +;; writing the mail to start calculating the hashcash payment +;; asynchronously. +;; +;; The easiest way to do this automatically for all outgoing mail +;; is to set `message-generate-hashcash' to t. If you want more +;; control, try the following hooks. +;; +;; To automatically add payments to all outgoing mail when sending: +;; (add-hook 'message-send-hook 'mail-add-payment) +;; +;; To start calculations automatically when addresses are prefilled: +;; (add-hook 'message-setup-hook 'mail-add-payment-async) +;; +;; To check whether calculations are done before sending: +;; (add-hook 'message-send-hook 'hashcash-wait-or-cancel) + +;;; Code: + +(defgroup hashcash nil + "Hashcash configuration." + :group 'mail) + +(defcustom hashcash-default-payment 20 + "*The default number of bits to pay to unknown users. +If this is zero, no payment header will be generated. +See `hashcash-payment-alist'." + :type 'integer + :group 'hashcash) + +(defcustom hashcash-payment-alist '() + "*An association list mapping email addresses to payment amounts. +Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where +ADDR is the email address of the intended recipient and AMOUNT is +the value of hashcash payment to be made to that user. STRING, if +present, is the string to be hashed; if not present ADDR will be used." + :type '(repeat (choice (list :tag "Normal" + (string :name "Address") + (integer :name "Amount")) + (list :tag "Replace hash input" + (string :name "Address") + (string :name "Hash input") + (integer :name "Amount")))) + :group 'hashcash) + +(defcustom hashcash-default-accept-payment 20 + "*The default minimum number of bits to accept on incoming payments." + :type 'integer + :group 'hashcash) + +(defcustom hashcash-accept-resources `((,user-mail-address nil)) + "*An association list mapping hashcash resources to payment amounts. +Resources named here are to be accepted in incoming payments. If the +corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment' +is used instead." + :group 'hashcash) + +(defcustom hashcash-path (executable-find "hashcash") + "*The path to the hashcash binary." + :group 'hashcash) + +(defcustom hashcash-extra-generate-parameters nil + "*A list of parameter strings passed to `hashcash-path' when minting. +For example, you may want to set this to '(\"-Z2\") to reduce header length." + :type '(repeat string) + :group 'hashcash) + +(defcustom hashcash-double-spend-database "hashcash.db" + "*The path to the double-spending database." + :group 'hashcash) + +(defcustom hashcash-in-news nil + "*Specifies whether or not hashcash payments should be made to newsgroups." + :type 'boolean + :group 'hashcash) + +(defvar hashcash-process-alist nil + "Alist of asynchronous hashcash processes and buffers.") + +(require 'mail-utils) + +(eval-and-compile + (if (fboundp 'point-at-bol) + (defalias 'hashcash-point-at-bol 'point-at-bol) + (defalias 'hashcash-point-at-bol 'line-beginning-position)) + + (if (fboundp 'point-at-eol) + (defalias 'hashcash-point-at-eol 'point-at-eol) + (defalias 'hashcash-point-at-eol 'line-end-position))) + +(defun hashcash-strip-quoted-names (addr) + (setq addr (mail-strip-quoted-names addr)) + (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr)) + (concat (match-string 1 addr) (match-string 2 addr)) + addr)) + +(defun hashcash-token-substring () + (save-excursion + (let ((token "")) + (loop + (setq token + (concat token (buffer-substring (point) (hashcash-point-at-eol)))) + (goto-char (hashcash-point-at-eol)) + (forward-char 1) + (unless (looking-at "[ \t]") (return token)) + (while (looking-at "[ \t]") (forward-char 1)))))) + +(defun hashcash-payment-required (addr) + "Return the hashcash payment value required for the given address." + (let ((val (assoc addr hashcash-payment-alist))) + (or (nth 2 val) (nth 1 val) hashcash-default-payment))) + +(defun hashcash-payment-to (addr) + "Return the string with which hashcash payments should collide." + (let ((val (assoc addr hashcash-payment-alist))) + (or (nth 1 val) (nth 0 val) addr))) + +(defun hashcash-generate-payment (str val) + "Generate a hashcash payment by finding a VAL-bit collison on STR." + (if (and (> val 0) + hashcash-path) + (save-excursion + (set-buffer (get-buffer-create " *hashcash*")) + (erase-buffer) + (apply 'call-process hashcash-path nil t nil + "-m" "-q" "-b" (number-to-string val) str + hashcash-extra-generate-parameters) + (goto-char (point-min)) + (hashcash-token-substring)) + (error "No `hashcash' binary found"))) + +(defun hashcash-generate-payment-async (str val callback) + "Generate a hashcash payment by finding a VAL-bit collison on STR. +Return immediately. Call CALLBACK with process and result when ready." + (if (and (> val 0) + hashcash-path) + (let ((process (apply 'start-process "hashcash" nil + hashcash-path "-m" "-q" + "-b" (number-to-string val) str + hashcash-extra-generate-parameters))) + (setq hashcash-process-alist (cons + (cons process (current-buffer)) + hashcash-process-alist)) + (set-process-filter process `(lambda (process output) + (funcall ,callback process output)))) + (funcall callback nil nil))) + +(defun hashcash-check-payment (token str val) + "Check the validity of a hashcash payment." + (if hashcash-path + (zerop (call-process hashcash-path nil nil nil "-c" + "-d" "-f" hashcash-double-spend-database + "-b" (number-to-string val) + "-r" str + token)) + (progn + (message "No hashcash binary found") + (sleep-for 1) + nil))) + +(defun hashcash-version (token) + "Find the format version of a hashcash token." + ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; This carries its own version number embedded in the token, + ;; so no further format number changes should be necessary + ;; in the X-Payment header. + ;; + ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx + ;; You need to upgrade your hashcash binary. + ;; + ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx + ;; This is no longer supported. + (cond ((equal (aref token 1) ?:) 1.2) + ((equal (aref token 6) ?:) 1.1) + (t (error "Unknown hashcash format version")))) + +(defun hashcash-already-paid-p (recipient) + "Check for hashcash token to RECIPIENT in current buffer." + (save-excursion + (save-restriction + (message-narrow-to-headers-or-head) + (let ((token (message-fetch-field "x-hashcash")) + (case-fold-search t)) + (and (stringp token) + (string-match (regexp-quote recipient) token)))))) + +;;;###autoload +(defun hashcash-insert-payment (arg) + "Insert X-Payment and X-Hashcash headers with a payment for ARG" + (interactive "sPay to: ") + (unless (hashcash-already-paid-p arg) + (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) + (hashcash-payment-required arg)))) + (when pay + (insert-before-markers "X-Hashcash: " pay "\n"))))) + +;;;###autoload +(defun hashcash-insert-payment-async (arg) + "Insert X-Payment and X-Hashcash headers with a payment for ARG +Only start calculation. Results are inserted when ready." + (interactive "sPay to: ") + (unless (hashcash-already-paid-p arg) + (hashcash-generate-payment-async + (hashcash-payment-to arg) + (hashcash-payment-required arg) + `(lambda (process payment) + (hashcash-insert-payment-async-2 ,(current-buffer) process payment))))) + +(defun hashcash-insert-payment-async-2 (buffer process pay) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (save-restriction + (setq hashcash-process-alist (delq + (assq process hashcash-process-alist) + hashcash-process-alist)) + (message-goto-eoh) + (when pay + (insert-before-markers "X-Hashcash: " pay))))))) + +(defun hashcash-cancel-async (&optional buffer) + "Delete any hashcash processes associated with BUFFER. +BUFFER defaults to the current buffer." + (interactive) + (unless buffer (setq buffer (current-buffer))) + (let (entry) + (while (setq entry (rassq buffer hashcash-process-alist)) + (delete-process (car entry)) + (setq hashcash-process-alist + (delq entry hashcash-process-alist))))) + +(defun hashcash-wait-async (&optional buffer) + "Wait for asynchronous hashcash processes in BUFFER to finish. +BUFFER defaults to the current buffer." + (interactive) + (unless buffer (setq buffer (current-buffer))) + (let (entry) + (while (setq entry (rassq buffer hashcash-process-alist)) + (accept-process-output (car entry))))) + +(defun hashcash-processes-running-p (buffer) + "Return non-nil if hashcash processes in BUFFER are still running." + (rassq buffer hashcash-process-alist)) + +(defun hashcash-wait-or-cancel () + "Ask user whether to wait for hashcash processes to finish." + (interactive) + (when (hashcash-processes-running-p (current-buffer)) + (if (y-or-n-p + "Hashcash process(es) still running; wait for them to finish? ") + (hashcash-wait-async) + (hashcash-cancel-async)))) + +;;;###autoload +(defun hashcash-verify-payment (token &optional resource amount) + "Verify a hashcash payment" + (let* ((split (split-string token ":")) + (key (if (< (hashcash-version token) 1.2) + (nth 1 split) + (case (string-to-number (nth 0 split)) + (0 (nth 2 split)) + (1 (nth 3 split)))))) + (cond ((null resource) + (let ((elt (assoc key hashcash-accept-resources))) + (and elt (hashcash-check-payment token (car elt) + (or (cadr elt) hashcash-default-accept-payment))))) + ((equal token key) + (hashcash-check-payment token resource + (or amount hashcash-default-accept-payment))) + (t nil)))) + +;;;###autoload +(defun mail-add-payment (&optional arg async) + "Add X-Payment: and X-Hashcash: headers with a hashcash payment +for each recipient address. Prefix arg sets default payment temporarily. +Set ASYNC to t to start asynchronous calculation. (See +`mail-add-payment-async')." + (interactive "P") + (let ((hashcash-default-payment (if arg (prefix-numeric-value arg) + hashcash-default-payment)) + (addrlist nil)) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t))) + (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t))) + (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups" + nil t)))) + (when to + (setq addrlist (split-string to ",[ \t\n]*"))) + (when cc + (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*")))) + (when (and hashcash-in-news ng) + (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) + (when addrlist + (mapc (if async + #'hashcash-insert-payment-async + #'hashcash-insert-payment) + addrlist))))) + t) + +;;;###autoload +(defun mail-add-payment-async (&optional arg) + "Add X-Payment: and X-Hashcash: headers with a hashcash payment +for each recipient address. Prefix arg sets default payment temporarily. +Calculation is asynchronous." + (interactive "P") + (mail-add-payment arg t)) + +;;;###autoload +(defun mail-check-payment (&optional arg) + "Look for a valid X-Payment: or X-Hashcash: header. +Prefix arg sets default accept amount temporarily." + (interactive "P") + (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg) + hashcash-default-accept-payment)) + (version (hashcash-version (hashcash-generate-payment "x" 1)))) + (save-excursion + (goto-char (point-min)) + (search-forward "\n\n") + (beginning-of-line) + (let ((end (point)) + (ok nil)) + (goto-char (point-min)) + (while (and (not ok) (search-forward "X-Payment: hashcash " end t)) + (let ((value (split-string (hashcash-token-substring) " "))) + (when (equal (car value) (number-to-string version)) + (setq ok (hashcash-verify-payment (cadr value)))))) + (goto-char (point-min)) + (while (and (not ok) (search-forward "X-Hashcash: " end t)) + (setq ok (hashcash-verify-payment (hashcash-token-substring)))) + (when ok + (message "Payment valid")) + ok)))) + +(provide 'hashcash) + +;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/hmac-def.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/hmac-def.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,86 @@ +;;; hmac-def.el --- A macro for defining HMAC functions. + +;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This program is implemented from RFC 2104, +;; "HMAC: Keyed-Hashing for Message Authentication". + +;;; Code: + +(defmacro define-hmac-function (name H B L &optional bit) + "Define a function NAME(TEXT KEY) which computes HMAC with function H. + +HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)): + +H is a cryptographic hash function, such as SHA1 and MD5, which takes +a string and return a digest of it (in binary form). +B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.) +L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.) +If BIT is non-nil, truncate output to specified bits." + `(defun ,name (text key) + ,(concat "Compute " + (upcase (symbol-name name)) + " over TEXT with KEY.") + (let ((key-xor-ipad (make-string ,B ?\x36)) + (key-xor-opad (make-string ,B ?\x5C)) + (len (length key)) + (pos 0)) + (unwind-protect + (progn + ;; if `key' is longer than the block size, apply hash function + ;; to `key' and use the result as a real `key'. + (if (> len ,B) + (setq key (,H key) + len ,L)) + (while (< pos len) + (aset key-xor-ipad pos (logxor (aref key pos) ?\x36)) + (aset key-xor-opad pos (logxor (aref key pos) ?\x5C)) + (setq pos (1+ pos))) + (setq key-xor-ipad (unwind-protect + (concat key-xor-ipad text) + (fillarray key-xor-ipad 0)) + key-xor-ipad (unwind-protect + (,H key-xor-ipad) + (fillarray key-xor-ipad 0)) + key-xor-opad (unwind-protect + (concat key-xor-opad key-xor-ipad) + (fillarray key-xor-opad 0)) + key-xor-opad (unwind-protect + (,H key-xor-opad) + (fillarray key-xor-opad 0))) + ;; now `key-xor-opad' contains + ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)). + ,(if (and bit (< (/ bit 8) L)) + `(substring key-xor-opad 0 ,(/ bit 8)) + ;; return a copy of `key-xor-opad'. + `(concat key-xor-opad))) + ;; cleanup. + (fillarray key-xor-ipad 0) + (fillarray key-xor-opad 0))))) + +(provide 'hmac-def) + +;;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9 +;;; hmac-def.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/hmac-md5.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/hmac-md5.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,85 @@ +;;; hmac-md5.el --- Compute HMAC-MD5. + +;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. + +;; Author: Shuhei KOBAYASHI +;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1". +;; +;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b))) +;; => "9294727a3638bb1c13f48ef8158bfc9d" +;; +;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe")) +;; => "750c783e6ab0b503eaa86e310a5db738" +;; +;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa))) +;; => "56be34521d144c88dbb8c733f0e8b3f6" +;; +;; (encode-hex-string +;; (hmac-md5 +;; (make-string 50 ?\xcd) +;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) +;; => "697eaf0aca3a3aea3a75164746ffaa79" +;; +;; (encode-hex-string +;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c))) +;; => "56461ef2342edc00f9bab995690efd4c" +;; +;; (encode-hex-string +;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c))) +;; => "56461ef2342edc00f9bab995" +;; +;; (encode-hex-string +;; (hmac-md5 +;; "Test Using Larger Than Block-Size Key - Hash Key First" +;; (make-string 80 ?\xaa))) +;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" +;; +;; (encode-hex-string +;; (hmac-md5 +;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" +;; (make-string 80 ?\xaa))) +;; => "6f630fad67cda0ee1fb1f562db3aa53e" + +;;; Code: + +(eval-when-compile (require 'hmac-def)) +(require 'hex-util) ; (decode-hex-string STRING) +(require 'md5) ; expects (md5 STRING) + +(defun md5-binary (string) + "Return the MD5 of STRING in binary form." + (if (condition-case nil + ;; `md5' of v21 takes 4th arg CODING (and 5th arg NOERROR). + (md5 "" nil nil 'binary) ; => "d41d8cd98f00b204e9800998ecf8427e" + (wrong-number-of-arguments nil)) + (decode-hex-string (md5 string nil nil 'binary)) + (decode-hex-string (md5 string)))) + +(define-hmac-function hmac-md5 md5-binary 64 16) ; => (hmac-md5 TEXT KEY) +(define-hmac-function hmac-md5-96 md5-binary 64 16 96) + +(provide 'hmac-md5) + +;;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27 +;;; hmac-md5.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/html2text.el --- a/lisp/gnus/html2text.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/html2text.el Sun Oct 28 09:18:39 2007 +0000 @@ -43,8 +43,42 @@ (defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr))) (defvar html2text-replace-list - '((" " . " ") (">" . ">") ("<" . "<") (""" . "\"") - ("&" . "&") ("'" . "'")) + '(("´" . "`") + ("&" . "&") + ("'" . "'") + ("¦" . "|") + ("¢" . "c") + ("ˆ" . "^") + ("©" . "(C)") + ("¤" . "(#)") + ("°" . "degree") + ("÷" . "/") + ("€" . "e") + ("½" . "1/2") + (">" . ">") + ("¿" . "?") + ("«" . "<<") + ("&ldquo" . "\"") + ("‹" . "(") + ("‘" . "`") + ("<" . "<") + ("—" . "--") + (" " . " ") + ("–" . "-") + ("‰" . "%%") + ("±" . "+-") + ("£" . "£") + (""" . "\"") + ("»" . ">>") + ("&rdquo" . "\"") + ("®" . "(R)") + ("›" . ")") + ("’" . "'") + ("§" . "§") + ("¹" . "^1") + ("²" . "^2") + ("³" . "^3") + ("˜" . "~")) "The map of entity to text. This is an alist were each element is a dotted pair consisting of an @@ -229,12 +263,12 @@ (goto-char p1) (let ((item-nr 0) (items 0)) - (while (re-search-forward "
  • " p2 t) + (while (search-forward "
  • " p2 t) (setq items (1+ items))) (goto-char p1) (while (< item-nr items) (setq item-nr (1+ item-nr)) - (re-search-forward "
  • " (point-max) t) + (search-forward "
  • " (point-max) t) (cond ((string= list-type "ul") (insert " o ")) ((string= list-type "ol") (insert (format " %s: " item-nr))) @@ -244,7 +278,7 @@ (goto-char p1) (let ((items 0) (item-nr 0)) - (while (re-search-forward "
    " p2 t) + (while (search-forward "
    " p2 t) (setq items (1+ items))) (goto-char p1) (while (< item-nr items) @@ -342,8 +376,7 @@ (defun html2text-fix-paragraph (p1 p2) (goto-char p1) - (let ((has-br-line) - (refill-start) + (let ((refill-start) (refill-stop)) (when (re-search-forward "
    $" p2 t) (goto-char p1) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/ietf-drums.el --- a/lisp/gnus/ietf-drums.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/ietf-drums.el Sun Oct 28 09:18:39 2007 +0000 @@ -99,14 +99,14 @@ (push c out))) (range (while (<= b c) - (push (mm-make-char 'ascii b) out) + (push (make-char 'ascii b) out) (incf b)) (setq range nil)) ((= i (length token)) - (push (mm-make-char 'ascii c) out)) + (push (make-char 'ascii c) out)) (t (when b - (push (mm-make-char 'ascii b) out)) + (push (make-char 'ascii b) out)) (setq b c)))) (nreverse out))) @@ -200,7 +200,9 @@ (buffer-substring (1+ (point)) (progn (forward-sexp 1) (1- (point)))))))) - (t (error "Unknown symbol: %c" c)))) + (t + (message "Unknown symbol: %c" c) + (forward-char 1)))) ;; If we found no display-name, then we look for comments. (if display-name (setq display-string @@ -213,8 +215,10 @@ (ietf-drums-get-comment string))) (cons mailbox display-string))))) -(defun ietf-drums-parse-addresses (string) - "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs." +(defun ietf-drums-parse-addresses (string &optional rawp) + "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs. +If RAWP, don't actually parse the addresses, but instead return +a list of address strings." (if (null string) nil (with-temp-buffer @@ -231,20 +235,24 @@ (skip-chars-forward "^,")))) ((eq c ?,) (setq address - (condition-case nil - (ietf-drums-parse-address - (buffer-substring beg (point))) - (error nil))) + (if rawp + (buffer-substring beg (point)) + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil)))) (if address (push address pairs)) (forward-char 1) (setq beg (point))) (t (forward-char 1)))) (setq address - (condition-case nil - (ietf-drums-parse-address - (buffer-substring beg (point))) - (error nil))) + (if rawp + (buffer-substring beg (point)) + (condition-case nil + (ietf-drums-parse-address + (buffer-substring beg (point))) + (error nil)))) (if address (push address pairs)) (nreverse pairs))))) @@ -274,6 +282,11 @@ (concat "\"" string "\"") string)) +(defun ietf-drums-make-address (name address) + (if name + (concat (ietf-drums-quote-string name) " <" address ">") + address)) + (provide 'ietf-drums) ;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/imap.el --- a/lisp/gnus/imap.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/imap.el Sun Oct 28 09:18:39 2007 +0000 @@ -74,13 +74,13 @@ ;; explanatory for someone that know IMAP. All functions have ;; additional documentation on how to invoke them. ;; -;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP -;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 +;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented +;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, ;; LOGINDISABLED) (with use of external library starttls.el and -;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731 -;; (with use of external program `imtest'). It also takes advantage of -;; the UNSELECT extension in Cyrus IMAPD. +;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731 +;; (with use of external program `imtest'), RFC2971 (ID). It also +;; takes advantage of the UNSELECT extension in Cyrus IMAPD. ;; ;; Without the work of John McClary Prevost and Jim Radford this library ;; would not have seen the light of day. Many thanks. @@ -140,29 +140,19 @@ (eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'base64-decode-string "base64") - (autoload 'base64-encode-string "base64") (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") + (autoload 'sasl-find-mechanism "sasl") (autoload 'digest-md5-parse-digest-challenge "digest-md5") (autoload 'digest-md5-digest-response "digest-md5") (autoload 'digest-md5-digest-uri "digest-md5") (autoload 'digest-md5-challenge "digest-md5") (autoload 'rfc2104-hash "rfc2104") - (autoload 'md5 "md5") (autoload 'utf7-encode "utf7") (autoload 'utf7-decode "utf7") (autoload 'format-spec "format-spec") (autoload 'format-spec-make "format-spec") - (autoload 'open-tls-stream "tls") - ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These - ;; days we have point-at-eol anyhow. - (if (fboundp 'point-at-eol) - (defalias 'imap-point-at-eol 'point-at-eol) - (defun imap-point-at-eol () - (save-excursion - (end-of-line) - (point))))) + (autoload 'open-tls-stream "tls")) ;; User variables. @@ -311,6 +301,7 @@ kerberos4 digest-md5 cram-md5 + ;;sasl login anonymous) "Priority of authenticators to consider when authenticating to server.") @@ -318,6 +309,7 @@ (defvar imap-authenticator-alist '((gssapi imap-gssapi-auth-p imap-gssapi-auth) (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth) + (sasl imap-sasl-auth-p imap-sasl-auth) (cram-md5 imap-cram-md5-p imap-cram-md5-auth) (login imap-login-p imap-login-auth) (anonymous imap-anonymous-p imap-anonymous-auth) @@ -333,6 +325,13 @@ (defvar imap-error nil "Error codes from the last command.") +(defvar imap-logout-timeout nil + "Close server immediately if it can't logout in this number of seconds. +If it is nil, never close server until logout completes. Normally, +the value of this variable will be bound to a certain value to which +an application program that uses this module specifies on a per-server +basis.") + ;; Internal constants. Change these and die. (defconst imap-default-port 143) @@ -353,6 +352,7 @@ imap-current-target-mailbox imap-message-data imap-capability + imap-id imap-namespace imap-state imap-reached-tag @@ -408,6 +408,10 @@ (defvar imap-capability nil "Capability for server.") +(defvar imap-id nil + "Identity of server. +See RFC 2971.") + (defvar imap-namespace nil "Namespace for current server.") @@ -557,7 +561,7 @@ (not (string-match "failed" response)))) (setq done process) (if (memq (process-status process) '(open run)) - (imap-send-command "LOGOUT")) + (imap-logout)) (delete-process process) nil))))) done)) @@ -632,7 +636,7 @@ (not (string-match "failed" response)))) (setq done process) (if (memq (process-status process) '(open run)) - (imap-send-command "LOGOUT")) + (imap-logout)) (delete-process process) nil))))) done)) @@ -915,14 +919,27 @@ (and (not (imap-capability 'LOGINDISABLED buffer)) (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))) +(defun imap-quote-specials (string) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "[\\\"]" nil t) + (forward-char -1) + (insert "\\") + (forward-char 1)) + (buffer-string))) + (defun imap-login-auth (buffer) "Login to server using the LOGIN command." (message "imap: Plaintext authentication...") (imap-interactive-login buffer (lambda (user passwd) (imap-ok-p (imap-send-command-wait - (concat "LOGIN \"" user "\" \"" - passwd "\"")))))) + (concat "LOGIN \"" + (imap-quote-specials user) + "\" \"" + (imap-quote-specials passwd) + "\"")))))) (defun imap-anonymous-p (buffer) t) @@ -934,6 +951,66 @@ (concat "LOGIN anonymous \"" (concat (user-login-name) "@" (system-name)) "\""))))) +;;; Compiler directives. + +(defvar imap-sasl-client) +(defvar imap-sasl-step) + +(defun imap-sasl-make-mechanisms (buffer) + (let ((mecs '())) + (mapc (lambda (sym) + (let ((name (symbol-name sym))) + (if (and (> (length name) 5) + (string-equal "AUTH=" (substring name 0 5 ))) + (setq mecs (cons (substring name 5) mecs))))) + (imap-capability nil buffer)) + mecs)) + +(defun imap-sasl-auth-p (buffer) + (and (condition-case () + (require 'sasl) + (error nil)) + (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))) + +(defun imap-sasl-auth (buffer) + "Login to server using the SASL method." + (message "imap: Authenticating using SASL...") + (with-current-buffer buffer + (make-local-variable 'imap-username) + (make-local-variable 'imap-sasl-client) + (make-local-variable 'imap-sasl-step) + (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))) + logged user) + (while (not logged) + (setq user (or imap-username + (read-from-minibuffer + (concat "IMAP username for " imap-server " using SASL " + (sasl-mechanism-name mechanism) ": ") + (or user imap-default-user)))) + (when user + (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server) + imap-sasl-step (sasl-next-step imap-sasl-client nil)) + (let ((tag (imap-send-command + (if (sasl-step-data imap-sasl-step) + (format "AUTHENTICATE %s %s" + (sasl-mechanism-name mechanism) + (sasl-step-data imap-sasl-step)) + (format "AUTHENTICATE %s" (sasl-mechanism-name mechanism))) + buffer))) + (while (eq (imap-wait-for-tag tag) 'INCOMPLETE) + (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation)) + (setq imap-continuation nil + imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step)) + (imap-send-command-1 (if (sasl-step-data imap-sasl-step) + (base64-encode-string (sasl-step-data imap-sasl-step) t) + ""))) + (if (imap-ok-p (imap-wait-for-tag tag)) + (setq imap-username user + logged t) + (message "Login failed...") + (sit-for 1))))) + logged))) + (defun imap-digest-md5-p (buffer) (and (imap-capability 'AUTH=DIGEST-MD5 buffer) (condition-case () @@ -1006,7 +1083,7 @@ (with-current-buffer (get-buffer-create buffer) (if (imap-opened buffer) (imap-close buffer)) - (mapcar 'make-local-variable imap-local-variables) + (mapc 'make-local-variable imap-local-variables) (imap-disable-multibyte) (buffer-disable-undo) (setq imap-server (or server imap-server)) @@ -1029,7 +1106,7 @@ (if (not (eq imap-default-stream stream)) (with-current-buffer (get-buffer-create (generate-new-buffer-name " *temp*")) - (mapcar 'make-local-variable imap-local-variables) + (mapc 'make-local-variable imap-local-variables) (imap-disable-multibyte) (buffer-disable-undo) (setq imap-server (or server imap-server)) @@ -1084,7 +1161,7 @@ (with-current-buffer (or buffer (current-buffer)) (if (not (eq imap-state 'nonauth)) (or (eq imap-state 'auth) - (eq imap-state 'select) + (eq imap-state 'selected) (eq imap-state 'examine)) (make-local-variable 'imap-username) (make-local-variable 'imap-password) @@ -1118,7 +1195,7 @@ (with-current-buffer (or buffer (current-buffer)) (when (imap-opened) (condition-case nil - (imap-send-command-wait "LOGOUT") + (imap-logout-wait) (quit nil))) (when (and imap-process (memq (process-status imap-process) '(open run))) @@ -1141,6 +1218,26 @@ (memq (intern (upcase (symbol-name identifier))) imap-capability) imap-capability))) +(defun imap-id (&optional list-of-values buffer) + "Identify client to server in BUFFER, and return server identity. +LIST-OF-VALUES is nil, or a plist with identifier and value +strings to send to the server to identify the client. + +Return a list of identifiers which server in BUFFER support, or +nil if it doesn't support ID or returns no information. + +If BUFFER is nil, the current buffer is assumed." + (with-current-buffer (or buffer (current-buffer)) + (when (and (imap-capability 'ID) + (imap-ok-p (imap-send-command-wait + (if (null list-of-values) + "ID NIL" + (concat "ID (" (mapconcat (lambda (el) + (concat "\"" el "\"")) + list-of-values + " ") ")"))))) + imap-id))) + (defun imap-namespace (&optional buffer) "Return a namespace hierarchy at server in BUFFER. If BUFFER is nil, the current buffer is assumed." @@ -1153,6 +1250,28 @@ (defun imap-send-command-wait (command &optional buffer) (imap-wait-for-tag (imap-send-command command buffer) buffer)) +(defun imap-logout (&optional buffer) + (or buffer (setq buffer (current-buffer))) + (if imap-logout-timeout + (with-timeout (imap-logout-timeout + (condition-case nil + (with-current-buffer buffer + (delete-process imap-process)) + (error))) + (imap-send-command "LOGOUT" buffer)) + (imap-send-command "LOGOUT" buffer))) + +(defun imap-logout-wait (&optional buffer) + (or buffer (setq buffer (current-buffer))) + (if imap-logout-timeout + (with-timeout (imap-logout-timeout + (condition-case nil + (with-current-buffer buffer + (delete-process imap-process)) + (error))) + (imap-send-command-wait "LOGOUT" buffer)) + (imap-send-command-wait "LOGOUT" buffer))) + ;; Mailbox functions: @@ -2106,6 +2225,8 @@ (read (concat "(" (upcase (buffer-substring (point) (point-max))) ")")))) + (ID (setq imap-id (read (buffer-substring (point) + (point-max))))) (ACL (imap-parse-acl)) (t (case (prog1 (read (current-buffer)) (imap-forward)) @@ -2460,7 +2581,7 @@ ;; next line for Courier IMAP bug. (skip-chars-forward " ") (point))) - (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0)) + (> (skip-chars-forward "^ )" (point-at-eol)) 0)) (push (buffer-substring start (point)) flag-list)) (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") (imap-forward) @@ -2740,99 +2861,99 @@ (when imap-debug ; (untrace-all) (require 'trace) (buffer-disable-undo (get-buffer-create imap-debug-buffer)) - (mapcar (lambda (f) (trace-function-background f imap-debug-buffer)) - '( - imap-utf7-encode - imap-utf7-decode - imap-error-text - imap-kerberos4s-p - imap-kerberos4-open - imap-ssl-p - imap-ssl-open - imap-network-p - imap-network-open - imap-interactive-login - imap-kerberos4a-p - imap-kerberos4-auth - imap-cram-md5-p - imap-cram-md5-auth - imap-login-p - imap-login-auth - imap-anonymous-p - imap-anonymous-auth - imap-open-1 - imap-open - imap-opened - imap-authenticate - imap-close - imap-capability - imap-namespace - imap-send-command-wait - imap-mailbox-put - imap-mailbox-get - imap-mailbox-map-1 - imap-mailbox-map - imap-current-mailbox - imap-current-mailbox-p-1 - imap-current-mailbox-p - imap-mailbox-select-1 - imap-mailbox-select - imap-mailbox-examine-1 - imap-mailbox-examine - imap-mailbox-unselect - imap-mailbox-expunge - imap-mailbox-close - imap-mailbox-create-1 - imap-mailbox-create - imap-mailbox-delete - imap-mailbox-rename - imap-mailbox-lsub - imap-mailbox-list - imap-mailbox-subscribe - imap-mailbox-unsubscribe - imap-mailbox-status - imap-mailbox-acl-get - imap-mailbox-acl-set - imap-mailbox-acl-delete - imap-current-message - imap-list-to-message-set - imap-fetch-asynch - imap-fetch - imap-message-put - imap-message-get - imap-message-map - imap-search - imap-message-flag-permanent-p - imap-message-flags-set - imap-message-flags-del - imap-message-flags-add - imap-message-copyuid-1 - imap-message-copyuid - imap-message-copy - imap-message-appenduid-1 - imap-message-appenduid - imap-message-append - imap-body-lines - imap-envelope-from - imap-send-command-1 - imap-send-command - imap-wait-for-tag - imap-sentinel - imap-find-next-line - imap-arrival-filter - imap-parse-greeting - imap-parse-response - imap-parse-resp-text - imap-parse-resp-text-code - imap-parse-data-list - imap-parse-fetch - imap-parse-status - imap-parse-acl - imap-parse-flag-list - imap-parse-envelope - imap-parse-body-extension - imap-parse-body - ))) + (mapc (lambda (f) (trace-function-background f imap-debug-buffer)) + '( + imap-utf7-encode + imap-utf7-decode + imap-error-text + imap-kerberos4s-p + imap-kerberos4-open + imap-ssl-p + imap-ssl-open + imap-network-p + imap-network-open + imap-interactive-login + imap-kerberos4a-p + imap-kerberos4-auth + imap-cram-md5-p + imap-cram-md5-auth + imap-login-p + imap-login-auth + imap-anonymous-p + imap-anonymous-auth + imap-open-1 + imap-open + imap-opened + imap-authenticate + imap-close + imap-capability + imap-namespace + imap-send-command-wait + imap-mailbox-put + imap-mailbox-get + imap-mailbox-map-1 + imap-mailbox-map + imap-current-mailbox + imap-current-mailbox-p-1 + imap-current-mailbox-p + imap-mailbox-select-1 + imap-mailbox-select + imap-mailbox-examine-1 + imap-mailbox-examine + imap-mailbox-unselect + imap-mailbox-expunge + imap-mailbox-close + imap-mailbox-create-1 + imap-mailbox-create + imap-mailbox-delete + imap-mailbox-rename + imap-mailbox-lsub + imap-mailbox-list + imap-mailbox-subscribe + imap-mailbox-unsubscribe + imap-mailbox-status + imap-mailbox-acl-get + imap-mailbox-acl-set + imap-mailbox-acl-delete + imap-current-message + imap-list-to-message-set + imap-fetch-asynch + imap-fetch + imap-message-put + imap-message-get + imap-message-map + imap-search + imap-message-flag-permanent-p + imap-message-flags-set + imap-message-flags-del + imap-message-flags-add + imap-message-copyuid-1 + imap-message-copyuid + imap-message-copy + imap-message-appenduid-1 + imap-message-appenduid + imap-message-append + imap-body-lines + imap-envelope-from + imap-send-command-1 + imap-send-command + imap-wait-for-tag + imap-sentinel + imap-find-next-line + imap-arrival-filter + imap-parse-greeting + imap-parse-response + imap-parse-resp-text + imap-parse-resp-text-code + imap-parse-data-list + imap-parse-fetch + imap-parse-status + imap-parse-acl + imap-parse-flag-list + imap-parse-envelope + imap-parse-body-extension + imap-parse-body + ))) (provide 'imap) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/legacy-gnus-agent.el --- a/lisp/gnus/legacy-gnus-agent.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/legacy-gnus-agent.el Sun Oct 28 09:18:39 2007 +0000 @@ -110,23 +110,20 @@ (throw 'found-file-to-convert t)) (erase-buffer) - (let ((compressed nil)) - (mapcar (lambda (pair) - (let* ((article-id (car pair)) - (day-of-download (cdr pair)) - (comp-list (assq day-of-download compressed))) - (if comp-list - (setcdr comp-list - (cons article-id (cdr comp-list))) - (setq compressed - (cons (list day-of-download article-id) - compressed))) - nil)) alist) - (mapcar (lambda (comp-list) - (setcdr comp-list - (gnus-compress-sequence - (nreverse (cdr comp-list))))) - compressed) + (let (article-id day-of-download comp-list compressed) + (while alist + (setq article-id (caar alist) + day-of-download (cdar alist) + comp-list (assq day-of-download compressed) + alist (cdr alist)) + (if comp-list + (setcdr comp-list (cons article-id (cdr comp-list))) + (push (list day-of-download article-id) compressed))) + (setq alist compressed) + (while alist + (setq comp-list (pop alist)) + (setcdr comp-list + (gnus-compress-sequence (nreverse (cdr comp-list))))) (princ compressed (current-buffer))) (insert "\n2\n") (write-file file) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mail-parse.el --- a/lisp/gnus/mail-parse.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mail-parse.el Sun Oct 28 09:18:39 2007 +0000 @@ -59,6 +59,7 @@ (defalias 'mail-header-parse-date 'ietf-drums-parse-date) (defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header) (defalias 'mail-quote-string 'ietf-drums-quote-string) +(defalias 'mail-header-make-address 'ietf-drums-make-address) (defalias 'mail-header-fold-field 'rfc2047-fold-field) (defalias 'mail-header-unfold-field 'rfc2047-unfold-field) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mail-source.el --- a/lisp/gnus/mail-source.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mail-source.el Sun Oct 28 09:18:39 2007 +0000 @@ -34,8 +34,7 @@ (eval-and-compile (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") - (autoload 'nnheader-cancel-timer "nnheader") - (autoload 'nnheader-run-at-time "nnheader")) + (autoload 'nnheader-cancel-timer "nnheader")) (require 'format-spec) (require 'mm-util) (require 'message) ;; for `message-directory' @@ -111,7 +110,7 @@ (const :format "" :value :port) (choice :tag "Port" :value "pop3" - (number :format "%v") + (integer :format "%v") (string :format "%v"))) (group :inline t (const :format "" :value :user) @@ -127,13 +126,15 @@ (choice :tag "Prescript" :value nil (string :format "%v") - (function :format "%v"))) + (function :format "%v") + (const :tag "None" nil))) (group :inline t (const :format "" :value :postscript) (choice :tag "Postscript" :value nil (string :format "%v") - (function :format "%v"))) + (function :format "%v") + (const :tag "None" nil))) (group :inline t (const :format "" :value :function) (function :tag "Function")) @@ -146,7 +147,14 @@ (const apop))) (group :inline t (const :format "" :value :plugged) - (boolean :tag "Plugged")))) + (boolean :tag "Plugged")) + (group :inline t + (const :format "" :value :stream) + (choice :tag "Stream" + :value nil + (const :tag "Clear" nil) + (const starttls) + (const :tag "SSL/TLS" ssl))))) (cons :tag "Maildir (qmail, postfix...)" (const :format "" maildir) (checklist :tag "Options" :greedy t @@ -166,7 +174,7 @@ (const :format "" :value :port) (choice :tag "Port" :value 143 - number string)) + integer string)) (group :inline t (const :format "" :value :user) (string :tag "User")) @@ -210,17 +218,17 @@ (const :format "" webmail) (checklist :tag "Options" :greedy t (group :inline t - (const :format "" :value :subtype) - ;; Should be generated from - ;; `webmail-type-definition', but we - ;; can't require webmail without W3. - (choice :tag "Subtype" - :value hotmail - (const hotmail) - (const yahoo) - (const netaddress) - (const netscape) - (const my-deja))) + (const :format "" :value :subtype) + ;; Should be generated from + ;; `webmail-type-definition', but we + ;; can't require webmail without W3. + (choice :tag "Subtype" + :value hotmail + (const hotmail) + (const yahoo) + (const netaddress) + (const netscape) + (const my-deja))) (group :inline t (const :format "" :value :user) (string :tag "User")) @@ -269,7 +277,7 @@ :group 'mail-source :type 'integer) -(defcustom mail-source-delete-incoming t +(defcustom mail-source-delete-incoming nil "*If non-nil, delete incoming files after handling. If t, delete immediately, if nil, never delete. If a positive number, delete files older than number of days." @@ -350,7 +358,8 @@ (:program) (:function) (:password) - (:authentication password)) + (:authentication password) + (:stream nil)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) (:subdirs ("cur" "new")) @@ -502,7 +511,8 @@ (when (file-exists-p mail-source-crash-box) (message "Processing mail from %s..." mail-source-crash-box) (setq found (mail-source-callback - callback mail-source-crash-box))) + callback mail-source-crash-box)) + (mail-source-delete-crash-box)) (+ found (if (or debug-on-quit debug-on-error) (funcall function source callback) @@ -552,33 +562,33 @@ (delete-file ffile)))))) (defun mail-source-callback (callback info) - "Call CALLBACK on the mail file, and then remove the mail file. -Pass INFO on to CALLBACK." + "Call CALLBACK on the mail file. Pass INFO on to CALLBACK." (if (or (not (file-exists-p mail-source-crash-box)) (zerop (nth 7 (file-attributes mail-source-crash-box)))) (progn (when (file-exists-p mail-source-crash-box) (delete-file mail-source-crash-box)) 0) - (prog1 - (funcall callback mail-source-crash-box info) - (when (file-exists-p mail-source-crash-box) - ;; Delete or move the incoming mail out of the way. - (if (eq mail-source-delete-incoming t) - (delete-file mail-source-crash-box) - (let ((incoming - (mm-make-temp-file - (expand-file-name - mail-source-incoming-file-prefix - mail-source-directory)))) - (unless (file-exists-p (file-name-directory incoming)) - (make-directory (file-name-directory incoming) t)) - (rename-file mail-source-crash-box incoming t) - ;; remove old incoming files? - (when (natnump mail-source-delete-incoming) - (mail-source-delete-old-incoming - mail-source-delete-incoming - mail-source-delete-old-incoming-confirm)))))))) + (funcall callback mail-source-crash-box info))) + +(defun mail-source-delete-crash-box () + (when (file-exists-p mail-source-crash-box) + ;; Delete or move the incoming mail out of the way. + (if (eq mail-source-delete-incoming t) + (delete-file mail-source-crash-box) + (let ((incoming + (mm-make-temp-file + (expand-file-name + mail-source-incoming-file-prefix + mail-source-directory)))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) + (rename-file mail-source-crash-box incoming t) + ;; remove old incoming files? + (when (natnump mail-source-delete-incoming) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm)))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -670,12 +680,20 @@ (sleep-for delay))) (defun mail-source-call-script (script) - (let ((background nil)) + (let ((background nil) + (stderr (get-buffer-create " *mail-source-stderr*")) + result) (when (string-match "& *$" script) (setq script (substring script 0 (match-beginning 0)) background 0)) - (call-process shell-file-name nil background nil - shell-command-switch script))) + (setq result + (call-process shell-file-name nil background nil + shell-command-switch script)) + (when (and result + (not (zerop result))) + (set-buffer stderr) + (message "Mail source error: %s" (buffer-string))) + (kill-buffer stderr))) ;;; ;;; Different fetchers @@ -692,7 +710,8 @@ (prog1 (mail-source-callback callback path) (mail-source-run-script - postscript (format-spec-make ?t mail-source-crash-box))) + postscript (format-spec-make ?t mail-source-crash-box)) + (mail-source-delete-crash-box)) 0)))) (defun mail-source-fetch-directory (source callback) @@ -707,13 +726,15 @@ (when (and (file-regular-p file) (funcall predicate file) (mail-source-movemail file mail-source-crash-box)) - (incf found (mail-source-callback callback file)))) - (mail-source-run-script postscript (format-spec-make ?t path)) + (incf found (mail-source-callback callback file)) + (mail-source-run-script postscript (format-spec-make ?t path)) + (mail-source-delete-crash-box))) found))) (defun mail-source-fetch-pop (source callback) "Fetcher for single-file sources." (mail-source-bind (pop source) + ;; fixme: deal with stream type in format specs (mail-source-run-script prescript (format-spec-make ?p password ?t mail-source-crash-box @@ -748,7 +769,8 @@ (pop3-mailhost server) (pop3-port port) (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) + (if (eq authentication 'apop) 'apop 'pass)) + (pop3-stream-type stream)) (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) (condition-case err @@ -773,7 +795,8 @@ (mail-source-run-script postscript (format-spec-make ?p password ?t mail-source-crash-box - ?s server ?P port ?u user)))) + ?s server ?P port ?u user)) + (mail-source-delete-crash-box))) ;; We nix out the password in case the error ;; was because of a wrong password being given. (setq mail-source-password-cache @@ -865,11 +888,6 @@ (defvar mail-source-report-new-mail-timer nil) (defvar mail-source-report-new-mail-idle-timer nil) -(eval-when-compile - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer))) - (defun mail-source-start-idle-timer () ;; Start our idle timer if necessary, so we delay the check until the ;; user isn't typing. @@ -912,7 +930,7 @@ (setq display-time-mail-function #'mail-source-new-mail-p) ;; Set up the main timer. (setq mail-source-report-new-mail-timer - (nnheader-run-at-time + (run-at-time (* 60 mail-source-report-new-mail-interval) (* 60 mail-source-report-new-mail-interval) #'mail-source-start-idle-timer)) @@ -957,7 +975,8 @@ ;; MMDF mail format (insert "\001\001\001\001\n")) (delete-file file))))) - (incf found (mail-source-callback callback file)))))) + (incf found (mail-source-callback callback file)) + (mail-source-delete-crash-box))))) found))) (eval-and-compile @@ -1018,11 +1037,13 @@ (insert "From imap " (current-time-string) "\n") (save-excursion (insert str "\n\n")) - (while (re-search-forward "^From " nil t) + (while (let ((case-fold-search nil)) + (re-search-forward "^From " nil t)) (replace-match ">From ")) (goto-char (point-max)))) (nnheader-ms-strip-cr)) (incf found (mail-source-callback callback server)) + (mail-source-delete-crash-box) (when (and remove fetchflag) (setq remove (nreverse remove)) (imap-message-flags-add @@ -1068,7 +1089,8 @@ (push (cons (format "webmail:%s:%s" subtype user) password) mail-source-password-cache))) (webmail-fetch mail-source-crash-box subtype user password) - (mail-source-callback callback (symbol-name subtype))))) + (mail-source-callback callback (symbol-name subtype)) + (mail-source-delete-crash-box)))) (provide 'mail-source) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mailcap.el --- a/lisp/gnus/mailcap.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mailcap.el Sun Oct 28 09:18:39 2007 +0000 @@ -254,7 +254,11 @@ ("html" (viewer . mm-w3-prepare-buffer) (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html"))) + (type . "text/html")) + ("dns" + (viewer . dns-mode) + (test . (fboundp 'dns-mode)) + (type . "text/dns"))) ("video" ("mpeg" (viewer . "mpeg_play %s") @@ -852,6 +856,7 @@ (".sit" . "application/x-stuffit") (".siv" . "application/sieve") (".snd" . "audio/basic") + (".soa" . "text/dns") (".src" . "application/x-wais-source") (".tar" . "archive/tar") (".tcl" . "application/x-tcl") diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/md4.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/md4.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,228 @@ +;;; md4.el --- MD4 Message Digest Algorithm. + +;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Copyright (C) 2001 Taro Kawagishi +;; Author: Taro Kawagishi +;; Keywords: MD4 +;; Version: 1.00 +;; Created: February 2001 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Code: + +;;; +;;; MD4 hash calculation + +(defvar md4-buffer (make-vector 4 '(0 . 0)) + "work buffer of four 32-bit integers") + +(defun md4 (in n) + "Returns the MD4 hash string of 16 bytes long for a string IN of N +bytes long. N is required to handle strings containing character 0." + (let (m + (b (cons 0 (* n 8))) + (i 0) + (buf (make-string 128 0)) c4) + ;; initial values + (aset md4-buffer 0 '(26437 . 8961)) ;0x67452301 + (aset md4-buffer 1 '(61389 . 43913)) ;0xefcdab89 + (aset md4-buffer 2 '(39098 . 56574)) ;0x98badcfe + (aset md4-buffer 3 '(4146 . 21622)) ;0x10325476 + + ;; process the string in 64 bits chunks + (while (> n 64) + (setq m (md4-copy64 (substring in 0 64))) + (md4-64 m) + (setq in (substring in 64)) + (setq n (- n 64))) + + ;; process the rest of the string (length is now n <= 64) + (setq i 0) + (while (< i n) + (aset buf i (aref in i)) + (setq i (1+ i))) + (aset buf n 128) ;0x80 + (if (<= n 55) + (progn + (setq c4 (md4-pack-int32 b)) + (aset buf 56 (aref c4 0)) + (aset buf 57 (aref c4 1)) + (aset buf 58 (aref c4 2)) + (aset buf 59 (aref c4 3)) + (setq m (md4-copy64 buf)) + (md4-64 m)) + ;; else + (setq c4 (md4-pack-int32 b)) + (aset buf 120 (aref c4 0)) + (aset buf 121 (aref c4 1)) + (aset buf 122 (aref c4 2)) + (aset buf 123 (aref c4 3)) + (setq m (md4-copy64 buf)) + (md4-64 m) + (setq m (md4-copy64 (substring buf 64))) + (md4-64 m))) + + (concat (md4-pack-int32 (aref md4-buffer 0)) + (md4-pack-int32 (aref md4-buffer 1)) + (md4-pack-int32 (aref md4-buffer 2)) + (md4-pack-int32 (aref md4-buffer 3)))) + +(defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z))) +(defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z))) +(defsubst md4-H (x y z) (logxor x y z)) + +(defmacro md4-make-step (name func) + `(defun ,name (a b c d xk s ac) + (let* + ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac))) + (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) + (h2 (logand 65535 (+ h1 (lsh l1 -16)))) + (l2 (logand 65535 l1)) + ;; cyclic shift of 32 bits integer + (h3 (logand 65535 (if (> s 15) + (+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) + (+ (lsh h2 s) (lsh l2 (- s 16)))))) + (l3 (logand 65535 (if (> s 15) + (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) + (+ (lsh l2 s) (lsh h2 (- s 16))))))) + (cons h3 l3)))) + +(md4-make-step md4-round1 md4-F) +(md4-make-step md4-round2 md4-G) +(md4-make-step md4-round3 md4-H) + +(defsubst md4-add (x y) + "Return 32-bit sum of 32-bit integers X and Y." + (let ((h (+ (car x) (car y))) + (l (+ (cdr x) (cdr y)))) + (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l)))) + +(defsubst md4-and (x y) + (cons (logand (car x) (car y)) (logand (cdr x) (cdr y)))) + +(defun md4-64 (m) + "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of +32 bits integers. The resulting md4 value is placed in md4-buffer." + (let ((a (aref md4-buffer 0)) + (b (aref md4-buffer 1)) + (c (aref md4-buffer 2)) + (d (aref md4-buffer 3))) + (setq a (md4-round1 a b c d (aref m 0) 3 '(0 . 0)) + d (md4-round1 d a b c (aref m 1) 7 '(0 . 0)) + c (md4-round1 c d a b (aref m 2) 11 '(0 . 0)) + b (md4-round1 b c d a (aref m 3) 19 '(0 . 0)) + a (md4-round1 a b c d (aref m 4) 3 '(0 . 0)) + d (md4-round1 d a b c (aref m 5) 7 '(0 . 0)) + c (md4-round1 c d a b (aref m 6) 11 '(0 . 0)) + b (md4-round1 b c d a (aref m 7) 19 '(0 . 0)) + a (md4-round1 a b c d (aref m 8) 3 '(0 . 0)) + d (md4-round1 d a b c (aref m 9) 7 '(0 . 0)) + c (md4-round1 c d a b (aref m 10) 11 '(0 . 0)) + b (md4-round1 b c d a (aref m 11) 19 '(0 . 0)) + a (md4-round1 a b c d (aref m 12) 3 '(0 . 0)) + d (md4-round1 d a b c (aref m 13) 7 '(0 . 0)) + c (md4-round1 c d a b (aref m 14) 11 '(0 . 0)) + b (md4-round1 b c d a (aref m 15) 19 '(0 . 0)) + + a (md4-round2 a b c d (aref m 0) 3 '(23170 . 31129)) ;0x5A827999 + d (md4-round2 d a b c (aref m 4) 5 '(23170 . 31129)) + c (md4-round2 c d a b (aref m 8) 9 '(23170 . 31129)) + b (md4-round2 b c d a (aref m 12) 13 '(23170 . 31129)) + a (md4-round2 a b c d (aref m 1) 3 '(23170 . 31129)) + d (md4-round2 d a b c (aref m 5) 5 '(23170 . 31129)) + c (md4-round2 c d a b (aref m 9) 9 '(23170 . 31129)) + b (md4-round2 b c d a (aref m 13) 13 '(23170 . 31129)) + a (md4-round2 a b c d (aref m 2) 3 '(23170 . 31129)) + d (md4-round2 d a b c (aref m 6) 5 '(23170 . 31129)) + c (md4-round2 c d a b (aref m 10) 9 '(23170 . 31129)) + b (md4-round2 b c d a (aref m 14) 13 '(23170 . 31129)) + a (md4-round2 a b c d (aref m 3) 3 '(23170 . 31129)) + d (md4-round2 d a b c (aref m 7) 5 '(23170 . 31129)) + c (md4-round2 c d a b (aref m 11) 9 '(23170 . 31129)) + b (md4-round2 b c d a (aref m 15) 13 '(23170 . 31129)) + + a (md4-round3 a b c d (aref m 0) 3 '(28377 . 60321)) ;0x6ED9EBA1 + d (md4-round3 d a b c (aref m 8) 9 '(28377 . 60321)) + c (md4-round3 c d a b (aref m 4) 11 '(28377 . 60321)) + b (md4-round3 b c d a (aref m 12) 15 '(28377 . 60321)) + a (md4-round3 a b c d (aref m 2) 3 '(28377 . 60321)) + d (md4-round3 d a b c (aref m 10) 9 '(28377 . 60321)) + c (md4-round3 c d a b (aref m 6) 11 '(28377 . 60321)) + b (md4-round3 b c d a (aref m 14) 15 '(28377 . 60321)) + a (md4-round3 a b c d (aref m 1) 3 '(28377 . 60321)) + d (md4-round3 d a b c (aref m 9) 9 '(28377 . 60321)) + c (md4-round3 c d a b (aref m 5) 11 '(28377 . 60321)) + b (md4-round3 b c d a (aref m 13) 15 '(28377 . 60321)) + a (md4-round3 a b c d (aref m 3) 3 '(28377 . 60321)) + d (md4-round3 d a b c (aref m 11) 9 '(28377 . 60321)) + c (md4-round3 c d a b (aref m 7) 11 '(28377 . 60321)) + b (md4-round3 b c d a (aref m 15) 15 '(28377 . 60321))) + + (aset md4-buffer 0 (md4-add a (aref md4-buffer 0))) + (aset md4-buffer 1 (md4-add b (aref md4-buffer 1))) + (aset md4-buffer 2 (md4-add c (aref md4-buffer 2))) + (aset md4-buffer 3 (md4-add d (aref md4-buffer 3))) + )) + +(defun md4-copy64 (seq) + "Unpack a 64 bytes string into 16 pairs of 32 bits integers." + (let ((int32s (make-vector 16 0)) (i 0) j) + (while (< i 16) + (setq j (* i 4)) + (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) + (+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) + (setq i (1+ i))) + int32s)) + +;;; +;;; sub functions + +(defun md4-pack-int16 (int16) + "Pack 16 bits integer in 2 bytes string as little endian." + (let ((str (make-string 2 0))) + (aset str 0 (logand int16 255)) + (aset str 1 (lsh int16 -8)) + str)) + +(defun md4-pack-int32 (int32) + "Pack 32 bits integer in a 4 bytes string as little endian. A 32 bits +integer is represented as a pair of two 16 bits integers (cons high low)." + (let ((str (make-string 4 0)) + (h (car int32)) (l (cdr int32))) + (aset str 0 (logand l 255)) + (aset str 1 (lsh l -8)) + (aset str 2 (logand h 255)) + (aset str 3 (lsh h -8)) + str)) + +(defun md4-unpack-int16 (str) + (if (eq 2 (length str)) + (+ (lsh (aref str 1) 8) (aref str 0)) + (error "%s is not 2 bytes long" str))) + +(defun md4-unpack-int32 (str) + (if (eq 4 (length str)) + (cons (+ (lsh (aref str 3) 8) (aref str 2)) + (+ (lsh (aref str 1) 8) (aref str 0))) + (error "%s is not 4 bytes long" str))) + +(provide 'md4) + +;;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e +;;; md4.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/message.el --- a/lisp/gnus/message.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/message.el Sun Oct 28 09:18:39 2007 +0000 @@ -35,6 +35,7 @@ (require 'cl) (defvar gnus-message-group-art) (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary +(require 'hashcash) (require 'canlock) (require 'mailheader) (require 'gmm-utils) @@ -48,10 +49,8 @@ (require 'mail-parse) (require 'mml) (require 'rfc822) -(eval-and-compile - (autoload 'gnus-find-method-for-group "gnus") - (autoload 'nnvirtual-find-group-art "nnvirtual") - (autoload 'gnus-group-decoded-name "gnus-group")) +(require 'ecomplete) + (defgroup message '((user-mail-address custom-variable) (user-full-name custom-variable)) @@ -156,7 +155,6 @@ :group 'message-interface :type 'regexp) -;;;###autoload (defcustom message-from-style 'default "*Specifies how \"From\" headers look. @@ -211,7 +209,7 @@ :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) -(defcustom message-draft-headers '(References From) +(defcustom message-draft-headers '(References From Date) "*Headers to be generated when saving a draft message." :version "22.1" :group 'message-news @@ -271,7 +269,7 @@ :link '(custom-manual "(message)Mail Headers") :type 'regexp) -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:" +(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:" "*Header lines matching this regexp will be deleted before posting. It's best to delete old Path and Date headers before posting to avoid any confusion." @@ -304,7 +302,7 @@ :version "22.1" :type '(choice (const :tag "never" nil) (const :tag "always strip" t) - (const ask)) + (const ask)) :link '(custom-manual "(message)Message Headers") :group 'message-various) @@ -411,7 +409,6 @@ ;;; End of variables adopted from `message-utils.el'. -;;;###autoload (defcustom message-signature-separator "^-- *$" "Regexp matching the signature separator." :type 'regexp @@ -470,6 +467,13 @@ :link '(custom-manual "(message)Message Buffers") :type 'boolean) +(defcustom message-kill-buffer-query t + "*Non-nil means that killing a modified message buffer has to be confirmed. +This is used by `message-kill-buffer'." + :version "23.0" ;; No Gnus + :group 'message-buffers + :type 'boolean) + (eval-when-compile (defvar gnus-local-organization)) (defcustom message-user-organization @@ -484,8 +488,14 @@ :type '(choice string (const :tag "consult file" t))) -;;;###autoload -(defcustom message-user-organization-file "/usr/lib/news/organization" +(defcustom message-user-organization-file + (let (orgfile) + (dolist (f (list "/etc/organization" + "/etc/news/organization" + "/usr/lib/news/organization")) + (when (file-readable-p f) + (setq orgfile f))) + orgfile) "*Local news organization file." :type 'file :link '(custom-manual "(message)News Headers") @@ -578,15 +588,13 @@ (if (string-match "[[:digit:]]" "1") ;; support POSIX? "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+" ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. - (let ((old-table (syntax-table)) - non-word-constituents) - (set-syntax-table text-mode-syntax-table) - (setq non-word-constituents - (concat - (if (string-match "\\w" "-") "" "-") - (if (string-match "\\w" "_") "" "_") - (if (string-match "\\w" ".") "" "."))) - (set-syntax-table old-table) + (let (non-word-constituents) + (with-syntax-table text-mode-syntax-table + (setq non-word-constituents + (concat + (if (string-match "\\w" "-") "" "-") + (if (string-match "\\w" "_") "" "_") + (if (string-match "\\w" ".") "" ".")))) (if (equal non-word-constituents "") "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+" (concat "\\([ \t]*\\(\\w\\|[" @@ -596,7 +604,13 @@ :version "22.1" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") - :type 'regexp) + :type 'regexp + :set (lambda (symbol value) + (prog1 + (custom-set-default symbol value) + (if (boundp 'gnus-message-cite-prefix-regexp) + (setq gnus-message-cite-prefix-regexp + (concat "^\\(?:" value "\\)")))))) (defcustom message-cancel-message "I am canceling my own article.\n" "Message to be inserted in the cancel message." @@ -605,8 +619,20 @@ :type 'string) ;; Useful to set in site-init.el -;;;###autoload -(defcustom message-send-mail-function 'message-send-mail-with-sendmail +(defcustom message-send-mail-function + (let ((program (if (boundp 'sendmail-program) + ;; see paths.el + sendmail-program))) + (cond + ((and program + (string-match "/" program) ;; Skip path + (file-executable-p program)) + 'message-send-mail-with-sendmail) + ((and program + (executable-find program)) + 'message-send-mail-with-sendmail) + (t + 'smtpmail-send-it))) "Function to call to send the current buffer as mail. The headers should be delimited by a line whose contents match the variable `mail-header-separator'. @@ -660,6 +686,12 @@ :link '(custom-manual "(message)Followup") :type '(choice function (const nil))) +(defcustom message-extra-wide-headers nil + "If non-nil, a list of additional address headers. +These are used when composing a wide reply." + :group 'message-sending + :type '(repeat string)) + (defcustom message-use-followup-to 'ask "*Specifies what to do with Followup-To header. If nil, always ignore the header. If it is t, use its value, but @@ -756,6 +788,14 @@ :link '(custom-manual "(message)Mail Variables") :group 'message-sending) +(defcustom message-sendmail-extra-arguments nil + "Additional arguments to `sendmail-program'." + ;; E.g. '("-a" "account") for msmtp + :version "23.0" ;; No Gnus + :type '(repeat string) + ;; :link '(custom-manual "(message)Mail Variables") + :group 'message-sending) + ;; qmail-related stuff (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" "Location of the qmail-inject program." @@ -776,11 +816,6 @@ :type '(choice (function) (repeat string))) -(defvar message-cater-to-broken-inn t - "Non-nil means Gnus should not fold the `References' header. -Folding `References' makes ancient versions of INN create incorrect -NOV lines.") - (eval-when-compile (defvar gnus-post-method) (defvar gnus-select-method)) @@ -817,9 +852,18 @@ :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "None" nil) - (const :tag "References" '(references)) - (const :tag "All" t) - (repeat (sexp :tag "Header")))) + (const :tag "References" '(references)) + (const :tag "All" t) + (repeat (sexp :tag "Header")))) + +(defcustom message-fill-column 72 + "Column beyond which automatic line-wrapping should happen. +Local value for message buffers. If non-nil, also turn on +auto-fill in message buffers." + :group 'message-various + ;; :link '(custom-manual "(message)Message Headers") + :type '(choice (const :tag "Don't turn on auto fill" nil) + (integer))) (defcustom message-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. @@ -866,31 +910,71 @@ :version "22.1" :group 'message-various) -;;;###autoload (defcustom message-citation-line-function 'message-insert-citation-line "*Function called to insert the \"Whomever writes:\" line. +Predefined functions include `message-insert-citation-line' and +`message-insert-formated-citation-line' (see the variable +`message-citation-line-format'). + Note that Gnus provides a feature where the reader can click on `writes:' to hide the cited text. If you change this line too much, people who read your message will have to change their Gnus configuration. See the variable `gnus-cite-attribution-suffix'." - :type 'function + :type '(choice + (function-item :tag "plain" message-insert-citation-line) + (function-item :tag "formatted" message-insert-formated-citation-line) + (function :tag "Other")) :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) -;;;###autoload +(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n" + "Format of the \"Whomever writes:\" line. + +The string is formatted using `format-spec'. The following +constructs are replaced: + + %f The full From, e.g. \"John Doe \". + %n The mail address, e.g. \"john.doe@example.invalid\". + %N The real name if present, e.g.: \"John Doe\", else fall + back to the mail address. + %F The first name if present, e.g.: \"John\". + %L The last name if present, e.g.: \"Doe\". + +All other format specifiers are passed to `format-time-string' +which is called using the date from the article your replying to. +Extracting the first (%F) and last name (%L) is done +heuristically, so you should always check it yourself. + +Please also read the note in the documentation of +`message-citation-line-function'." + :type '(choice (const :tag "Plain" "%f writes:") + (const :tag "Include date" "On %a, %b %d %Y, %n wrote:") + string) + :link '(custom-manual "(message)Insertion Variables") + :version "23.0" ;; No Gnus + :group 'message-insertion) + (defcustom message-yank-prefix "> " "*Prefix inserted on the lines of yanked messages. Fix `message-cite-prefix-regexp' if it is set to an abnormal value. -See also `message-yank-cited-prefix'." +See also `message-yank-cited-prefix' and `message-yank-empty-prefix'." :type 'string :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) (defcustom message-yank-cited-prefix ">" - "*Prefix inserted on cited or empty lines of yanked messages. + "*Prefix inserted on cited lines of yanked messages. Fix `message-cite-prefix-regexp' if it is set to an abnormal value. -See also `message-yank-prefix'." +See also `message-yank-prefix' and `message-yank-empty-prefix'." + :version "22.1" + :type 'string + :link '(custom-manual "(message)Insertion Variables") + :group 'message-insertion) + +(defcustom message-yank-empty-prefix ">" + "*Prefix inserted on empty lines of yanked messages. +See also `message-yank-prefix' and `message-yank-cited-prefix'." :version "22.1" :type 'string :link '(custom-manual "(message)Insertion Variables") @@ -903,12 +987,11 @@ :link '(custom-manual "(message)Insertion Variables") :type 'integer) -;;;###autoload (defcustom message-cite-function 'message-cite-original "*Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. -Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil." +Note that these functions use `mail-citation-hook' if that is non-nil." :type '(radio (function-item message-cite-original) (function-item message-cite-original-without-signature) (function-item sc-cite-original) @@ -916,7 +999,6 @@ :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) -;;;###autoload (defcustom message-indent-citation-function 'message-indent-citation "*Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the @@ -926,7 +1008,6 @@ :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) -;;;###autoload (defcustom message-signature t "*String to be inserted at the end of the message buffer. If t, the `message-signature-file' file will be inserted instead. @@ -936,16 +1017,26 @@ :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) -;;;###autoload (defcustom message-signature-file "~/.signature" "*Name of file containing the text inserted at end of message buffer. Ignored if the named file doesn't exist. -If nil, don't insert a signature." +If nil, don't insert a signature. +If a path is specified, the value of `message-signature-directory' is ignored, +even if set." :type '(choice file (const :tags "None" nil)) :link '(custom-manual "(message)Insertion Variables") :group 'message-insertion) -;;;###autoload +(defcustom message-signature-directory nil + "*Name of directory containing signature files. +Comes in handy if you have many such files, handled via posting styles for +instance. +If nil, `message-signature-file' is expected to specify the directory if +needed." + :type '(choice string (const :tags "None" nil)) + :link '(custom-manual "(message)Insertion Variables") + :group 'message-insertion) + (defcustom message-signature-insert-empty-line t "*If non-nil, insert an empty line before the signature separator." :version "22.1" @@ -1075,13 +1166,25 @@ (defcustom message-mail-alias-type 'abbrev "*What alias expansion type to use in Message buffers. -The default is `abbrev', which uses mailabbrev. nil switches -mail aliases off." +The default is `abbrev', which uses mailabbrev. `ecomplete' uses +an electric completion mode. nil switches mail aliases off. +This can also be a list of values." :group 'message :link '(custom-manual "(message)Mail Aliases") :type '(choice (const :tag "Use Mailabbrev" abbrev) + (const :tag "Use ecomplete" ecomplete) (const :tag "No expansion" nil))) +(defcustom message-self-insert-commands '(self-insert-command) + "List of `self-insert-command's used to trigger ecomplete. +When one of those commands is invoked to enter a character in To or Cc +header, ecomplete will suggest the candidates of recipients (see also +`message-mail-alias-type'). If you use some tool to enter non-ASCII +text and it replaces `self-insert-command' with the other command, e.g. +`egg-self-insert-command', you may want to add it to this list." + :group 'message-various + :type '(repeat function)) + (defcustom message-auto-save-directory (file-name-as-directory (nnheader-concat message-directory "drafts")) "*Directory where Message auto-saves buffers if Gnus isn't running. @@ -1101,13 +1204,18 @@ (defcustom message-dont-reply-to-names (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) - "*A regexp specifying addresses to prune when doing wide replies. -A value of nil means exclude your own user name only." + "*Addresses to prune when doing wide replies. +This can be a regexp or a list of regexps. Also, a value of nil means +exclude your own user name only." :version "21.1" :group 'message :link '(custom-manual "(message)Wide Reply") :type '(choice (const :tag "Yourself" nil) - regexp)) + regexp + (repeat :tag "Regexp List" regexp))) + +(defsubst message-dont-reply-to-names () + (gmm-regexp-concat message-dont-reply-to-names)) (defvar message-shoot-gnksa-feet nil "*A list of GNKSA feet you are allowed to shoot. @@ -1119,20 +1227,34 @@ `quoted-text-only' Allow you to post quoted text only; `multiple-copies' Allow you to post multiple copies; `cancel-messages' Allow you to cancel or supersede messages from - your other email addresses.") + your other email addresses.") (defsubst message-gnksa-enable-p (feature) (or (not (listp message-shoot-gnksa-feet)) (memq feature message-shoot-gnksa-feet))) -(defcustom message-hidden-headers nil +(defcustom message-hidden-headers '("^References:" "^Face:" "^X-Face:" + "^X-Draft-From:") "Regexp of headers to be hidden when composing new messages. This can also be a list of regexps to match headers. Or a list starting with `not' and followed by regexps." :version "22.1" :group 'message :link '(custom-manual "(message)Message Headers") - :type '(repeat regexp)) + :type '(choice + :format "%{%t%}: %[Value Type%] %v" + (regexp :menu-tag "regexp" :format "regexp\n%t: %v") + (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i" + (regexp :format "%t: %v")) + (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v" + (const not) + (repeat :format "%v%i" + (regexp :format "%t: %v"))))) + +(defcustom message-cite-articles-with-x-no-archive t + "If non-nil, cite text from articles that has X-No-Archive set." + :group 'message + :type 'boolean) ;;; Internal variables. ;;; Well, not really internal. @@ -1148,7 +1270,7 @@ (defface message-header-to '((((class color) (background dark)) - (:foreground "green2" :bold t)) + (:foreground "DarkOliveGreen1" :bold t)) (((class color) (background light)) (:foreground "MidnightBlue" :bold t)) @@ -1162,7 +1284,7 @@ (defface message-header-cc '((((class color) (background dark)) - (:foreground "green4" :bold t)) + (:foreground "chartreuse1" :bold t)) (((class color) (background light)) (:foreground "MidnightBlue")) @@ -1176,7 +1298,7 @@ (defface message-header-subject '((((class color) (background dark)) - (:foreground "green3")) + (:foreground "OliveDrab1")) (((class color) (background light)) (:foreground "navy blue" :bold t)) @@ -1204,7 +1326,7 @@ (defface message-header-other '((((class color) (background dark)) - (:foreground "#b00000")) + (:foreground "VioletRed1")) (((class color) (background light)) (:foreground "steel blue")) @@ -1218,7 +1340,7 @@ (defface message-header-name '((((class color) (background dark)) - (:foreground "DarkGreen")) + (:foreground "green")) (((class color) (background light)) (:foreground "cornflower blue")) @@ -1232,7 +1354,7 @@ (defface message-header-xheader '((((class color) (background dark)) - (:foreground "blue")) + (:foreground "DeepSkyBlue1")) (((class color) (background light)) (:foreground "blue")) @@ -1246,7 +1368,7 @@ (defface message-separator '((((class color) (background dark)) - (:foreground "blue3")) + (:foreground "LightSkyBlue1")) (((class color) (background light)) (:foreground "brown")) @@ -1260,7 +1382,7 @@ (defface message-cited-text '((((class color) (background dark)) - (:foreground "red")) + (:foreground "LightPink1")) (((class color) (background light)) (:foreground "red")) @@ -1274,7 +1396,7 @@ (defface message-mml '((((class color) (background dark)) - (:foreground "ForestGreen")) + (:foreground "MediumSpringGreen")) (((class color) (background light)) (:foreground "ForestGreen")) @@ -1322,13 +1444,13 @@ (1 'message-header-name) (2 'message-header-newsgroups nil t)) (,(message-font-lock-make-header-matcher + (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) + (1 'message-header-name) + (2 'message-header-xheader)) + (,(message-font-lock-make-header-matcher (concat "^\\([A-Z][^: \n\t]+:\\)" content)) (1 'message-header-name) (2 'message-header-other nil t)) - (,(message-font-lock-make-header-matcher - (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content)) - (1 'message-header-name) - (2 'message-header-name)) ,@(if (and mail-header-separator (not (equal mail-header-separator ""))) `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") @@ -1350,10 +1472,10 @@ (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t)) (defvar message-face-alist - '((bold . bold-region) + '((bold . message-bold-region) (underline . underline-region) (default . (lambda (b e) - (unbold-region b e) + (message-unbold-region b e) (ununderline-region b e)))) "Alist of mail and news faces for facemenu. The cdr of each entry is a function for applying the face to a region.") @@ -1493,6 +1615,19 @@ (const :tag "Never" nil) (const :tag "Always" t))) +(defcustom message-generate-hashcash (if (executable-find "hashcash") t) + "*Whether to generate X-Hashcash: headers. +If `t', always generate hashcash headers. If `opportunistic', +only generate hashcash headers if it can be done without the user +waiting (i.e., only asynchronously). + +You must have the \"hashcash\" binary installed, see `hashcash-path'." + :group 'message-headers + :link '(custom-manual "(message)Mail Headers") + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Opportunistic" opportunistic))) + ;;; Internal variables. (defvar message-sending-message "Sending...") @@ -1575,10 +1710,17 @@ "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") +(defvar message-field-fillers + '((To message-fill-field-address) + (Cc message-fill-field-address) + (From message-fill-field-address)) + "Alist of header names/filler functions.") + (defvar message-header-format-alist - `((Newsgroups) - (To . message-fill-address) - (Cc . message-fill-address) + `((From) + (Newsgroups) + (To) + (Cc) (Subject) (In-Reply-To) (Fcc) @@ -1622,28 +1764,32 @@ :type 'regexp) (eval-and-compile + (autoload 'gnus-alive-p "gnus-util") + (autoload 'gnus-delay-article "gnus-delay") + (autoload 'gnus-extract-address-components "gnus-util") + (autoload 'gnus-find-method-for-group "gnus") + (autoload 'gnus-group-decoded-name "gnus-group") + (autoload 'gnus-group-name-charset "gnus-group") + (autoload 'gnus-group-name-decode "gnus-group") + (autoload 'gnus-groups-from-server "gnus") + (autoload 'gnus-make-local-hook "gnus-util") + (autoload 'gnus-open-server "gnus-int") + (autoload 'gnus-output-to-mail "gnus-util") + (autoload 'gnus-output-to-rmail "gnus-util") + (autoload 'gnus-request-post "gnus-int") + (autoload 'gnus-select-frame-set-input-focus "gnus-util") + (autoload 'gnus-server-string "gnus") (autoload 'idna-to-ascii "idna") (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") (autoload 'mh-send-letter "mh-comp") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-point-at-bol "gnus-util") - (autoload 'gnus-output-to-rmail "gnus-util") - (autoload 'gnus-output-to-mail "gnus-util") (autoload 'nndraft-request-associate-buffer "nndraft") (autoload 'nndraft-request-expire-articles "nndraft") - (autoload 'gnus-open-server "gnus-int") - (autoload 'gnus-request-post "gnus-int") - (autoload 'gnus-alive-p "gnus-util") - (autoload 'gnus-server-string "gnus") - (autoload 'gnus-group-name-charset "gnus-group") - (autoload 'gnus-group-name-decode "gnus-group") - (autoload 'gnus-groups-from-server "gnus") - (autoload 'rmail-output "rmailout") - (autoload 'gnus-delay-article "gnus-delay") - (autoload 'gnus-make-local-hook "gnus-util") - (autoload 'gnus-extract-address-components "gnus-util") - (autoload 'gnus-select-frame-set-input-focus "gnus-util")) + (autoload 'nnvirtual-find-group-art "nnvirtual") + (autoload 'rmail-dont-reply-to "mail-utils") + (autoload 'rmail-msg-is-pruned "rmail") + (autoload 'rmail-msg-restore-non-pruned-header "rmail") + (autoload 'rmail-output "rmailout")) @@ -1723,12 +1869,10 @@ The buffer is expected to be narrowed to just the header of the message; see `message-narrow-to-headers-or-head'." (let* ((inhibit-point-motion-hooks t) - (case-fold-search t) (value (mail-fetch-field header nil (not not-all)))) (when value (while (string-match "\n[\t ]+" value) (setq value (replace-match " " t t value))) - (set-text-properties 0 (length value) nil value) value))) (defun message-field-value (header &optional not-all) @@ -1741,14 +1885,14 @@ (defun message-narrow-to-field () "Narrow the buffer to the header on the current line." (beginning-of-line) + (while (looking-at "[ \t]") + (forward-line -1)) (narrow-to-region (point) (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (progn - (beginning-of-line) - (point)) + (point-at-bol) (point-max)))) (goto-char (point-min))) @@ -1964,28 +2108,30 @@ " (was: " old-subject ")\n"))))))))) -(defun message-mark-inserted-region (beg end) +(defun message-mark-inserted-region (beg end &optional verbatim) "Mark some region in the current article with enclosing tags. -See `message-mark-insert-begin' and `message-mark-insert-end'." - (interactive "r") +See `message-mark-insert-begin' and `message-mark-insert-end'. +If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." + (interactive "r\nP") (save-excursion ;; add to the end of the region first, otherwise end would be invalid (goto-char end) - (insert message-mark-insert-end) + (insert (if verbatim "#v-\n" message-mark-insert-end)) (goto-char beg) - (insert message-mark-insert-begin))) - -(defun message-mark-insert-file (file) + (insert (if verbatim "#v+\n" message-mark-insert-begin)))) + +(defun message-mark-insert-file (file &optional verbatim) "Insert FILE at point, marking it with enclosing tags. -See `message-mark-insert-begin' and `message-mark-insert-end'." - (interactive "fFile to insert: ") +See `message-mark-insert-begin' and `message-mark-insert-end'. +If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")." + (interactive "fFile to insert: \nP") ;; reverse insertion to get correct result. (let ((p (point))) - (insert message-mark-insert-end) + (insert (if verbatim "#v-\n" message-mark-insert-end)) (goto-char p) (insert-file-contents file) (goto-char p) - (insert message-mark-insert-begin))) + (insert (if verbatim "#v+\n" message-mark-insert-begin)))) (defun message-add-archive-header () "Insert \"X-No-Archive: Yes\" in the header and a note in the body. @@ -2304,6 +2450,14 @@ (1+ max))))) (message-sort-headers-1)))) +(defun message-kill-address () + "Kill the address under point." + (interactive) + (let ((start (point))) + (message-skip-to-next-address) + (kill-region start (point)))) + + (defun message-info (&optional arg) "Display the Message manual. @@ -2365,6 +2519,7 @@ (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) + (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires) (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\M-n" @@ -2385,18 +2540,20 @@ (define-key message-mode-map "\C-c\C-d" 'message-dont-send) (define-key message-mode-map "\C-c\n" 'gnus-delay-article) + (define-key message-mode-map "\C-c\M-k" 'message-kill-address) (define-key message-mode-map "\C-c\C-e" 'message-elide-region) (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph) (define-key message-mode-map [remap split-line] 'message-split-line) (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) (define-key message-mode-map "\C-a" 'message-beginning-of-line) (define-key message-mode-map "\t" 'message-tab) - (define-key message-mode-map "\M-;" 'comment-region)) + (define-key message-mode-map "\M-;" 'comment-region) + + (define-key message-mode-map "\M-n" 'message-display-abbrev)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -2477,7 +2634,8 @@ ;; ["Followup-To (with note in body)" message-cross-post-followup-to t] ["Crosspost / Followup-To..." message-cross-post-followup-to t] ["Distribution" message-goto-distribution t] - ["X-No-Archive:" message-add-archive-header t ] + ["Expires" message-insert-expires t ] + ["X-No-Archive" message-add-archive-header t ] "----" ;; (typical) mailing-lists stuff ["Fetch To" message-insert-to @@ -2497,6 +2655,8 @@ "----" ["Sort Headers" message-sort-headers t] ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t] + ;; We hide `message-hidden-headers' by narrowing the buffer. + ["Show Hidden Headers" widen t] ["Goto Body" message-goto-body t] ["Goto Signature" message-goto-signature t])) @@ -2555,19 +2715,23 @@ (get-text-property pos 'egg-lang) (get-text-property pos 'egg-start))))) +(defsubst message-mail-alias-type-p (type) + (if (atom message-mail-alias-type) + (eq message-mail-alias-type type) + (memq type message-mail-alias-type))) + (defun message-strip-forbidden-properties (begin end &optional old-length) "Strip forbidden properties between BEGIN and END, ignoring the third arg. This function is intended to be called from `after-change-functions'. See also `message-forbidden-properties'." + (when (and (message-mail-alias-type-p 'ecomplete) + (memq this-command message-self-insert-commands)) + (message-display-abbrev)) (when (and message-strip-special-text-properties (message-tamago-not-in-use-p begin)) (let ((buffer-read-only nil) (inhibit-read-only t)) - (while (not (= begin end)) - (when (not (get-text-property begin 'message-hidden)) - (remove-text-properties begin (1+ begin) - message-forbidden-properties)) - (incf begin))))) + (remove-text-properties begin end message-forbidden-properties)))) ;;;###autoload (define-derived-mode message-mode text-mode "Message" @@ -2581,9 +2745,10 @@ C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-o move to From (\"Originator\") + C-c C-f C-o move to From (\"Originator\") C-c C-f C-f move to Followup-To C-c C-f C-m move to Mail-Followup-To + C-c C-f C-e move to Expires C-c C-f C-i cycle through Importance values C-c C-f s change subject and append \"(was: )\" C-c C-f x crossposting with FollowUp-To header and note in body @@ -2632,6 +2797,9 @@ (set (make-local-variable 'message-checksum) nil) (set (make-local-variable 'message-mime-part) 0) (message-setup-fill-variables) + (when message-fill-column + (setq fill-column message-fill-column) + (turn-on-auto-fill)) ;; Allow using comment commands to add/remove quoting. ;; (set (make-local-variable 'comment-start) message-yank-prefix) (when message-yank-prefix @@ -2651,11 +2819,14 @@ (add-hook 'after-change-functions 'message-strip-forbidden-properties nil 'local) ;; Allow mail alias things. - (when (eq message-mail-alias-type 'abbrev) + (cond + ((message-mail-alias-type-p 'abbrev) (if (fboundp 'mail-abbrevs-setup) (mail-abbrevs-setup) (if (fboundp 'mail-aliases-setup) ; warning avoidance (mail-aliases-setup)))) + ((message-mail-alias-type-p 'ecomplete) + (ecomplete-setup))) (unless buffer-file-name (message-set-auto-save-file-name)) (unless (buffer-base-buffer) @@ -2845,11 +3016,11 @@ prefix FORCE is given." (interactive "P") (let* ((mct (message-fetch-reply-field "mail-copies-to")) - (dont (and mct (or (equal (downcase mct) "never") + (dont (and mct (or (equal (downcase mct) "never") (equal (downcase mct) "nobody")))) - (to (or (message-fetch-reply-field "mail-reply-to") - (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from")))) + (to (or (message-fetch-reply-field "mail-reply-to") + (message-fetch-reply-field "reply-to") + (message-fetch-reply-field "from")))) (when (and dont to) (message (if force @@ -2889,21 +3060,21 @@ ;; (mail-strip-quoted-names "Foo Bar , bla@fasel (Bla Fasel)") (dolist (header headers) (let* ((header-name (symbol-name (car header))) - (new-header (cdr header)) - (synonyms (loop for synonym in message-header-synonyms + (new-header (cdr header)) + (synonyms (loop for synonym in message-header-synonyms when (memq (car header) synonym) return synonym)) - (old-header - (loop for synonym in synonyms + (old-header + (loop for synonym in synonyms for old-header = (mail-fetch-field (symbol-name synonym)) when (and old-header (string-match new-header old-header)) return synonym))) (if old-header - (message "already have `%s' in `%s'" new-header old-header) + (message "already have `%s' in `%s'" new-header old-header) (when (and (message-position-on-field header-name) - (setq old-header (mail-fetch-field header-name)) - (not (string-match "\\` *\\'" old-header))) + (setq old-header (mail-fetch-field header-name)) + (not (string-match "\\` *\\'" old-header))) (insert ", ")) - (insert new-header))))) + (insert new-header))))) (defun message-widen-reply () "Widen the reply to include maximum recipients." @@ -2961,22 +3132,30 @@ (when (message-goto-signature) (forward-line -2))) -(defun message-kill-to-signature () - "Deletes all text up to the signature." - (interactive) - (let ((point (point))) - (message-goto-signature) - (unless (eobp) - (end-of-line -1)) - (kill-region point (point)) - (unless (bolp) - (insert "\n")))) +(defun message-kill-to-signature (&optional arg) + "Kill all text up to the signature. +If a numberic argument or prefix arg is given, leave that number +of lines before the signature intact." + (interactive "P") + (save-excursion + (save-restriction + (let ((point (point))) + (narrow-to-region point (point-max)) + (message-goto-signature) + (unless (eobp) + (if (and arg (numberp arg)) + (forward-line (- -1 arg)) + (end-of-line -1))) + (unless (= point (point)) + (kill-region point (point)) + (unless (bolp) + (insert "\n"))))))) (defun message-newline-and-reformat (&optional arg not-break) "Insert four newlines, and then reformat if inside quoted text. Prefix arg means justify as well." (interactive (list (if current-prefix-arg 'full))) - (let (quoted point beg end leading-space bolp) + (let (quoted point beg end leading-space bolp fill-paragraph-function) (setq point (point)) (beginning-of-line) (setq beg (point)) @@ -3061,22 +3240,22 @@ (if point (goto-char point))))) (defun message-fill-paragraph (&optional arg) - "Like `fill-paragraph'." + "Message specific function to fill a paragraph. +This function is used as the value of `fill-paragraph-function' in +Message buffers and is not meant to be called directly." (interactive (list (if current-prefix-arg 'full))) (if (if (boundp 'filladapt-mode) filladapt-mode) nil - (message-newline-and-reformat arg t) + (if (message-point-in-header-p) + (message-fill-field) + (message-newline-and-reformat arg t)) t)) -;; Is it better to use `mail-header-end'? (defun message-point-in-header-p () "Return t if point is in the header." (save-excursion - (let ((p (point))) - (goto-char (point-min)) - (not (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") - p t))))) + (not (re-search-backward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t)))) (defun message-do-auto-fill () "Like `do-auto-fill', but don't fill in message header." @@ -3101,13 +3280,21 @@ ((listp message-signature) (eval message-signature)) (t message-signature))) - (signature + signature-file) + (setq signature (cond ((stringp signature) signature) - ((and (eq t signature) - message-signature-file - (file-exists-p message-signature-file)) - signature)))) + ((and (eq t signature) message-signature-file) + (setq signature-file + (if (and message-signature-directory + ;; don't actually use the signature directory + ;; if message-signature-file contains a path. + (not (file-name-directory + message-signature-file))) + (nnheader-concat message-signature-directory + message-signature-file) + message-signature-file)) + (file-exists-p signature-file)))) (when signature (goto-char (point-max)) ;; Insert the signature. @@ -3117,7 +3304,7 @@ (insert "\n")) (insert "-- \n") (if (eq signature t) - (insert-file-contents message-signature-file) + (insert-file-contents signature-file) (insert signature)) (goto-char (point-max)) (or (bolp) (insert "\n"))))) @@ -3222,17 +3409,17 @@ (substring table ?a (+ ?a n)) (substring table (+ ?a 26) 255)))) -(defun message-caesar-buffer-body (&optional rotnum) +(defun message-caesar-buffer-body (&optional rotnum wide) "Caesar rotate all letters in the current buffer by 13 places. Used to encode/decode possibly offensive messages (commonly in rec.humor). With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated." +Mail and USENET news headers are not rotated unless WIDE is non-nil." (interactive (if current-prefix-arg (list (prefix-numeric-value current-prefix-arg)) (list nil))) (save-excursion (save-restriction - (when (message-goto-body) + (when (and (not wide) (message-goto-body)) (narrow-to-region (point) (point-max))) (message-caesar-region (point-min) (point-max) rotnum)))) @@ -3279,14 +3466,15 @@ (let ((fill-prefix message-yank-prefix)) (fill-individual-paragraphs (point) (point-max) justifyp)))) -(defun message-indent-citation () +(defun message-indent-citation (&optional start end yank-only) "Modify text just inserted from a message to be cited. The inserted text should be the region. When this function returns, the region is again around the modified text. Normally, indent each nonblank line `message-indentation-spaces' spaces. However, if `message-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) + (unless start (setq start (point))) + (unless yank-only ;; Remove unwanted headers. (when message-ignored-cited-headers (let (all-removed) @@ -3314,18 +3502,53 @@ (insert "\n")) (while (and (zerop (forward-line -1)) (looking-at "$")) - (message-delete-line)) - ;; Do the indentation. - (if (null message-yank-prefix) - (indent-rigidly start (mark t) message-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (if (or (looking-at ">") (looking-at "^$")) - (insert message-yank-cited-prefix) - (insert message-yank-prefix)) - (forward-line 1)))) - (goto-char start))) + (message-delete-line))) + ;; Do the indentation. + (if (null message-yank-prefix) + (indent-rigidly start (or end (mark t)) message-indentation-spaces) + (save-excursion + (goto-char start) + (while (< (point) (or end (mark t))) + (cond ((looking-at ">") + (insert message-yank-cited-prefix)) + ((looking-at "^$") + (insert message-yank-empty-prefix)) + (t + (insert message-yank-prefix))) + (forward-line 1)))) + (goto-char start)) + +(defun message-remove-blank-cited-lines (&optional remove) + "Remove cited lines containing only blanks. +If REMOVE is non-nil, remove newlines, too. + +To use this automatically, you may add this function to +`gnus-message-setup-hook'." + (interactive "P") + (let ((citexp + (concat + "^\\(" + (if (boundp 'message-yank-cited-prefix) + (concat message-yank-cited-prefix "\\|")) + message-yank-prefix + "\\)+ *$" + (if remove "\n" "")))) + (gnus-message 8 "removing `%s'" citexp) + (save-excursion + (message-goto-body) + (while (re-search-forward citexp nil t) + (replace-match ""))))) + +(defvar message-cite-reply-above nil + "If non-nil, start own text above the quote. + +Note: Top posting is bad netiquette. Don't use it unless you +really must. You probably want to set variable only for specific +groups, e.g. using `gnus-posting-styles': + + (eval (set (make-local-variable 'message-cite-reply-above) t)) + +This variable has no effect in news postings.") (defun message-yank-original (&optional arg) "Insert the message being replied to, if any. @@ -3338,9 +3561,22 @@ Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." (interactive "P") - (let ((modified (buffer-modified-p))) + (let ((modified (buffer-modified-p)) + body-text) (when (and message-reply-buffer message-cite-function) + (when message-cite-reply-above + (if (and (not (message-news-p)) + (or (eq message-cite-reply-above 'is-evil) + (y-or-n-p "\ +Top posting is bad netiquette. Please don't top post unless you really must. +Really top post? "))) + (save-excursion + (setq body-text + (buffer-substring (message-goto-body) + (point-max))) + (delete-region (message-goto-body) (point-max))) + (set (make-local-variable 'message-cite-reply-above) nil))) (delete-windows-on message-reply-buffer t) (push-mark (save-excursion (insert-buffer-substring message-reply-buffer) @@ -3354,6 +3590,13 @@ (goto-char (mark t)) (insert-before-markers ?\n) (goto-char pt)))) + (when message-cite-reply-above + (message-goto-body) + (insert body-text) + (insert (if (bolp) "\n" "\n\n")) + (message-goto-body)) + ;; Add a `message-setup-very-last-hook' here? + ;; Add `gnus-article-highlight-citation' here? (unless modified (setq message-checksum (message-checksum)))))) @@ -3375,59 +3618,20 @@ (push (buffer-name buffer) buffers)))) (nreverse buffers))) -(defun message-cite-original-without-signature () - "Cite function in the standard Message manner." - (let* ((start (point)) - (end (mark t)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function)))) - ;; This function may be called by `gnus-summary-yank-message' and - ;; may insert a different article from the original. So, we will - ;; modify the value of `message-reply-headers' with that article. - (message-reply-headers - (save-restriction - (narrow-to-region start end) - (message-narrow-to-head-1) - (vector 0 - (or (message-fetch-field "subject") "none") - (or (message-fetch-field "from") "nobody") - (message-fetch-field "date") - (message-fetch-field "message-id" t) - (message-fetch-field "references") - 0 0 "")))) - (mml-quote-region start end) - ;; Allow undoing. - (undo-boundary) - (goto-char end) - (when (re-search-backward message-signature-separator start t) - ;; Also peel off any blank lines before the signature. - (forward-line -1) - (while (looking-at "^[ \t]*$") - (forward-line -1)) - (forward-line 1) - (delete-region (point) end) - (unless (search-backward "\n\n" start t) - ;; Insert a blank line if it is peeled off. - (insert "\n"))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive -(defun message-cite-original () - "Cite function in the standard Message manner." +(eval-when-compile (defvar mail-citation-hook)) ; Compiler directive + +(defun message-cite-original-1 (strip-signature) + "Cite an original message. +If STRIP-SIGNATURE is non-nil, strips off the signature from the +original message. + +This function uses `mail-citation-hook' if that is non-nil." (if (and (boundp 'mail-citation-hook) mail-citation-hook) (run-hooks 'mail-citation-hook) (let* ((start (point)) (end (mark t)) + (x-no-archive nil) (functions (when message-indent-citation-function (if (listp message-indent-citation-function) @@ -3440,6 +3644,7 @@ (save-restriction (narrow-to-region start end) (message-narrow-to-head-1) + (setq x-no-archive (message-fetch-field "x-no-archive")) (vector 0 (or (message-fetch-field "subject") "none") (or (message-fetch-field "from") "nobody") @@ -3448,13 +3653,129 @@ (message-fetch-field "references") 0 0 "")))) (mml-quote-region start end) + (when strip-signature + ;; Allow undoing. + (undo-boundary) + (goto-char end) + (when (re-search-backward message-signature-separator start t) + ;; Also peel off any blank lines before the signature. + (forward-line -1) + (while (looking-at "^[ \t]*$") + (forward-line -1)) + (forward-line 1) + (delete-region (point) end) + (unless (search-backward "\n\n" start t) + ;; Insert a blank line if it is peeled off. + (insert "\n")))) (goto-char start) - (while functions - (funcall (pop functions))) + (mapc 'funcall functions) (when message-citation-line-function (unless (bolp) (insert "\n")) - (funcall message-citation-line-function))))) + (funcall message-citation-line-function)) + (when (and x-no-archive + (not message-cite-articles-with-x-no-archive) + (string-match "yes" x-no-archive)) + (undo-boundary) + (delete-region (point) (mark t)) + (insert "> [Quoted text removed due to X-No-Archive]\n") + (push-mark) + (forward-line -1))))) + +(defun message-cite-original () + "Cite function in the standard Message manner." + (message-cite-original-1 nil)) + +(defun message-insert-formated-citation-line (&optional from date) + "Function that inserts a formated citation line. + +See `message-citation-line-format'." + ;; The optional args are for testing/debugging. They will disappear later. + ;; Example: + ;; (with-temp-buffer + ;; (message-insert-formated-citation-line + ;; "John Doe " + ;; (current-time)) + ;; (buffer-string)) + (when (or message-reply-headers (and from date)) + (unless from + (setq from (mail-header-from message-reply-headers))) + (let* ((data (condition-case () + (funcall (if (boundp gnus-extract-address-components) + gnus-extract-address-components + 'mail-extract-address-components) + from) + (error nil))) + (name (car data)) + (fname name) + (lname name) + (net (car (cdr data))) + (name-or-net (or (car data) + (car (cdr data)) from)) + (replydate + (or + date + ;; We need Gnus functionality if the user wants date or time from + ;; the original article: + (when (string-match "%[^fnNFL]" message-citation-line-format) + (autoload 'gnus-date-get-time "gnus-util") + (gnus-date-get-time (mail-header-date message-reply-headers))))) + (flist + (let ((i ?A) lst) + (when (stringp name) + ;; Guess first name and last name: + (cond ((string-match + "\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name) + (setq fname (nth 0 (split-string name "[ \t]+")) + lname (nth 1 (split-string name "[ \t]+")))) + ((string-match + "\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name) + (setq fname (nth 1 (split-string name "[ \t,]+")) + lname (nth 0 (split-string name "[ \t,]+")))) + ((string-match + "\\`\\(\\w\\|[-.]\\)+\\'" name) + (setq fname name + lname "")))) + ;; The following letters are not used in `format-time-string': + (push ?E lst) (push "" lst) + (push ?F lst) (push fname lst) + ;; We might want to use "" instead of "" later. + (push ?J lst) (push "" lst) + (push ?K lst) (push "" lst) + (push ?L lst) (push lname lst) + (push ?N lst) (push name-or-net lst) + (push ?O lst) (push "" lst) + (push ?P lst) (push "

    " lst) + (push ?Q lst) (push "" lst) + (push ?f lst) (push from lst) + (push ?i lst) (push "" lst) + (push ?n lst) (push net lst) + (push ?o lst) (push "" lst) + (push ?q lst) (push "" lst) + (push ?t lst) (push "" lst) + (push ?v lst) (push "" lst) + ;; Delegate the rest to `format-time-string': + (while (<= i ?z) + (when (and (not (memq i lst)) + ;; Skip (Z,a) + (or (<= i ?Z) + (>= i ?a))) + (push i lst) + (push (condition-case nil + (progn (format-time-string (format "%%%c" i) + replydate)) + (format ">%c<" i)) + lst)) + (setq i (1+ i))) + (reverse lst))) + (spec (apply 'format-spec-make flist))) + (insert (format-spec message-citation-line-format spec))) + (newline))) + +(defun message-cite-original-without-signature () + "Cite function in the standard Message manner. +This function strips off the signature from the original message." + (message-cite-original-1 t)) (defun message-insert-citation-line () "Insert a simple citation line." @@ -3548,6 +3869,7 @@ "Kill the current buffer." (interactive) (when (or (not (buffer-modified-p)) + (not message-kill-buffer-query) (yes-or-no-p "Message modified; kill anyway? ")) (let ((actions message-kill-actions) (draft-article message-draft-article) @@ -3640,6 +3962,9 @@ (save-excursion (run-hooks 'message-sent-hook)) (message "Sending...done") + ;; Do ecomplete address snarfing. + (when (message-mail-alias-type-p 'ecomplete) + (message-put-addresses-in-ecomplete)) ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) (delete-auto-save-file-if-necessary t) @@ -3667,16 +3992,31 @@ (put 'message-check 'lisp-indent-function 1) (put 'message-check 'edebug-form-spec '(form body)) -(defun message-text-with-property (prop) - "Return a list of all points where the text has PROP." - (let ((points nil) - (point (point-min))) - (save-excursion - (while (< point (point-max)) - (when (get-text-property point prop) - (push point points)) - (incf point))) - (nreverse points))) +(defun message-text-with-property (prop &optional start end reverse) + "Return a list of start and end positions where the text has PROP. +START and END bound the search, they default to `point-min' and +`point-max' respectively. If REVERSE is non-nil, find text which does +not have PROP." + (unless start + (setq start (point-min))) + (unless end + (setq end (point-max))) + (let (next regions) + (if reverse + (while (and start + (setq start (text-property-any start end prop nil))) + (setq next (next-single-property-change start prop nil end)) + (push (cons start (or next end)) regions) + (setq start next)) + (while (and start + (or (get-text-property start prop) + (and (setq start (next-single-property-change + start prop nil end)) + (get-text-property start prop)))) + (setq next (text-property-any start end prop nil)) + (push (cons start (or next end)) regions) + (setq start next))) + (nreverse regions))) (defun message-fix-before-sending () "Do various things to make the message nice before sending it." @@ -3685,44 +4025,49 @@ (unless (bolp) (insert "\n")) ;; Make the hidden headers visible. - (let ((points (message-text-with-property 'message-hidden))) - (when points - (goto-char (car points)) - (dolist (point points) - (add-text-properties point (1+ point) - '(invisible nil intangible nil))))) + (widen) + ;; Sort headers before sending the message. + (message-sort-headers) ;; Make invisible text visible. ;; It doesn't seem as if this is useful, since the invisible property ;; is clobbered by an after-change hook anyhow. (message-check 'invisible-text - (let ((points (message-text-with-property 'invisible))) - (when points - (goto-char (car points)) - (dolist (point points) - (put-text-property point (1+ point) 'invisible nil) - (message-overlay-put (message-make-overlay point (1+ point)) + (let ((regions (message-text-with-property 'invisible)) + from to) + (when regions + (while regions + (setq from (caar regions) + to (cdar regions) + regions (cdr regions)) + (put-text-property from to 'invisible nil) + (message-overlay-put (message-make-overlay from to) 'face 'highlight)) (unless (yes-or-no-p "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) (message-check 'illegible-text - (let (found choice) + (let (char found choice) (message-goto-body) - (skip-chars-forward mm-7bit-chars) - (while (not (eobp)) - (when (let ((char (char-after))) - (or (< (mm-char-int char) 128) - (and (mm-multibyte-p) - (memq (char-charset char) - '(eight-bit-control eight-bit-graphic - control-1)) - (not (get-text-property - (point) 'untranslated-utf-8))))) + (while (progn + (skip-chars-forward mm-7bit-chars) + (when (get-text-property (point) 'no-illegible-text) + ;; There is a signed or encrypted raw message part + ;; that is considered to be safe. + (goto-char (or (next-single-property-change + (point) 'no-illegible-text) + (point-max)))) + (setq char (char-after))) + (when (or (< (mm-char-int char) 128) + (and (mm-multibyte-p) + (memq (char-charset char) + '(eight-bit-control eight-bit-graphic + control-1)) + (not (get-text-property + (point) 'untranslated-utf-8)))) (message-overlay-put (message-make-overlay (point) (1+ (point))) 'face 'highlight) (setq found t)) - (forward-char) - (skip-chars-forward mm-7bit-chars)) + (forward-char)) (when found (setq choice (gnus-multiple-choice @@ -3773,16 +4118,15 @@ (defun message-do-actions (actions) "Perform all actions in ACTIONS." ;; Now perform actions on successful sending. - (while actions + (dolist (action actions) (ignore-errors (cond ;; A simple function. - ((functionp (car actions)) - (funcall (car actions))) + ((functionp action) + (funcall action)) ;; Something to be evaled. (t - (eval (car actions))))) - (pop actions))) + (eval action)))))) (defun message-send-mail-partially () "Send mail as message/partial." @@ -3867,6 +4211,15 @@ (gnus-setup-posting-charset nil) message-posting-charset)) (headers message-required-mail-headers)) + (when (and message-generate-hashcash + (not (eq message-generate-hashcash 'opportunistic))) + (message "Generating hashcash...") + ;; Wait for calculations already started to finish... + (hashcash-wait-async) + ;; ...and do calculations not already done. mail-add-payment + ;; will leave existing X-Hashcash headers alone. + (mail-add-payment) + (message "Generating hashcash...done")) (save-restriction (message-narrow-to-headers) ;; Generate the Mail-Followup-To header if the header is not there... @@ -4003,8 +4356,7 @@ (when (eval message-mailer-swallows-blank-line) (newline)) (when message-interactive - (save-excursion - (set-buffer errbuf) + (with-current-buffer errbuf (erase-buffer)))) (let* ((default-directory "/") (coding-system-for-write message-send-coding-system) @@ -4022,6 +4374,7 @@ "/usr/ucblib/sendmail") (t "fakemail")) nil errbuf nil "-oi") + message-sendmail-extra-arguments ;; Always specify who from, ;; since some systems have broken sendmails. ;; But some systems are more broken with -f, so @@ -4045,7 +4398,7 @@ (save-excursion (set-buffer errbuf) (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) + (while (re-search-forward "\n+ *" nil t) (replace-match "; ")) (if (not (zerop (buffer-size))) (error "Sending...failed to %s" @@ -4086,9 +4439,9 @@ ;; free for -inject-arguments -- a big win for the user and for us ;; since we don't have to play that double-guessing game and the user ;; gets full control (no gestapo'ish -f's, for instance). --sj - (if (functionp message-qmail-inject-args) - (funcall message-qmail-inject-args) - message-qmail-inject-args))) + (if (functionp message-qmail-inject-args) + (funcall message-qmail-inject-args) + message-qmail-inject-args))) ;; qmail-inject doesn't say anything on it's stdout/stderr, ;; we have to look at the retval instead (0 nil) @@ -4753,29 +5106,27 @@ (when (re-search-forward ",+$" nil t) (replace-match "" t t)))))) -(eval-when-compile (require 'parse-time)) (defun message-make-date (&optional now) "Make a valid data header. If NOW, use that time instead." - (require 'parse-time) - (let* ((now (or now (current-time))) - (zone (nth 8 (decode-time now))) - (sign "+")) - (when (< zone 0) - (setq sign "-") - (setq zone (- zone))) - (concat - ;; The day name of the %a spec is locale-specific. Pfff. - (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now)) - parse-time-weekdays)))) - (format-time-string "%d" now) - ;; The month name of the %b spec is locale-specific. Pfff. - (format " %s " - (capitalize (car (rassoc (nth 4 (decode-time now)) - parse-time-months)))) - (format-time-string "%Y %H:%M:%S " now) - ;; We do all of this because XEmacs doesn't have the %z spec. - (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60))))) + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z" now))) + +(defun message-insert-expires (days) + "Insert the Expires header. Expiry in DAYS days." + (interactive "NExpire article in how many days? ") + (save-excursion + (message-position-on-field "Expires" "X-Draft-From") + (insert (message-make-expires-date days)))) + +(defun message-make-expires-date (days) + "Make date string for the Expires header. Expiry in DAYS days. + +In posting styles use `(\"Expires\" (make-expires-date 30))'." + (let* ((cur (decode-time (current-time))) + (nday (+ days (nth 3 cur)))) + (setf (nth 3 cur) nday) + (message-make-date (apply 'encode-time cur)))) (defun message-make-message-id () "Make a unique Message-ID." @@ -4940,14 +5291,14 @@ (concat message-user-path "!" login-name)) (t login-name)))) -(defun message-make-from () +(defun message-make-from (&optional name address ) "Make a From header." (let* ((style message-from-style) - (login (message-make-address)) - (fullname - (or (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) + (login (or address (message-make-address))) + (fullname (or name + (and (boundp 'user-full-name) + user-full-name) + (user-full-name)))) (when (string= fullname "&") (setq fullname (user-login-name))) (with-temp-buffer @@ -4968,15 +5319,15 @@ (string-match "[\\()]" tmp))))) (insert fullname) (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) + ;; Quote fullname, escaping specials. + (goto-char (point-min)) + (insert "\"") + (while (re-search-forward "[\"\\]" nil 1) + (replace-match "\\\\\\&" t)) + (insert "\"")) (insert " <" login ">")) (t ; 'parens or default (insert login " (") @@ -5279,19 +5630,21 @@ (if formatter (funcall formatter header value) (insert header-string ": " value)) + (goto-char (message-fill-field)) ;; We check whether the value was ended by a - ;; newline. If now, we insert one. + ;; newline. If not, we insert one. (unless (bolp) (insert "\n")) (forward-line -1))) ;; The value of this header was empty, so we clear ;; totally and insert the new value. - (delete-region (point) (gnus-point-at-eol)) + (delete-region (point) (point-at-eol)) ;; If the header is optional, and the header was - ;; empty, we con't insert it anyway. + ;; empty, we can't insert it anyway. (unless optionalp (push header-string message-inserted-headers) - (insert value))) + (insert value) + (message-fill-field))) ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) @@ -5347,35 +5700,29 @@ ;;; Setting up a message buffer ;;; +(defun message-skip-to-next-address () + (let ((end (save-excursion + (message-next-header) + (point))) + quoted char) + (when (looking-at ",") + (forward-char 1)) + (while (and (not (= (point) end)) + (or (not (eq char ?,)) + quoted)) + (skip-chars-forward "^,\"" (point-max)) + (when (eq (setq char (following-char)) ?\") + (setq quoted (not quoted))) + (unless (= (point) end) + (forward-char 1))) + (skip-chars-forward " \t\n"))) + (defun message-fill-address (header value) - (save-restriction - (narrow-to-region (point) (point)) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (narrow-to-region (point-min) (1- (point-max))) - (let (quoted last) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^,\"" (point-max)) - (if (or (eq (char-after) ?,) - (eobp)) - (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) - (setq quoted (not quoted))) - (unless (eobp) - (forward-char 1)))) - (goto-char (point-max)) - (widen) - (forward-line 1))) + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n") + (message-fill-field-address)) (defun message-split-line () "Split current line, moving portion beyond point vertically down. @@ -5386,26 +5733,56 @@ (error (split-line)))) -(defun message-fill-header (header value) +(defun message-insert-header (header value) + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value))) + +(defun message-field-name () + (save-excursion + (goto-char (point-min)) + (when (looking-at "\\([^:]+\\):") + (intern (capitalize (match-string 1)))))) + +(defun message-fill-field () + (save-excursion + (save-restriction + (message-narrow-to-field) + (let ((field-name (message-field-name))) + (funcall (or (cadr (assq field-name message-field-fillers)) + 'message-fill-field-general))) + (point-max)))) + +(defun message-fill-field-address () + (while (not (eobp)) + (message-skip-to-next-address) + (let (last) + (if (and (> (current-column) 78) + last) + (progn + (save-excursion + (goto-char last) + (insert "\n\t")) + (setq last (1+ (point)))) + (setq last (1+ (point))))))) + +(defun message-fill-field-general () (let ((begin (point)) (fill-column 78) (fill-prefix "\t")) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (save-restriction - (narrow-to-region begin (point)) - (fill-region-as-paragraph begin (point)) - ;; Tapdance around looong Message-IDs. - (forward-line -1) - (when (looking-at "[ \t]*$") - (message-delete-line)) - (goto-char begin) - (re-search-forward ":" nil t) - (when (looking-at "\n[ \t]+") - (replace-match " " t t)) - (goto-char (point-max))))) + (while (and (search-forward "\n" nil t) + (not (eobp))) + (replace-match " " t t)) + (fill-region-as-paragraph begin (point-max)) + ;; Tapdance around looong Message-IDs. + (forward-line -1) + (when (looking-at "[ \t]*$") + (message-delete-line)) + (goto-char begin) + (search-forward ":" nil t) + (when (looking-at "\n[ \t]+") + (replace-match " " t t)) + (goto-char (point-max)))) (defun message-shorten-1 (list cut surplus) "Cut SURPLUS elements out of LIST, beginning with CUTth one." @@ -5414,8 +5791,9 @@ (defun message-shorten-references (header references) "Trim REFERENCES to be 21 Message-ID long or less, and fold them. -If folding is disallowed, also check that the REFERENCES are less -than 988 characters long, and if they are not, trim them until they are." +When sending via news, also check that the REFERENCES are less +than 988 characters long, and if they are not, trim them until +they are." (let ((maxcount 21) (count 0) (cut 2) @@ -5437,33 +5815,26 @@ (message-shorten-1 refs cut surplus) (decf count surplus))) - ;; If folding is disallowed, make sure the total length (including - ;; the spaces between) will be less than MAXSIZE characters. + ;; When sending via news, make sure the total folded length will + ;; be less than 998 characters. This is to cater to broken INN + ;; 2.3 which counts the total number of characters in a header + ;; rather than the physical line length of each line, as it should. + ;; + ;; This hack should be removed when it's believed than INN 2.3 is + ;; no longer widely used. ;; - ;; Only disallow folding for News messages. At this point the headers - ;; have not been generated, thus we use message-this-is-news directly. - (when (and message-this-is-news message-cater-to-broken-inn) - (let ((maxsize 988) - (totalsize (+ (apply #'+ (mapcar #'length refs)) - (1- count))) - (surplus 0) - (ptr (nthcdr (1- cut) refs))) - ;; Decide how many elements to cut off... - (while (> totalsize maxsize) - (decf totalsize (1+ (length (car ptr)))) - (incf surplus) - (setq ptr (cdr ptr))) - ;; ...and do it. - (when (> surplus 0) - (message-shorten-1 refs cut surplus)))) - + ;; At this point the headers have not been generated, thus we use + ;; message-this-is-news directly. + (when message-this-is-news + (while (< 998 + (with-temp-buffer + (message-insert-header + header (mapconcat #'identity refs " ")) + (buffer-size))) + (message-shorten-1 refs cut 1))) ;; Finally, collect the references back into a string and insert ;; it into the buffer. - (let ((refstring (mapconcat #'identity refs " "))) - (if (and message-this-is-news message-cater-to-broken-inn) - (insert (capitalize (symbol-name header)) ": " - refstring "\n") - (message-fill-header header refstring))))) + (message-insert-header header (mapconcat #'identity refs " ")))) (defun message-position-point () "Move point to where the user probably wants to find it." @@ -5513,7 +5884,7 @@ (message-point-in-header-p)) (let* ((here (point)) (bol (progn (beginning-of-line n) (point))) - (eol (gnus-point-at-eol)) + (eol (point-at-eol)) (eoh (re-search-forward ": *" eol t))) (goto-char (if (and eoh (or (< eoh here) (= bol here))) @@ -5726,12 +6097,7 @@ (when message-default-headers (insert message-default-headers) (or (bolp) (insert ?\n))) - (put-text-property - (point) - (progn - (insert mail-header-separator "\n") - (1- (point))) - 'read-only nil) + (insert mail-header-separator "\n") (forward-line -1) (when (message-news-p) (when message-default-news-headers @@ -5762,6 +6128,9 @@ (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (setq buffer-undo-list nil) + (when message-generate-hashcash + ;; Generate hashcash headers for recipients already known + (mail-add-payment-async)) (run-hooks 'message-setup-hook) ;; Do this last to give it precedence over posting styles, etc. (when (message-mail-p) @@ -5864,8 +6233,8 @@ (Subject . ,(or subject "")))))) (defun message-get-reply-headers (wide &optional to-address address-headers) - (let (follow-to mct never-mct to cc author mft recipients) - ;; Find all relevant headers we need. + (let (follow-to mct never-mct to cc author mft recipients extra) + ;; Find all relevant headers we need. (save-restriction (message-narrow-to-headers-or-head) ;; Gmane renames "To". Look at "Original-To", too, if it is present in @@ -5876,6 +6245,11 @@ return t) (message-fetch-field "original-to"))) cc (message-fetch-field "cc") + extra (when message-extra-wide-headers + (mapconcat 'identity + (mapcar 'message-fetch-field + message-extra-wide-headers) + ", ")) mct (message-fetch-field "mail-copies-to") author (or (message-fetch-field "mail-reply-to") (message-fetch-field "reply-to") @@ -5938,8 +6312,9 @@ (if mct (setq recipients (concat recipients ", " mct)))) (t (setq recipients (if never-mct "" (concat ", " author))) - (if to (setq recipients (concat recipients ", " to))) - (if cc (setq recipients (concat recipients ", " cc))) + (if to (setq recipients (concat recipients ", " to))) + (if cc (setq recipients (concat recipients ", " cc))) + (if extra (setq recipients (concat recipients ", " extra))) (if mct (setq recipients (concat recipients ", " mct))))) (if (>= (length recipients) 2) ;; Strip the leading ", ". @@ -5948,7 +6323,7 @@ (while (string-match "[ \t][ \t]+" recipients) (setq recipients (replace-match " " t t recipients))) ;; Remove addresses that match `rmail-dont-reply-to-names'. - (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (let ((rmail-dont-reply-to-names (message-dont-reply-to-names))) (setq recipients (rmail-dont-reply-to recipients))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") @@ -6233,16 +6608,16 @@ ;; Email address in From field equals to our address (and (setq from (message-fetch-field "from")) (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (cadr (mail-extract-address-components - (message-make-from)))))) + (downcase (car (mail-header-parse-address from))) + (downcase (car (mail-header-parse-address + (message-make-from)))))) ;; Email address in From field matches ;; 'message-alternative-emails' regexp (and from message-alternative-emails (string-match message-alternative-emails - (cadr (mail-extract-address-components from)))))))))) + (car (mail-header-parse-address from)))))))))) ;;;###autoload (defun message-cancel-news (&optional arg) @@ -6382,7 +6757,9 @@ (prefix (if group (gnus-group-decoded-name group) - (or (and from (car (gnus-extract-address-components from))) + (or (and from (or + (car (gnus-extract-address-components from)) + (cadr (gnus-extract-address-components from)))) "(nowhere)")))) (concat "[" (if message-forward-decoded-p @@ -6428,18 +6805,17 @@ subject (mail-decode-encoded-word-string subject)) "")) - (if message-wash-forwarded-subjects - (setq subject (message-wash-subject subject))) + (when message-wash-forwarded-subjects + (setq subject (message-wash-subject subject))) ;; Make sure funcs is a list. (and funcs (not (listp funcs)) (setq funcs (list funcs))) ;; Apply funcs in order, passing subject generated by previous ;; func to the next one. - (while funcs - (when (functionp (car funcs)) - (setq subject (funcall (car funcs) subject))) - (setq funcs (cdr funcs))) + (dolist (func funcs) + (when (functionp func) + (setq subject (funcall func subject)))) subject)))) (eval-when-compile @@ -6482,17 +6858,24 @@ (setq e (point)) (insert "\n-------------------- End of forwarded message --------------------\n") - (when message-forward-ignored-headers - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t))))) + (message-remove-ignored-headers b e))) + +(defun message-remove-ignored-headers (b e) + (when message-forward-ignored-headers + (save-restriction + (narrow-to-region b e) + (goto-char b) + (narrow-to-region (point) + (or (search-forward "\n\n" nil t) (point))) + (let ((ignored (if (stringp message-forward-ignored-headers) + (list message-forward-ignored-headers) + message-forward-ignored-headers))) + (dolist (elem ignored) + (message-remove-header elem t)))))) (defun message-forward-make-body-mime (forward-buffer) - (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") - (let ((b (point)) e) + (let ((b (point))) + (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") (save-restriction (narrow-to-region (point) (point)) (mml-insert-buffer forward-buffer) @@ -6500,8 +6883,11 @@ (when (looking-at "From ") (replace-match "X-From-Line: ")) (goto-char (point-max))) - (setq e (point)) - (insert "<#/part>\n"))) + (insert "<#/part>\n") + ;; Consider there is no illegible text. + (add-text-properties + b (point) + `(no-illegible-text t rear-nonsticky t start-open t)))) (defun message-forward-make-body-mml (forward-buffer) (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n") @@ -6530,12 +6916,7 @@ (insert "<#/mml>\n") (when (and (not message-forward-decoded-p) message-forward-ignored-headers) - (save-restriction - (narrow-to-region b e) - (goto-char b) - (narrow-to-region (point) - (or (search-forward "\n\n" nil t) (point))) - (message-remove-header message-forward-ignored-headers t))))) + (message-remove-ignored-headers b e)))) (defun message-forward-make-body-digest-plain (forward-buffer) (insert @@ -6564,6 +6945,62 @@ (message-forward-make-body-digest-mime forward-buffer) (message-forward-make-body-digest-plain forward-buffer))) +(eval-and-compile + (autoload 'mm-uu-dissect-text-parts "mm-uu") + (autoload 'mm-uu-dissect "mm-uu")) + +(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles) + "Say whether the current buffer contains signed or encrypted message. +If DONT-EMULATE-MIME is nil, this function does the MIME emulation on +messages that don't conform to PGP/MIME described in RFC2015. HANDLES +is for the internal use." + (unless handles + (let ((mm-decrypt-option 'never) + (mm-verify-option 'never)) + (if (setq handles (mm-dissect-buffer nil t)) + (unless dont-emulate-mime + (mm-uu-dissect-text-parts handles)) + (unless dont-emulate-mime + (setq handles (mm-uu-dissect)))))) + ;; Check text/plain message in which there is a signed or encrypted + ;; body that has been encoded by B or Q. + (unless (or handles dont-emulate-mime) + (let ((cur (current-buffer)) + (mm-decrypt-option 'never) + (mm-verify-option 'never)) + (with-temp-buffer + (insert-buffer-substring cur) + (when (setq handles (mm-dissect-buffer t t)) + (if (and (prog1 + (bufferp (car handles)) + (mm-destroy-parts handles)) + (equal (mm-handle-media-type handles) "text/plain")) + (progn + (mm-decode-content-transfer-encoding + (mm-handle-encoding handles)) + (setq handles (mm-uu-dissect))) + (setq handles nil)))))) + (when handles + (prog1 + (catch 'found + (dolist (handle (if (stringp (car handles)) + (if (member (car handles) + '("multipart/signed" + "multipart/encrypted")) + (throw 'found t) + (cdr handles)) + (list handles))) + (if (stringp (car handle)) + (when (message-signed-or-encrypted-p dont-emulate-mime handle) + (throw 'found t)) + (when (and (bufferp (car handle)) + (equal (mm-handle-media-type handle) + "message/rfc822")) + (with-current-buffer (mm-handle-buffer handle) + (when (message-signed-or-encrypted-p dont-emulate-mime) + (throw 'found t))))))) + (mm-destroy-parts handles)))) + ;;;###autoload (defun message-forward-make-body (forward-buffer &optional digest) ;; Put point where we want it before inserting the forwarded @@ -6576,11 +7013,13 @@ (if message-forward-as-mime (if (and message-forward-show-mml (not (and (eq message-forward-show-mml 'best) + ;; Use the raw form in the body if it contains + ;; signed or encrypted message so as not to be + ;; destroyed by re-encoding. (with-current-buffer forward-buffer - (goto-char (point-min)) - (re-search-forward - "Content-Type: *multipart/\\(signed\\|encrypted\\)" - nil t))))) + (condition-case nil + (message-signed-or-encrypted-p) + (error t)))))) (message-forward-make-body-mml forward-buffer) (message-forward-make-body-mime forward-buffer)) (message-forward-make-body-plain forward-buffer))) @@ -6590,8 +7029,6 @@ (defun message-forward-rmail-make-body (forward-buffer) (save-window-excursion (set-buffer forward-buffer) - ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs - ;; 20. FIXIT, or we drop support for rmail in Emacs 20. (if (rmail-msg-is-pruned) (rmail-msg-restore-non-pruned-header))) (message-forward-make-body forward-buffer)) @@ -6621,6 +7058,7 @@ (set-buffer (get-buffer-create " *message resend*")) (erase-buffer)) (let ((message-this-is-mail t) + message-generate-hashcash message-setup-hook) (message-setup `((To . ,address)))) ;; Insert our usual headers. @@ -6658,6 +7096,7 @@ ;; Send it. (let ((message-inhibit-body-encoding t) message-required-mail-headers + message-generate-hashcash rfc2047-encode-encoded-words) (message-send-mail)) (kill-buffer (current-buffer))) @@ -6772,7 +7211,7 @@ ;; This code should be moved to underline.el (from which it is stolen). ;;;###autoload -(defun bold-region (start end) +(defun message-bold-region (start end) "Bold all nonblank characters in the region. Works by overstriking characters. Called from program, takes two arguments START and END @@ -6788,7 +7227,7 @@ (forward-char 1))))) ;;;###autoload -(defun unbold-region (start end) +(defun message-unbold-region (start end) "Remove all boldness (overstruck characters) in the region. Called from program, takes two arguments START and END which specify the range to operate on." @@ -6797,7 +7236,7 @@ (let ((end1 (make-marker))) (move-marker end1 (max start end)) (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) + (while (search-forward "\b" end1 t) (if (eq (char-after) (char-after (- (point) 2))) (delete-char -2)))))) @@ -6847,7 +7286,7 @@ (const :tag "Retro look" message-tool-bar-retro) (repeat :tag "User defined list" gmm-tool-bar-item) (symbol)) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'message-tool-bar-update :group 'message) @@ -6866,7 +7305,7 @@ (message-kill-buffer "close") ;; stock_cancel (mml-attach-file "attach" mml-mode-map) (mml-preview "mail/preview" mml-mode-map) - ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) + (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) (message-insert-importance-high "important" nil :visible nil) (message-insert-importance-low "unimportant" nil :visible nil) (message-insert-disposition-notification-to "receipt" nil :visible nil) @@ -6876,7 +7315,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'message-tool-bar-update :group 'message) @@ -6896,7 +7335,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list." :type '(repeat gmm-tool-bar-item) - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'message-tool-bar-update :group 'message) @@ -6909,7 +7348,7 @@ See `gmm-tool-bar-from-list' for the format of the list." :type 'gmm-tool-bar-zap-list - :version "22.1" ;; Gnus 5.10.9 + :version "23.0" ;; No Gnus :initialize 'custom-initialize-default :set 'message-tool-bar-update :group 'message) @@ -6956,6 +7395,13 @@ :group 'message :type '(alist :key-type regexp :value-type function)) +(defcustom message-expand-name-databases + (list 'bbdb 'eudc) + "List of databases to try for name completion (`message-expand-name'). +Each element is a symbol and can be `bbdb' or `eudc'." + :group 'message + :type '(set (const bbdb) (const eudc))) + (defcustom message-tab-body-function nil "*Function to execute when `message-tab' (TAB) is executed in the body. If nil, the function bound in `text-mode-map' or `global-map' is executed." @@ -7036,9 +7482,15 @@ (delete-region (point) (progn (forward-line 3) (point)))))))))) (defun message-expand-name () - (if (fboundp 'bbdb-complete-name) - (bbdb-complete-name) - (expand-abbrev))) + (cond ((and (memq 'eudc message-expand-name-databases) + (boundp 'eudc-protocol) + eudc-protocol) + (eudc-expand-inline)) + ((and (memq 'bbdb message-expand-name-databases) + (fboundp 'bbdb-complete-name)) + (bbdb-complete-name)) + (t + (expand-abbrev)))) ;;; Help stuff. @@ -7053,7 +7505,7 @@ (with-output-to-temp-buffer " *MESSAGE information message*" (set-buffer " *MESSAGE information message*") (fundamental-mode) ; for Emacs 20.4+ - (mapcar 'princ text) + (mapc 'princ text) (goto-char (point-min)))) (funcall ask question)) (funcall ask question))) @@ -7164,7 +7616,7 @@ address in `message-alternative-emails', looking at To, Cc and From headers in the original article." (require 'mail-utils) - (let* ((fields '("To" "Cc")) + (let* ((fields '("To" "Cc" "From")) (emails (split-string (mail-strip-quoted-names @@ -7179,7 +7631,8 @@ (unless (or (not email) (equal email user-mail-address)) (message-remove-header "From") (goto-char (point-max)) - (insert "From: " email "\n")))) + (insert "From: " (let ((user-mail-address email)) (message-make-from)) + "\n")))) (defun message-options-get (symbol) (cdr (assq symbol message-options))) @@ -7218,7 +7671,8 @@ (list message-hidden-headers) message-hidden-headers)) (inhibit-point-motion-hooks t) - (after-change-functions nil)) + (after-change-functions nil) + (end-of-headers 0)) (when regexps (save-excursion (save-restriction @@ -7227,11 +7681,17 @@ (while (not (eobp)) (if (not (message-hide-header-p regexps)) (message-next-header) - (let ((begin (point))) + (let ((begin (point)) + header header-len) (message-next-header) - (add-text-properties - begin (point) - '(invisible t message-hidden t)))))))))) + (setq header (buffer-substring begin (point)) + header-len (- (point) begin)) + (delete-region begin (point)) + (goto-char (1+ end-of-headers)) + (insert header) + (setq end-of-headers + (+ end-of-headers header-len)))))))) + (narrow-to-region (1+ end-of-headers) (point-max)))) (defun message-hide-header-p (regexps) (let ((result nil) @@ -7245,6 +7705,39 @@ (not result) result))) +(defun message-put-addresses-in-ecomplete () + (dolist (header '("to" "cc" "from" "reply-to")) + (let ((value (message-field-value header))) + (dolist (string (mail-header-parse-addresses value 'raw)) + (setq string + (gnus-replace-in-string + (gnus-replace-in-string string "^ +\\| +$" "") "\n" "")) + (ecomplete-add-item 'mail (car (mail-header-parse-address string)) + string)))) + (ecomplete-save)) + +(defun message-display-abbrev (&optional choose) + "Display the next possible abbrev for the text before point." + (interactive (list t)) + (when (and (memq (char-after (point-at-bol)) '(?C ?T ?\t ? )) + (message-point-in-header-p) + (save-excursion + (beginning-of-line) + (while (and (memq (char-after) '(?\t ? )) + (zerop (forward-line -1)))) + (looking-at "To:\\|Cc:"))) + (let* ((end (point)) + (start (save-excursion + (and (re-search-backward "[\n\t ]" nil t) + (1+ (point))))) + (word (when start (buffer-substring start end))) + (match (when (and word + (not (zerop (length word)))) + (ecomplete-display-matches 'mail word choose)))) + (when (and choose match) + (delete-region start end) + (insert match))))) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-bodies.el --- a/lisp/gnus/mm-bodies.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-bodies.el Sun Oct 28 09:18:39 2007 +0000 @@ -26,10 +26,6 @@ ;;; Code: -(eval-and-compile - (or (fboundp 'base64-decode-region) - (require 'base64))) - (eval-when-compile (defvar mm-uu-decode-function) (defvar mm-uu-binhex-decode-function)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-decode.el --- a/lisp/gnus/mm-decode.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-decode.el Sun Oct 28 09:18:39 2007 +0000 @@ -33,7 +33,6 @@ (require 'term)) (eval-and-compile - (autoload 'executable-find "executable") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") (autoload 'mm-extern-cache-contents "mm-extern") @@ -231,6 +230,7 @@ (fboundp 'diff-mode))) ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) + ("text/dns" mm-display-dns-inline identity) ("text/html" mm-inline-text-html (lambda (handle) @@ -299,9 +299,9 @@ :group 'mime-display) (defcustom mm-automatic-display - '("text/plain" "text/enriched" "text/richtext" "text/html" + '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" - "message/rfc822" "text/x-patch" "application/pgp-signature" + "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature" "application/emacs-lisp" "application/x-emacs-lisp" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" @@ -364,20 +364,34 @@ :type 'boolean :group 'mime-display) -(defvar mm-file-name-rewrite-functions +(defcustom mm-file-name-rewrite-functions '(mm-file-name-delete-control mm-file-name-delete-gotchas) - "*List of functions used for rewriting file names of MIME parts. + "List of functions used for rewriting file names of MIME parts. Each function takes a file name as input and returns a file name. -Ready-made functions include -`mm-file-name-delete-control' -`mm-file-name-delete-gotchas' -`mm-file-name-delete-whitespace', -`mm-file-name-trim-whitespace', -`mm-file-name-collapse-whitespace', -`mm-file-name-replace-whitespace', -`capitalize', `downcase', `upcase', and -`upcase-initials'.") +Ready-made functions include `mm-file-name-delete-control', +`mm-file-name-delete-gotchas' (you should not remove these two +functions), `mm-file-name-delete-whitespace', +`mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace', +`mm-file-name-replace-whitespace', `capitalize', `downcase', +`upcase', and `upcase-initials'." + :type '(list (set :inline t + (const mm-file-name-delete-control) + (const mm-file-name-delete-gotchas) + (const mm-file-name-delete-whitespace) + (const mm-file-name-trim-whitespace) + (const mm-file-name-collapse-whitespace) + (const mm-file-name-replace-whitespace) + (const capitalize) + (const downcase) + (const upcase) + (const upcase-initials) + (repeat :inline t + :tag "Function" + function))) + :version "23.0" ;; No Gnus + :group 'mime-display) + (defvar mm-path-name-rewrite-functions nil "*List of functions for rewriting the full file names of MIME parts. @@ -436,7 +450,11 @@ (defcustom mm-verify-option 'never "Option of verifying signed parts. `never', not verify; `always', always verify; -`known', only verify known protocols. Otherwise, ask user." +`known', only verify known protocols. Otherwise, ask user. + +When set to `always' or `known', you should add +\"multipart/signed\" to `gnus-buttonized-mime-types' to see +result of the verification." :version "22.1" :type '(choice (item always) (item never) @@ -548,15 +566,11 @@ ;; solution, avoids most of them. (if from (setq from (cadr (mail-extract-address-components from)))))) - (when cte - (setq cte (mail-header-strip cte))) (if (or (not ctl) (not (string-match "/" (car ctl)))) (mm-dissect-singlepart (list mm-dissect-default-type) - (and cte (intern (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) + (and cte (intern (downcase (mail-header-strip cte)))) no-strict-mime (and cd (mail-header-parse-content-disposition cd)) description) @@ -589,9 +603,7 @@ (mm-possibly-verify-or-decrypt (mm-dissect-singlepart ctl - (and cte (intern (downcase (mail-header-remove-whitespace - (mail-header-remove-comments - cte))))) + (and cte (intern (downcase (mail-header-strip cte)))) no-strict-mime (and cd (mail-header-parse-content-disposition cd)) description id) @@ -922,16 +934,16 @@ (string= total "'%s'") (string= total "\"%s\"")) (setq uses-stdin nil) - (push (mm-quote-arg + (push (shell-quote-argument (gnus-map-function mm-path-name-rewrite-functions file)) out)) ((string= total "%t") - (push (mm-quote-arg (car type-list)) out)) + (push (shell-quote-argument (car type-list)) out)) (t - (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out)))) + (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out)))) (push (substring method beg (length method)) out) (when uses-stdin (push "<" out) - (push (mm-quote-arg + (push (shell-quote-argument (gnus-map-function mm-path-name-rewrite-functions file)) out)) (mapconcat 'identity (nreverse out) ""))) @@ -1136,16 +1148,26 @@ "Insert the contents of HANDLE in the current buffer. If NO-CACHE is non-nil, cached contents of a message/external-body part are ignored." - (save-excursion - (insert - (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset) - 'gnus-decoded) - (with-current-buffer (mm-handle-buffer handle) - (buffer-string))) - ((mm-multibyte-p) - (mm-string-to-multibyte (mm-get-part handle no-cache))) - (t - (mm-get-part handle no-cache)))))) + (let ((text (cond ((eq (mail-content-type-get (mm-handle-type handle) + 'charset) + 'gnus-decoded) + (with-current-buffer (mm-handle-buffer handle) + (buffer-string))) + ((mm-multibyte-p) + (mm-string-to-multibyte (mm-get-part handle no-cache))) + (t + (mm-get-part handle no-cache))))) + (save-restriction + (widen) + (goto-char + (prog1 + (point) + (if (and (eq (get-char-property (max (point-min) (1- (point))) 'face) + 'mm-uu-extract) + (eq (get-char-property 0 'face text) 'mm-uu-extract)) + ;; Separate the extracted parts that have the same faces. + (insert "\n" text) + (insert text))))))) (defun mm-file-name-delete-whitespace (file-name) "Remove all whitespace characters from FILE-NAME." @@ -1185,8 +1207,9 @@ (setq filename (gnus-replace-in-string filename "[<>|]" "")) (gnus-replace-in-string filename "^[.-]+" "")) -(defun mm-save-part (handle) - "Write HANDLE to a file." +(defun mm-save-part (handle &optional prompt) + "Write HANDLE to a file. +PROMPT overrides the default one used to ask user for a file name." (let ((filename (or (mail-content-type-get (mm-handle-disposition handle) 'filename) (mail-content-type-get @@ -1197,7 +1220,7 @@ (file-name-nondirectory filename)))) (setq file (mm-with-multibyte - (read-file-name "Save MIME part to: " + (read-file-name (or prompt "Save MIME part to: ") (or mm-default-directory default-directory) nil nil (or filename "")))) (setq mm-default-directory (file-name-directory file)) @@ -1211,17 +1234,13 @@ (defun mm-save-part-to-file (handle file) (mm-with-unibyte-buffer (mm-insert-part handle) - (let ((coding-system-for-write 'binary) - (current-file-modes (default-file-modes)) + (let ((current-file-modes (default-file-modes))) + (set-default-file-modes mm-attachment-file-modes) + (unwind-protect ;; Don't re-compress .gz & al. Arguably we should make ;; `file-name-handler-alist' nil, but that would chop ;; ange-ftp, which is reasonable to use here. - (inhibit-file-name-operation 'write-region) - (inhibit-file-name-handlers - (cons 'jka-compr-handler inhibit-file-name-handlers))) - (set-default-file-modes mm-attachment-file-modes) - (unwind-protect - (write-region (point-min) (point-max) file) + (mm-write-region (point-min) (point-max) file nil nil nil 'binary t) (set-default-file-modes current-file-modes))))) (defun mm-pipe-part (handle) @@ -1517,7 +1536,7 @@ (format "protocol=%s" protocol)))))) (save-excursion (if func - (funcall func parts ctl) + (setq parts (funcall func parts ctl)) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details (format "Unknown sign protocol (%s)" protocol)))))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-partial.el --- a/lisp/gnus/mm-partial.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-partial.el Sun Oct 28 09:18:39 2007 +0000 @@ -34,8 +34,7 @@ (require 'mm-decode) (defun mm-partial-find-parts (id &optional art) - (let ((headers (save-excursion - (set-buffer gnus-summary-buffer) + (let ((headers (with-current-buffer gnus-summary-buffer gnus-newsgroup-headers)) phandles header) (while (setq header (pop headers)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-url.el --- a/lisp/gnus/mm-url.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-url.el Sun Oct 28 09:18:39 2007 +0000 @@ -35,14 +35,6 @@ (require 'mm-util) (require 'gnus) -(eval-and-compile - (autoload 'executable-find "executable")) - -(eval-when-compile - (if (featurep 'xemacs) - (require 'timer-funcs) - (require 'timer))) - (defvar url-current-object) (defvar url-package-name) (defvar url-package-version) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-util.el --- a/lisp/gnus/mm-util.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-util.el Sun Oct 28 09:18:39 2007 +0000 @@ -30,7 +30,14 @@ (require 'mail-prsvr) (eval-and-compile - (mapcar + (if (featurep 'xemacs) + (unless (ignore-errors + (require 'timer-funcs)) + (require 'timer)) + (require 'timer))) + +(eval-and-compile + (mapc (lambda (elem) (let ((nfunc (intern (format "mm-%s" (car elem))))) (if (fboundp (car elem)) @@ -41,9 +48,6 @@ (coding-system-equal . equal) (annotationp . ignore) (set-buffer-file-coding-system . ignore) - (make-char - . (lambda (charset int) - (int-to-char int))) (read-charset . (lambda (prompt) "Return a charset." @@ -67,6 +71,10 @@ (aset string idx to)) (setq idx (1+ idx))) string))) + (replace-in-string + . (lambda (string regexp rep &optional literal) + "See `replace-regexp-in-string', only the order of args differs." + (replace-regexp-in-string regexp rep string nil literal))) (string-as-unibyte . identity) (string-make-unibyte . identity) ;; string-as-multibyte often doesn't really do what you think it does. @@ -90,7 +98,22 @@ (string-as-multibyte . identity) (multibyte-string-p . ignore) (insert-byte . insert-char) - (multibyte-char-to-unibyte . identity)))) + (multibyte-char-to-unibyte . identity) + (special-display-p + . (lambda (buffer-name) + "Returns non-nil if a buffer named BUFFER-NAME gets a special frame." + (and special-display-function + (or (and (member buffer-name special-display-buffer-names) t) + (cdr (assoc buffer-name special-display-buffer-names)) + (catch 'return + (dolist (elem special-display-regexps) + (and (stringp elem) + (string-match elem buffer-name) + (throw 'return t)) + (and (consp elem) + (stringp (car elem)) + (string-match (car elem) buffer-name) + (throw 'return (cdr elem)))))))))))) (eval-and-compile (if (featurep 'xemacs) @@ -120,32 +143,6 @@ (defalias 'mm-decode-coding-region 'decode-coding-region) (defalias 'mm-encode-coding-region 'encode-coding-region))) -(eval-and-compile - (cond - ((fboundp 'replace-in-string) - (defalias 'mm-replace-in-string 'replace-in-string)) - ((fboundp 'replace-regexp-in-string) - (defun mm-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (replace-regexp-in-string regexp newtext string nil literal))) - (t - (defun mm-replace-in-string (string regexp newtext &optional literal) - "Replace all matches for REGEXP with NEWTEXT in STRING. -If LITERAL is non-nil, insert NEWTEXT literally. Return a new -string containing the replacements. - -This is a compatibility function for different Emacsen." - (let ((start 0) tail) - (while (string-match regexp string start) - (setq tail (- (length string) (match-end 0))) - (setq string (replace-match newtext nil literal string)) - (setq start (- (length string) tail)))) - string)))) - (defalias 'mm-string-to-multibyte (cond ((featurep 'xemacs) @@ -262,6 +259,10 @@ ,@(when (and (not (mm-coding-system-p 'gbk)) (mm-coding-system-p 'cp936)) '((gbk . cp936))) + ;; ISO8859-1 is a bogus name for ISO-8859-1 + ,@(when (and (not (mm-coding-system-p 'iso8859-1)) + (mm-coding-system-p 'iso-8859-1)) + '((iso8859-1 . iso-8859-1))) ) "A mapping from unknown or invalid charset names to the real charset names. @@ -378,7 +379,9 @@ (mm-setup-codepage-ibm) (defcustom mm-charset-override-alist - `((iso-8859-1 . windows-1252)) + '((iso-8859-1 . windows-1252) + (iso-8859-8 . windows-1255) + (iso-8859-9 . windows-1254)) "A mapping from undesired charset names to their replacement. You may add pairs like (iso-8859-1 . windows-1252) here, @@ -386,6 +389,8 @@ superset of iso-8859-1." :type '(list (set :inline t (const (iso-8859-1 . windows-1252)) + (const (iso-8859-8 . windows-1255)) + (const (iso-8859-9 . windows-1254)) (const (undecided . windows-1252))) (repeat :inline t :tag "Other options" @@ -721,9 +726,6 @@ (message "Unknown charset: %s" charset))) cs)))) -(defsubst mm-replace-chars-in-string (string from to) - (mm-subst-char-in-string from to string)) - (eval-and-compile (defvar mm-emacs-mule (and (not (featurep 'xemacs)) (boundp 'default-enable-multibyte-characters) @@ -907,7 +909,7 @@ ;; Load the Latin Unity library, if available. (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity")) - (ignore-errors (require 'latin-unity))) + (require 'latin-unity)) ;; Now, can we use it? (if (featurep 'latin-unity) @@ -1010,8 +1012,8 @@ (memq 'iso-8859-15 charsets) (memq 'iso-8859-15 hack-charsets) (save-excursion (mm-iso-8859-x-to-15-region b e))) - (mapcar (lambda (x) (setq charsets (delq (car x) charsets))) - mm-iso-8859-15-compatible)) + (dolist (x mm-iso-8859-15-compatible) + (setq charsets (delq (car x) charsets)))) (if (and (memq 'iso-2022-jp-2 charsets) (memq 'iso-2022-jp-2 hack-charsets)) (setq charsets (delq 'iso-2022-jp charsets))) @@ -1093,10 +1095,10 @@ ;; Remove composition since the base charsets have been included. ;; Remove eight-bit-*, treat them as ascii. (let ((css (find-charset-region b e))) - (mapcar (lambda (cs) (setq css (delq cs css))) - '(composition eight-bit-control eight-bit-graphic - control-1)) - css)) + (dolist (cs + '(composition eight-bit-control eight-bit-graphic control-1) + css) + (setq css (delq cs css))))) (t ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit. (save-excursion @@ -1119,21 +1121,6 @@ mm-mime-mule-charset-alist))))) (list 'ascii (or charset 'latin-iso8859-1))))))))) -(if (fboundp 'shell-quote-argument) - (defalias 'mm-quote-arg 'shell-quote-argument) - (defun mm-quote-arg (arg) - "Return a version of ARG that is safe to evaluate in a shell." - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))) - (defun mm-auto-mode-alist () "Return an `auto-mode-alist' with only the .gz (etc) thingies." (let ((alist auto-mode-alist) @@ -1145,7 +1132,7 @@ (nreverse out))) (defvar mm-inhibit-file-name-handlers - '(jka-compr-handler image-file-handler) + '(jka-compr-handler image-file-handler epa-file-handler) "A list of handlers doing (un)compression (etc) thingies.") (defun mm-insert-file-contents (filename &optional visit beg end replace @@ -1231,7 +1218,7 @@ (>= (length def) 4) (eq (nth 3 def) 'suffix))))) (defalias 'mm-make-temp-file 'make-temp-file) - ;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22. + ;; Stolen (and modified for XEmacs) from Emacs 22. (defun mm-make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end @@ -1271,10 +1258,9 @@ nil 'excl)) nil) (file-already-exists t) - ;; The Emacs 20 and XEmacs versions of - ;; `make-directory' issue `file-error'. - (file-error (or (and (or (featurep 'xemacs) - (= emacs-major-version 20)) + ;; The XEmacs version of `make-directory' issues + ;; `file-error'. + (file-error (or (and (featurep 'xemacs) (file-exists-p file)) (signal (car err) (cdr err))))) ;; the file was somehow created by someone else between @@ -1322,6 +1308,187 @@ (let ((cs (mm-detect-coding-region start end))) cs))) +(eval-when-compile + (unless (fboundp 'coding-system-to-mime-charset) + (defalias 'coding-system-to-mime-charset 'ignore))) + +(defun mm-coding-system-to-mime-charset (coding-system) + "Return the MIME charset corresponding to CODING-SYSTEM. +To make this function work with XEmacs, the APEL package is required." + (when coding-system + (or (and (fboundp 'coding-system-get) + (or (coding-system-get coding-system :mime-charset) + (coding-system-get coding-system 'mime-charset))) + (and (featurep 'xemacs) + (or (and (fboundp 'coding-system-to-mime-charset) + (not (eq (symbol-function 'coding-system-to-mime-charset) + 'ignore))) + (and (condition-case nil + (require 'mcharset) + (error nil)) + (fboundp 'coding-system-to-mime-charset))) + (coding-system-to-mime-charset coding-system))))) + +(eval-when-compile + (require 'jka-compr)) + +(defun mm-decompress-buffer (filename &optional inplace force) + "Decompress buffer's contents, depending on jka-compr. +Only when FORCE is t or `auto-compression-mode' is enabled and FILENAME +agrees with `jka-compr-compression-info-list', decompression is done. +Signal an error if FORCE is neither nil nor t and compressed data are +not decompressed because `auto-compression-mode' is disabled. +If INPLACE is nil, return decompressed data or nil without modifying +the buffer. Otherwise, replace the buffer's contents with the +decompressed data. The buffer's multibyteness must be turned off." + (when (and filename + (if force + (prog1 t (require 'jka-compr)) + (and (fboundp 'jka-compr-installed-p) + (jka-compr-installed-p)))) + (let ((info (jka-compr-get-compression-info filename))) + (when info + (unless (or (memq force (list nil t)) + (jka-compr-installed-p)) + (error "")) + (let ((prog (jka-compr-info-uncompress-program info)) + (args (jka-compr-info-uncompress-args info)) + (msg (format "%s %s..." + (jka-compr-info-uncompress-message info) + filename)) + (err-file (jka-compr-make-temp-name)) + (cur (current-buffer)) + (coding-system-for-read mm-binary-coding-system) + (coding-system-for-write mm-binary-coding-system) + retval err-msg) + (message "%s" msg) + (mm-with-unibyte-buffer + (insert-buffer-substring cur) + (condition-case err + (progn + (unless (memq (apply 'call-process-region + (point-min) (point-max) + prog t (list t err-file) nil args) + jka-compr-acceptable-retval-list) + (erase-buffer) + (insert (mapconcat + 'identity + (delete "" (split-string + (prog2 + (insert-file-contents err-file) + (buffer-string) + (erase-buffer)))) + " ") + "\n") + (setq err-msg + (format "Error while executing \"%s %s < %s\"" + prog (mapconcat 'identity args " ") + filename))) + (setq retval (buffer-string))) + (error + (setq err-msg (error-message-string err))))) + (when (file-exists-p err-file) + (ignore-errors (jka-compr-delete-temp-file err-file))) + (when inplace + (unless err-msg + (delete-region (point-min) (point-max)) + (insert retval)) + (setq retval nil)) + (message "%s" (or err-msg (concat msg "done"))) + retval))))) + +(eval-when-compile + (unless (fboundp 'coding-system-name) + (defalias 'coding-system-name 'ignore)) + (unless (fboundp 'find-file-coding-system-for-read-from-filename) + (defalias 'find-file-coding-system-for-read-from-filename 'ignore)) + (unless (fboundp 'find-operation-coding-system) + (defalias 'find-operation-coding-system 'ignore))) + +(defun mm-find-buffer-file-coding-system (&optional filename) + "Find coding system used to decode the contents of the current buffer. +This function looks for the coding system magic cookie or examines the +coding system specified by `file-coding-system-alist' being associated +with FILENAME which defaults to `buffer-file-name'. Data compressed by +gzip, bzip2, etc. are allowed." + (unless filename + (setq filename buffer-file-name)) + (save-excursion + (let ((decomp (unless ;; No worth to examine charset of tar files. + (and filename + (string-match + "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'" + filename)) + (mm-decompress-buffer filename nil t)))) + (when decomp + (set-buffer (let (default-enable-multibyte-characters) + (generate-new-buffer " *temp*"))) + (insert decomp) + (setq filename (file-name-sans-extension filename))) + (goto-char (point-min)) + (prog1 + (cond + ((boundp 'set-auto-coding-function) ;; Emacs + (if filename + (or (funcall (symbol-value 'set-auto-coding-function) + filename (- (point-max) (point-min))) + (car (find-operation-coding-system 'insert-file-contents + filename))) + (let (auto-coding-alist) + (condition-case nil + (funcall (symbol-value 'set-auto-coding-function) + nil (- (point-max) (point-min))) + (error nil))))) + ((featurep 'file-coding) ;; XEmacs + (let ((case-fold-search t) + (end (point-at-eol)) + codesys start) + (or + (and (re-search-forward "-\\*-+[\t ]*" end t) + (progn + (setq start (match-end 0)) + (re-search-forward "[\t ]*-+\\*-" end t)) + (progn + (setq end (match-beginning 0)) + (goto-char start) + (or (looking-at "coding:[\t ]*\\([^\t ;]+\\)") + (re-search-forward + "[\t ;]+coding:[\t ]*\\([^\t ;]+\\)" + end t))) + (find-coding-system (setq codesys + (intern (match-string 1)))) + codesys) + (and (re-search-forward "^[\t ]*;+[\t ]*Local[\t ]+Variables:" + nil t) + (progn + (setq start (match-end 0)) + (re-search-forward "^[\t ]*;+[\t ]*End:" nil t)) + (progn + (setq end (match-beginning 0)) + (goto-char start) + (re-search-forward + "^[\t ]*;+[\t ]*coding:[\t ]*\\([^\t\n\r ]+\\)" + end t)) + (find-coding-system (setq codesys + (intern (match-string 1)))) + codesys) + (and (progn + (goto-char (point-min)) + (setq case-fold-search nil) + (re-search-forward "^;;;coding system: " + ;;(+ (point-min) 3000) t)) + nil t)) + (looking-at "[^\t\n\r ]+") + (find-coding-system + (setq codesys (intern (match-string 0)))) + codesys) + (and filename + (setq codesys + (find-file-coding-system-for-read-from-filename + filename)) + (coding-system-name (coding-system-base codesys))))))) + (when decomp + (kill-buffer (current-buffer))))))) (provide 'mm-util) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-uu.el --- a/lisp/gnus/mm-uu.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-uu.el Sun Oct 28 09:18:39 2007 +0000 @@ -68,9 +68,6 @@ (defvar mm-uu-yenc-decode-function 'yenc-decode-region) -(defvar mm-uu-pgp-beginning-signature - "^-----BEGIN PGP SIGNATURE-----") - (defvar mm-uu-beginning-regexp nil) (defvar mm-dissect-disposition "inline" @@ -90,19 +87,25 @@ :type 'regexp :group 'gnus-article-mime) +(defcustom mm-uu-tex-groups-regexp "\\.tex\\>" + "*Regexp matching TeX groups." + :version "23.0" + :type 'regexp + :group 'gnus-article-mime) + (defvar mm-uu-type-alist '((postscript "^%!PS-" "^%%EOF$" mm-uu-postscript-extract nil) - (uu + (uu ;; Maybe we should have a more strict test here. "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+" "^end[ \t]*$" mm-uu-uu-extract mm-uu-uu-filename) (binhex - "^:...............................................................$" + "^:.\\{63,63\\}$" ":$" mm-uu-binhex-extract nil @@ -157,7 +160,35 @@ nil mm-uu-diff-extract nil - mm-uu-diff-test)) + mm-uu-diff-test) + (message-marks + ;; Text enclosed with tags similar to `message-mark-insert-begin' and + ;; `message-mark-insert-end'. Don't use those variables to avoid + ;; dependency on `message.el'. + "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" + "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" + (lambda () (mm-uu-verbatim-marks-extract 0 -1 1 -1)) + nil) + ;; Omitting [a-z8<] leads to false positives (bogus signature separators + ;; and mailing list banners). + (insert-marks + "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$" + "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$" + (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) + nil) + (verbatim-marks + ;; slrn-style verbatim marks, see + ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81 + "^#v\\+" + "^#v\\-$" + (lambda () (mm-uu-verbatim-marks-extract 0 0)) + nil) + (LaTeX + "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]" + "^\\\\end{document}" + mm-uu-latex-extract + nil + mm-uu-latex-test)) "A list of specifications for non-MIME attachments. Each element consist of the following entries: label, start-regexp, end-regexp, extract-function, test-function. @@ -201,9 +232,45 @@ (defsubst mm-uu-function-2 (entry) (nth 5 entry)) -(defun mm-uu-copy-to-buffer (&optional from to) +;; In Emacs 22, we could use `min-colors' in the face definition. But Emacs +;; 21 and XEmacs don't support it. +(defcustom mm-uu-hide-markers + (< 16 (or (and (fboundp 'defined-colors) + (length (defined-colors))) + (and (fboundp 'device-color-cells) + (device-color-cells)) + 0)) + "If non-nil, hide verbatim markers. +The value should be nil on displays where the face +`mm-uu-extract' isn't distinguishable to the face `default'." + :type '(choice (const :tag "Hide" t) + (const :tag "Don't hide" nil)) + :version "23.0" ;; No Gnus + :group 'gnus-article-mime) + +(defface mm-uu-extract '(;; Colors from `gnus-cite-3' plus background: + (((class color) + (background dark)) + (:foreground "light yellow" + :background "dark green")) + (((class color) + (background light)) + (:foreground "dark green" + :background "light yellow")) + (t + ())) + "Face for extracted buffers." + ;; See `mm-uu-verbatim-marks-extract'. + :version "23.0" ;; No Gnus + :group 'gnus-article-mime) + +(defun mm-uu-copy-to-buffer (&optional from to properties) "Copy the contents of the current buffer to a fresh buffer. -Return that buffer." +Return that buffer. + +If PROPERTIES is non-nil, PROPERTIES are applied to the buffer, +see `set-text-properties'. If PROPERTIES equals t, this means to +apply the face `mm-uu-extract'." (let ((obuf (current-buffer)) (coding-system ;; Might not exist in non-MULE XEmacs @@ -212,6 +279,11 @@ (with-current-buffer (generate-new-buffer " *mm-uu*") (setq buffer-file-coding-system coding-system) (insert-buffer-substring obuf from to) + (cond ((eq properties t) + (set-text-properties (point-min) (point-max) + '(face mm-uu-extract))) + (properties + (set-text-properties (point-min) (point-max) properties))) (current-buffer)))) (defun mm-uu-configure-p (key val) @@ -267,6 +339,35 @@ (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/postscript"))) +(defun mm-uu-verbatim-marks-extract (start-offset end-offset + &optional + start-hide + end-hide) + (let ((start (or (and mm-uu-hide-markers + start-hide) + start-offset + 1)) + (end (or (and mm-uu-hide-markers + end-hide) + end-offset + -1))) + (mm-make-handle + (mm-uu-copy-to-buffer + (progn (goto-char start-point) + (forward-line start) + (point)) + (progn (goto-char end-point) + (forward-line end) + (point)) + t) + '("text/x-verbatim" (charset . gnus-decoded))))) + +(defun mm-uu-latex-extract () + (mm-make-handle + (mm-uu-copy-to-buffer start-point end-point t) + ;; application/x-tex? + '("text/x-verbatim" (charset . gnus-decoded)))) + (defun mm-uu-emacs-sources-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) '("application/emacs-lisp" (charset . gnus-decoded)) @@ -292,6 +393,11 @@ mm-uu-diff-groups-regexp (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name))) +(defun mm-uu-latex-test () + (and gnus-newsgroup-name + mm-uu-tex-groups-regexp + (string-match mm-uu-tex-groups-regexp gnus-newsgroup-name))) + (defun mm-uu-forward-extract () (mm-make-handle (mm-uu-copy-to-buffer (progn (goto-char start-point) (forward-line) (point)) @@ -369,30 +475,16 @@ (progn (mml2015-clean-buffer) (let ((coding-system-for-write (or gnus-newsgroup-charset - 'iso-8859-1))) + 'iso-8859-1)) + (coding-system-for-read (or gnus-newsgroup-charset + 'iso-8859-1))) (funcall (mml2015-clear-verify-function)))) (when (and mml2015-use (null (mml2015-clear-verify-function))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (format "Clear verification not supported by `%s'.\n" mml2015-use)))) - (goto-char (point-min)) - (forward-line) - ;; We need to be careful not to strip beyond the armor headers. - ;; Previously, an attacker could replace the text inside our - ;; markup with trailing garbage by injecting whitespace into the - ;; message. - (while (looking-at "Hash:") ; The only header allowed in cleartext - (forward-line)) ; signatures according to RFC2440. - (when (looking-at "[\t ]*$") - (forward-line)) - (delete-region (point-min) (point)) - (if (re-search-forward mm-uu-pgp-beginning-signature nil t) - (delete-region (match-beginning 0) (point-max))) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (replace-match "" t t) - (forward-line 1))) - (list (mm-make-handle buf mm-uu-text-plain-type)))) + (format "Clear verification not supported by `%s'.\n" mml2015-use))) + (mml2015-extract-cleartext-signature)) + (list (mm-make-handle buf mm-uu-text-plain-type))))) (defun mm-uu-pgp-signed-extract () (let ((mm-security-handle (list (format "multipart/signed")))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mm-view.el --- a/lisp/gnus/mm-view.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mm-view.el Sun Oct 28 09:18:39 2007 +0000 @@ -30,15 +30,14 @@ (require 'mailcap) (require 'mm-bodies) (require 'mm-decode) +(require 'smime) (eval-and-compile (autoload 'gnus-article-prepare-display "gnus-art") (autoload 'vcard-parse-string "vcard") (autoload 'vcard-format-string "vcard") (autoload 'fill-flowed "flow-fill") - (autoload 'html2text "html2text" nil t) - (unless (fboundp 'diff-mode) - (autoload 'diff-mode "diff-mode" "" t nil))) + (autoload 'html2text "html2text" nil t)) (defvar gnus-article-mime-handles) (defvar gnus-newsgroup-charset) @@ -73,7 +72,7 @@ "The attributes of washer types for text/html.") (defcustom mm-fill-flowed t - "If non-nil an format=flowed article will be displayed flowed." + "If non-nil a format=flowed article will be displayed flowed." :type 'boolean :version "22.1" :group 'mime-display) @@ -140,26 +139,26 @@ (charset (mail-content-type-get (mm-handle-type handle) 'charset))) (save-excursion - (insert text) + (insert (if charset (mm-decode-string text charset) text)) (save-restriction (narrow-to-region b (point)) - (goto-char (point-min)) - (if (or (and (boundp 'w3-meta-content-type-charset-regexp) - (re-search-forward - w3-meta-content-type-charset-regexp nil t)) - (and (boundp 'w3-meta-charset-content-type-regexp) - (re-search-forward - w3-meta-charset-content-type-regexp nil t))) + (unless charset + (goto-char (point-min)) + (when (or (and (boundp 'w3-meta-content-type-charset-regexp) + (re-search-forward + w3-meta-content-type-charset-regexp nil t)) + (and (boundp 'w3-meta-charset-content-type-regexp) + (re-search-forward + w3-meta-charset-content-type-regexp nil t))) (setq charset - (or (let ((bsubstr (buffer-substring-no-properties - (match-beginning 2) - (match-end 2)))) - (if (fboundp 'w3-coding-system-for-mime-charset) - (w3-coding-system-for-mime-charset bsubstr) - (mm-charset-to-coding-system bsubstr))) - charset))) - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset)) + (let ((bsubstr (buffer-substring-no-properties + (match-beginning 2) + (match-end 2)))) + (if (fboundp 'w3-coding-system-for-mime-charset) + (w3-coding-system-for-mime-charset bsubstr) + (mm-charset-to-coding-system bsubstr)))) + (delete-region (point-min) (point-max)) + (insert (mm-decode-string text charset)))) (save-window-excursion (save-restriction (let ((w3-strict-width width) @@ -189,12 +188,12 @@ handle `(lambda () (let (buffer-read-only) - (if (functionp 'remove-specifier) - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) - (current-buffer))) - '(background background-pixmap foreground))) + ,@(if (functionp 'remove-specifier) + '((mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) + (current-buffer))) + '(background background-pixmap foreground)))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) @@ -263,13 +262,7 @@ (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) - (if (functionp 'remove-specifier) - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) - (current-buffer))) - '(background background-pixmap foreground))) + (let ((inhibit-read-only t)) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) @@ -428,7 +421,8 @@ (save-restriction (narrow-to-region b (point)) (goto-char b) - (fill-flowed) + (fill-flowed nil (equal (cdr (assoc 'delsp (mm-handle-type handle))) + "yes")) (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) @@ -448,6 +442,8 @@ "Insert TEXT inline from HANDLE." (let ((b (point))) (insert text) + (unless (bolp) + (insert "\n")) (mm-handle-set-undisplayer handle `(lambda () @@ -530,38 +526,55 @@ (delete-region ,(point-min-marker) ,(point-max-marker))))))))) (defun mm-display-inline-fontify (handle mode) - (let (text) + (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) + text coding-system) + (unless (eq charset 'gnus-decoded) + (mm-with-unibyte-buffer + (mm-insert-part handle) + (mm-decompress-buffer + (or (mail-content-type-get (mm-handle-disposition handle) 'name) + (mail-content-type-get (mm-handle-disposition handle) 'filename)) + t t) + (unless charset + (setq coding-system (mm-find-buffer-file-coding-system))) + (setq text (buffer-string)))) ;; XEmacs @#$@ version of font-lock refuses to fully turn itself ;; on for buffers whose name begins with " ". That's why we use - ;; save-current-buffer/get-buffer-create rather than - ;; with-temp-buffer. - (save-current-buffer - (set-buffer (generate-new-buffer "*fontification*")) - (unwind-protect - (progn - (buffer-disable-undo) - (mm-insert-part handle) - (require 'font-lock) - (let ((font-lock-maximum-size nil) - ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. - (font-lock-mode-hook nil) - (font-lock-support-mode nil) - ;; I find font-lock a bit too verbose. - (font-lock-verbose nil)) - (funcall mode) - ;; The mode function might have already turned on font-lock. - (unless (symbol-value 'font-lock-mode) - (font-lock-fontify-buffer))) - ;; By default, XEmacs font-lock uses non-duplicable text - ;; properties. This code forces all the text properties - ;; to be copied along with the text. - (when (fboundp 'extent-list) - (map-extents (lambda (ext ignored) - (set-extent-property ext 'duplicable t) - nil) - nil nil nil nil nil 'text-prop)) - (setq text (buffer-string))) - (kill-buffer (current-buffer)))) + ;; `with-current-buffer'/`generate-new-buffer' rather than + ;; `with-temp-buffer'. + (with-current-buffer (generate-new-buffer "*fontification*") + (buffer-disable-undo) + (mm-enable-multibyte) + (insert (cond ((eq charset 'gnus-decoded) + (with-current-buffer (mm-handle-buffer handle) + (buffer-string))) + (coding-system + (mm-decode-coding-string text coding-system)) + (charset + (mm-decode-string text charset)) + (t + text))) + (require 'font-lock) + (let ((font-lock-maximum-size nil) + ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. + (font-lock-mode-hook nil) + (font-lock-support-mode nil) + ;; I find font-lock a bit too verbose. + (font-lock-verbose nil)) + (funcall mode) + ;; The mode function might have already turned on font-lock. + (unless (symbol-value 'font-lock-mode) + (font-lock-fontify-buffer))) + ;; By default, XEmacs font-lock uses non-duplicable text + ;; properties. This code forces all the text properties + ;; to be copied along with the text. + (when (fboundp 'extent-list) + (map-extents (lambda (ext ignored) + (set-extent-property ext 'duplicable t) + nil) + nil nil nil nil nil 'text-prop)) + (setq text (buffer-string)) + (kill-buffer (current-buffer))) (mm-insert-inline handle text))) ;; Shouldn't these functions check whether the user even wants to use @@ -575,27 +588,28 @@ (defun mm-display-elisp-inline (handle) (mm-display-inline-fontify handle 'emacs-lisp-mode)) +(defun mm-display-dns-inline (handle) + (mm-display-inline-fontify handle 'dns-mode)) + ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } (defvar mm-pkcs7-signed-magic (mm-string-as-unibyte - (apply 'concat - (mapcar 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02))))) + (mapconcat 'char-to-string + (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c + ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e + ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 + ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02) ""))) ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } (defvar mm-pkcs7-enveloped-magic (mm-string-as-unibyte - (apply 'concat - (mapcar 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03))))) + (mapconcat 'char-to-string + (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c + ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e + ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 + ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03) ""))) (defun mm-view-pkcs7-get-type (handle) (mm-with-unibyte-buffer @@ -614,23 +628,26 @@ (otherwise (error "Unknown or unimplemented PKCS#7 type")))) (defun mm-view-pkcs7-verify (handle) - ;; A bogus implementation of PKCS#7. FIXME:: - (mm-insert-part handle) - (goto-char (point-min)) - (if (search-forward "Content-Type: " nil t) - (delete-region (point-min) (match-beginning 0))) - (goto-char (point-max)) - (if (re-search-backward "--\r?\n?" nil t) - (delete-region (match-end 0) (point-max))) + (let ((verified nil)) + (with-temp-buffer + (insert "MIME-Version: 1.0\n") + (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m") + (insert-buffer-substring (mm-handle-buffer handle)) + (setq verified (smime-verify-region (point-min) (point-max)))) + (goto-char (point-min)) + (mm-insert-part handle) + (if (search-forward "Content-Type: " nil t) + (delete-region (point-min) (match-beginning 0))) + (goto-char (point-max)) + (if (re-search-backward "--\r?\n?" nil t) + (delete-region (match-end 0) (point-max))) + (unless verified + (insert-buffer-substring smime-details-buffer))) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) - (message "Verify signed PKCS#7 message is unimplemented.") - (sit-for 1) t) -(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro) - (defun mm-view-pkcs7-decrypt (handle) (insert-buffer-substring (mm-handle-buffer handle)) (goto-char (point-min)) @@ -641,10 +658,9 @@ (if (= (length smime-keys) 1) (cadar smime-keys) (smime-get-key-by-email - (gnus-completing-read-maybe-default + (completing-read (concat "Decipher using key" - (if smime-keys - (concat " (default " (caar smime-keys) "): ") + (if smime-keys (concat "(default " (caar smime-keys) "): ") ": ")) smime-keys nil nil nil nil (car-safe (car-safe smime-keys)))))) (goto-char (point-min)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mml-sec.el --- a/lisp/gnus/mml-sec.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mml-sec.el Sun Oct 28 09:18:39 2007 +0000 @@ -26,14 +26,20 @@ ;;; Code: -(require 'mml-smime) (eval-when-compile (require 'cl)) +(require 'password) (autoload 'mml2015-sign "mml2015") (autoload 'mml2015-encrypt "mml2015") (autoload 'mml1991-sign "mml1991") (autoload 'mml1991-encrypt "mml1991") (autoload 'message-goto-body "message") (autoload 'mml-insert-tag "mml") +(autoload 'mml-smime-sign "mml-smime") +(autoload 'mml-smime-encrypt "mml-smime") +(autoload 'mml-smime-sign-query "mml-smime") +(autoload 'mml-smime-encrypt-query "mml-smime") +(autoload 'mml-smime-verify "mml-smime") +(autoload 'mml-smime-verify-test "mml-smime") (defvar mml-sign-alist '(("smime" mml-smime-sign-buffer mml-smime-sign-query) @@ -96,6 +102,23 @@ (choice (const :tag "Separate" separate) (const :tag "Combined" combined))))) +(defcustom mml-secure-verbose nil + "If non-nil, ask the user about the current operation more verbosely." + :group 'message + :type 'boolean) + +(defcustom mml-secure-cache-passphrase password-cache + "If t, cache passphrase." + :group 'message + :type 'boolean) + +(defcustom mml-secure-passphrase-cache-expiry password-cache-expiry + "How many seconds the passphrase is cached. +Whether the passphrase is cached at all is controlled by +`mml-secure-cache-passphrase'." + :group 'message + :type 'integer) + ;;; Configuration/helper functions (defun mml-signencrypt-style (method &optional style) @@ -249,6 +272,13 @@ ;; defuns that add the proper <#secure ...> tag to the top of the message body (defun mml-secure-message (method &optional modesym) (let ((mode (prin1-to-string modesym)) + (tags (append + (if (or (eq modesym 'sign) + (eq modesym 'signencrypt)) + (funcall (nth 2 (assoc method mml-sign-alist)))) + (if (or (eq modesym 'encrypt) + (eq modesym 'signencrypt)) + (funcall (nth 2 (assoc method mml-encrypt-alist)))))) insert-loc) (mml-unsecure-message) (save-excursion @@ -257,8 +287,8 @@ (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (goto-char (setq insert-loc (match-end 0))) (unless (looking-at "<#secure") - (mml-insert-tag - 'secure 'method method 'mode mode))) + (apply 'mml-insert-tag + 'secure 'method method 'mode mode tags))) (t (error "The message is corrupted. No mail header separator")))) (when (eql insert-loc (point)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mml-smime.el --- a/lisp/gnus/mml-smime.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mml-smime.el Sun Oct 28 09:18:39 2007 +0000 @@ -31,10 +31,82 @@ (require 'smime) (require 'mm-decode) +(require 'mml-sec) (autoload 'message-narrow-to-headers "message") (autoload 'message-fetch-field "message") +(defvar mml-smime-use 'openssl) + +(defvar mml-smime-function-alist + '((openssl mml-smime-openssl-sign + mml-smime-openssl-encrypt + mml-smime-openssl-sign-query + mml-smime-openssl-encrypt-query + mml-smime-openssl-verify + mml-smime-openssl-verify-test) + (epg mml-smime-epg-sign + mml-smime-epg-encrypt + nil + nil + mml-smime-epg-verify + mml-smime-epg-verify-test))) + +(defcustom mml-smime-verbose mml-secure-verbose + "If non-nil, ask the user about the current operation more verbosely." + :group 'mime-security + :type 'boolean) + +(defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase + "If t, cache passphrase." + :group 'mime-security + :type 'boolean) + +(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry + "How many seconds the passphrase is cached. +Whether the passphrase is cached at all is controlled by +`mml-smime-cache-passphrase'." + :group 'mime-security + :type 'integer) + +(defcustom mml-smime-signers nil + "A list of your own key ID which will be used to sign a message." + :group 'mime-security + :type '(repeat (string :tag "Key ID"))) + (defun mml-smime-sign (cont) + (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find sign function")))) + +(defun mml-smime-encrypt (cont) + (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func cont) + (error "Cannot find encrypt function")))) + +(defun mml-smime-sign-query () + (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func)))) + +(defun mml-smime-encrypt-query () + (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func)))) + +(defun mml-smime-verify (handle ctl) + (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func handle ctl) + handle))) + +(defun mml-smime-verify-test (handle ctl) + (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist)))) + (if func + (funcall func handle ctl)))) + +(defun mml-smime-openssl-sign (cont) (when (null smime-keys) (customize-variable 'smime-keys) (error "No S/MIME keys configured, use customize to add your key")) @@ -44,7 +116,7 @@ (replace-match "\n" t t)) (goto-char (point-max))) -(defun mml-smime-encrypt (cont) +(defun mml-smime-openssl-encrypt (cont) (let (certnames certfiles tmp file tmpfiles) ;; xxx tmp files are always an security issue (while (setq tmp (pop cont)) @@ -70,7 +142,7 @@ nil)) (goto-char (point-max))) -(defun mml-smime-sign-query () +(defun mml-smime-openssl-sign-query () ;; query information (what certificate) from user when MML tag is ;; added, for use later by the signing process (when (null smime-keys) @@ -123,22 +195,42 @@ (quit)) result)) -(defun mml-smime-encrypt-query () - ;; todo: add ldap support (xemacs ldap api?) +(defun mml-smime-get-ldap-cert () + ;; todo: deal with comma separated multiple recipients + (let (result who bad cert) + (condition-case () + (while (not result) + (setq who (read-from-minibuffer + (format "%sLookup certificate for: " (or bad "")) + (cadr (funcall gnus-extract-address-components + (or (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "to"))) + ""))))) + (if (setq cert (smime-cert-by-ldap who)) + (setq result (list 'certfile (buffer-name cert))) + (setq bad (format "`%s' not found. " who)))) + (quit)) + result)) + +(defun mml-smime-openssl-encrypt-query () ;; todo: try dns/ldap automatically first, before prompting user (let (certs done) (while (not done) (ecase (read (gnus-completing-read-with-default - "dns" "Fetch certificate from" - '(("dns") ("file")) nil t)) + "ldap" "Fetch certificate from" + '(("dns") ("ldap") ("file")) nil t)) (dns (setq certs (append certs (mml-smime-get-dns-cert)))) + (ldap (setq certs (append certs + (mml-smime-get-ldap-cert)))) (file (setq certs (append certs (mml-smime-get-file-cert))))) (setq done (not (y-or-n-p "Add more recipients? ")))) certs)) -(defun mml-smime-verify (handle ctl) +(defun mml-smime-openssl-verify (handle ctl) (with-temp-buffer (insert-buffer-substring (mm-handle-multipart-original-buffer ctl)) (goto-char (point-min)) @@ -203,9 +295,249 @@ (buffer-string) "\n"))))) handle) -(defun mml-smime-verify-test (handle ctl) +(defun mml-smime-openssl-verify-test (handle ctl) smime-openssl-program) +(eval-and-compile + (autoload 'epg-make-context "epg")) + +(eval-when-compile + (defvar epg-user-id-alist) + (defvar epg-digest-algorithm-alist) + (defvar inhibit-redisplay) + (autoload 'epg-context-set-armor "epg") + (autoload 'epg-context-set-signers "epg") + (autoload 'epg-context-result-for "epg") + (autoload 'epg-new-signature-digest-algorithm "epg") + (autoload 'epg-verify-result-to-string "epg") + (autoload 'epg-list-keys "epg") + (autoload 'epg-decrypt-string "epg") + (autoload 'epg-verify-string "epg") + (autoload 'epg-sign-string "epg") + (autoload 'epg-encrypt-string "epg") + (autoload 'epg-passphrase-callback-function "epg") + (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-configuration "epg-config") + (autoload 'epg-expand-group "epg-config") + (autoload 'epa-select-keys "epa")) + +(eval-when-compile + (defvar password-cache-expiry) + (autoload 'password-read "password") + (autoload 'password-cache-add "password") + (autoload 'password-cache-remove "password")) + +(defvar mml-smime-epg-secret-key-id-list nil) + +(defun mml-smime-epg-passphrase-callback (context key-id ignore) + (if (eq key-id 'SYM) + (epg-passphrase-callback-function context key-id nil) + (let* (entry + (passphrase + (password-read + (if (eq key-id 'PIN) + "Passphrase for PIN: " + (if (setq entry (assoc key-id epg-user-id-alist)) + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))) + (if (eq key-id 'PIN) + "PIN" + key-id)))) + (when passphrase + (let ((password-cache-expiry mml-smime-passphrase-cache-expiry)) + (password-cache-add key-id passphrase)) + (setq mml-smime-epg-secret-key-id-list + (cons key-id mml-smime-epg-secret-key-id-list)) + (copy-sequence passphrase))))) + +(defun mml-smime-epg-find-usable-key (keys usage) + (catch 'found + (while keys + (let ((pointer (epg-key-sub-key-list (car keys)))) + (while pointer + (if (and (memq usage (epg-sub-key-capability (car pointer))) + (not (memq (epg-sub-key-validity (car pointer)) + '(revoked expired)))) + (throw 'found (car keys))) + (setq pointer (cdr pointer)))) + (setq keys (cdr keys))))) + +(defun mml-smime-epg-sign (cont) + (let* ((inhibit-redisplay t) + (context (epg-make-context 'CMS)) + (boundary (mml-compute-boundary cont)) + signer-key + (signers + (or (message-options-get 'mml-smime-epg-signers) + (message-options-set + 'mml-smime-epg-signers + (if mml-smime-verbose + (epa-select-keys context "\ +Select keys for signing. +If no one is selected, default secret key is used. " + mml-smime-signers t) + (if mml-smime-signers + (mapcar + (lambda (signer) + (setq signer-key (mml-smime-epg-find-usable-key + (epg-list-keys context signer t) + 'sign)) + (unless (or signer-key + (y-or-n-p + (format "No secret key for %s; skip it? " + signer))) + (error "No secret key for %s" signer)) + signer-key) + mml-smime-signers)))))) + signature micalg) + (epg-context-set-signers context signers) + (if mml-smime-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml-smime-epg-passphrase-callback)) + (condition-case error + (setq signature (epg-sign-string context + (mm-replace-in-string (buffer-string) + "\n" "\r\n") + t) + mml-smime-epg-secret-key-id-list nil) + (error + (while mml-smime-epg-secret-key-id-list + (password-cache-remove (car mml-smime-epg-secret-key-id-list)) + (setq mml-smime-epg-secret-key-id-list + (cdr mml-smime-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (if (epg-context-result-for context 'sign) + (setq micalg (epg-new-signature-digest-algorithm + (car (epg-context-result-for context 'sign))))) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (if micalg + (insert (format "\tmicalg=%s; " + (downcase + (cdr (assq micalg + epg-digest-algorithm-alist)))))) + (insert "protocol=\"application/pkcs7-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pkcs7-signature; name=smime.p7s +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename=smime.p7s + +") + (insert (base64-encode-string signature) "\n") + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +(defun mml-smime-epg-encrypt (cont) + (let ((inhibit-redisplay t) + (context (epg-make-context 'CMS)) + (config (epg-configuration)) + (recipients (message-options-get 'mml-smime-epg-recipients)) + cipher signers + (boundary (mml-compute-boundary cont)) + recipient-key) + (unless recipients + (setq recipients + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list recipient))) + (split-string + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+")))) + (if mml-smime-verbose + (setq recipients + (epa-select-keys context "\ +Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients)) + (setq recipients + (mapcar + (lambda (recipient) + (setq recipient-key (mml-smime-epg-find-usable-key + (epg-list-keys context recipient) + 'encrypt)) + (unless (or recipient-key + (y-or-n-p + (format "No public key for %s; skip it? " + recipient))) + (error "No public key for %s" recipient)) + recipient-key) + recipients)) + (unless recipients + (error "No recipient specified"))) + (message-options-set 'mml-smime-epg-recipients recipients)) + (if mml-smime-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml-smime-epg-passphrase-callback)) + (condition-case error + (setq cipher + (epg-encrypt-string context (buffer-string) recipients) + mml-smime-epg-secret-key-id-list nil) + (error + (while mml-smime-epg-secret-key-id-list + (password-cache-remove (car mml-smime-epg-secret-key-id-list)) + (setq mml-smime-epg-secret-key-id-list + (cdr mml-smime-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "\ +Content-Type: application/pkcs7-mime; + smime-type=enveloped-data; + name=smime.p7m +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename=smime.p7m + +") + (insert (base64-encode-string cipher)) + (goto-char (point-max)))) + +(defun mml-smime-epg-verify (handle ctl) + (catch 'error + (let ((inhibit-redisplay t) + context plain signature-file part signature) + (when (or (null (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter + ctl 'protocol) + "application/pkcs7-signature") + t))) + (null (setq signature (mm-find-part-by-type + (cdr handle) + "application/pkcs7-signature" + nil t)))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (setq part (mm-replace-in-string part "\n" "\r\n" t) + context (epg-make-context 'CMS)) + (condition-case error + (setq plain (epg-verify-string context (mm-get-part signature) part)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (if (eq (car error) 'quit) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (format "%S" error))) + (throw 'error handle))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (epg-verify-result-to-string (epg-context-result-for context 'verify))) + handle))) + +(defun mml-smime-epg-verify-test (handle ctl) + t) + (provide 'mml-smime) ;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mml.el --- a/lisp/gnus/mml.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mml.el Sun Oct 28 09:18:39 2007 +0000 @@ -35,9 +35,9 @@ (eval-and-compile (autoload 'message-make-message-id "message") (autoload 'gnus-setup-posting-charset "gnus-msg") - (autoload 'gnus-add-minor-mode "gnus-ems") (autoload 'gnus-make-local-hook "gnus-util") (autoload 'message-fetch-field "message") + (autoload 'message-mark-active-p "message") (autoload 'message-info "message") (autoload 'fill-flowed-encode "flow-fill") (autoload 'message-posting-charset "message") @@ -70,6 +70,46 @@ :type '(repeat (symbol :tag "Parameter")) :group 'message) +(defcustom mml-content-disposition-alist + '((text (rtf . "attachment") (t . "inline")) + (t . "attachment")) + "Alist of MIME types or regexps matching file names and default dispositions. +Each element should be one of the following three forms: + + (REGEXP . DISPOSITION) + (SUPERTYPE (SUBTYPE . DISPOSITION) (SUBTYPE . DISPOSITION)...) + (TYPE . DISPOSITION) + +Where REGEXP is a string which matches the file name (if any) of an +attachment, SUPERTYPE, SUBTYPE and TYPE should be symbols which are a +MIME supertype (e.g., text), a MIME subtype (e.g., plain) and a MIME +type (e.g., text/plain) respectively, and DISPOSITION should be either +the string \"attachment\" or the string \"inline\". The value t for +SUPERTYPE, SUBTYPE or TYPE matches any of those types. The first +match found will be used." + :version "23.0" ;; No Gnus + :type (let ((dispositions '(radio :format "DISPOSITION: %v" + :value "attachment" + (const :format "%v " "attachment") + (const :format "%v\n" "inline")))) + `(repeat + :offset 0 + (choice :format "%[Value Menu%]%v" + (cons :tag "(REGEXP . DISPOSITION)" :extra-offset 4 + (regexp :tag "REGEXP" :value ".*") + ,dispositions) + (cons :tag "(SUPERTYPE (SUBTYPE . DISPOSITION)...)" + :indent 0 + (symbol :tag " SUPERTYPE" :value text) + (repeat :format "%v%i\n" :offset 0 :extra-offset 4 + (cons :format "%v" :extra-offset 5 + (symbol :tag "SUBTYPE" :value t) + ,dispositions))) + (cons :tag "(TYPE . DISPOSITION)" :extra-offset 4 + (symbol :tag "TYPE" :value t) + ,dispositions)))) + :group 'message) + (defcustom mml-insert-mime-headers-always nil "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." @@ -154,19 +194,15 @@ (defun mml-destroy-buffers () (let (kill-buffer-hook) - (mapcar 'kill-buffer mml-buffer-list) + (mapc 'kill-buffer mml-buffer-list) (setq mml-buffer-list nil))) (defun mml-parse () "Parse the current buffer as an MML document." (save-excursion (goto-char (point-min)) - (let ((table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table mml-syntax-table) - (mml-parse-1)) - (set-syntax-table table))))) + (with-syntax-table mml-syntax-table + (mml-parse-1)))) (defun mml-parse-1 () "Parse the current buffer as an MML document." @@ -181,6 +217,8 @@ ;; included in the message (let* (secure-mode (taginfo (mml-read-tag)) + (keyfile (cdr (assq 'keyfile taginfo))) + (certfile (cdr (assq 'certfile taginfo))) (recipients (cdr (assq 'recipients taginfo))) (sender (cdr (assq 'sender taginfo))) (location (cdr (assq 'tag-location taginfo))) @@ -188,9 +226,8 @@ (method (cdr (assq 'method taginfo))) tags) (save-excursion - (if - (re-search-forward - "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t) + (if (re-search-forward + "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t) (setq secure-mode "multipart") (setq secure-mode "part"))) (save-excursion @@ -205,6 +242,10 @@ (setq tags (list "sign" method "encrypt" method)))) (eval `(mml-insert-tag ,secure-mode ,@tags + ,(if keyfile "keyfile") + ,keyfile + ,(if certfile "certfile") + ,certfile ,(if recipients "recipients") ,recipients ,(if sender "sender") @@ -427,21 +468,24 @@ (or (mm-default-file-encoding filename) "application/octet-stream") "text/plain"))) - coded encoding charset flowed) + (charset (cdr (assq 'charset cont))) + (coding (mm-charset-to-coding-system charset)) + encoding flowed coded) + (cond ((eq coding 'ascii) + (setq charset nil + coding nil)) + (charset + (setq charset (intern (downcase charset))))) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn (with-temp-buffer - (setq charset (mm-charset-to-coding-system - (cdr (assq 'charset cont)))) - (when (eq charset 'ascii) - (setq charset nil)) (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) - (let ((coding-system-for-read charset)) + (let ((coding-system-for-read coding)) (mm-insert-file-contents filename))) ((eq 'mml (car cont)) (insert (cdr (assq 'contents cont)))) @@ -491,7 +535,13 @@ ;; insert a "; format=flowed" string unless the ;; user has already specified it. (setq flowed (null (assq 'format cont))))) - (setq charset (mm-encode-body charset)) + ;; Prefer `utf-8' for text/calendar parts. + (if (or charset + (not (string= type "text/calendar"))) + (setq charset (mm-encode-body charset)) + (let ((mm-coding-system-priorities + (cons 'utf-8 mm-coding-system-priorities))) + (setq charset (mm-encode-body)))) (setq encoding (mm-body-encoding charset (cdr (assq 'encoding cont)))))) (setq coded (buffer-string))) @@ -507,7 +557,11 @@ ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) - (mm-insert-file-contents filename nil nil nil nil t))) + (mm-insert-file-contents filename nil nil nil nil t)) + (unless charset + (setq charset (mm-coding-system-to-mime-charset + (mm-find-buffer-file-coding-system + filename))))) (t (let ((contents (cdr (assq 'contents cont)))) (if (if (featurep 'xemacs) @@ -517,7 +571,7 @@ (mm-enable-multibyte) (insert contents) (unless raw - (setq charset (mm-encode-body)))) + (setq charset (mm-encode-body charset)))) (insert contents))))) (setq encoding (mm-encode-buffer type) coded (mm-string-as-multibyte (buffer-string)))) @@ -648,7 +702,7 @@ (incf mml-multipart-number))) (throw 'not-unique nil)))) ((eq (car cont) 'multipart) - (mapcar 'mml-compute-boundary-1 (cddr cont)))) + (mapc 'mml-compute-boundary-1 (cddr cont)))) t)) (defun mml-make-boundary (number) @@ -658,6 +712,30 @@ "") mml-base-boundary)) +(defun mml-content-disposition (type &optional filename) + "Return a default disposition name suitable to TYPE or FILENAME." + (let ((defs mml-content-disposition-alist) + disposition def types) + (while (and (not disposition) defs) + (setq def (pop defs)) + (cond ((stringp (car def)) + (when (and filename + (string-match (car def) filename)) + (setq disposition (cdr def)))) + ((consp (cdr def)) + (when (string= (car (setq types (split-string type "/"))) + (car def)) + (setq type (cadr types) + types (cdr def)) + (while (and (not disposition) types) + (setq def (pop types)) + (when (or (eq (car def) t) (string= type (car def))) + (setq disposition (cdr def)))))) + (t + (when (or (eq (car def) t) (string= type (car def))) + (setq disposition (cdr def)))))) + (or disposition "attachment"))) + (defun mml-insert-mime-headers (cont type charset encoding flowed) (let (parameters id disposition description) (setq parameters @@ -688,7 +766,9 @@ cont mml-content-disposition-parameters)) (when (or (setq disposition (cdr (assq 'disposition cont))) parameters) - (insert "Content-Disposition: " (or disposition "inline")) + (insert "Content-Disposition: " + (or disposition + (mml-content-disposition type (cdr (assq 'filename cont))))) (when parameters (mml-insert-parameter-string cont mml-content-disposition-parameters)) @@ -809,7 +889,7 @@ (goto-char (point-max)) (insert "<#/mml>\n")) ((stringp (car handle)) - (mapcar 'mml-insert-mime (cdr handle)) + (mapc 'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) (textp (let ((charset (mail-content-type-get @@ -1004,9 +1084,18 @@ ;;; inserting stuff to the buffer. ;;; +(defcustom mml-default-directory mm-default-directory + "The default directory where mml will find files. +If not set, `default-directory' will be used." + :type '(choice directory (const :tag "Default" nil)) + :version "23.0" ;; No Gnus + :group 'message) + (defun mml-minibuffer-read-file (prompt) (let* ((completion-ignored-extensions nil) - (file (read-file-name prompt nil nil t))) + (file (read-file-name prompt + (or mml-default-directory default-directory) + nil t))) ;; Prevent some common errors. This is inspired by similar code in ;; VM. (when (file-directory-p file) @@ -1038,16 +1127,13 @@ (setq description nil)) description)) -(defun mml-minibuffer-read-disposition (type &optional default) - (unless default (setq default - (if (and (string-match "\\`text/" type) - (not (string-match "\\`text/rtf\\'" type))) - "inline" - "attachment"))) +(defun mml-minibuffer-read-disposition (type &optional default filename) + (unless default + (setq default (mml-content-disposition type filename))) (let ((disposition (completing-read - (format "Disposition (default %s): " default) - '(("attachment") ("inline") ("")) - nil t nil nil default))) + (format "Disposition (default %s): " default) + '(("attachment") ("inline") ("")) + nil t nil nil default))) (if (not (equal disposition "")) disposition default))) @@ -1139,7 +1225,7 @@ (let* ((file (mml-minibuffer-read-file "Attach file: ")) (type (mml-minibuffer-read-type file)) (description (mml-minibuffer-read-description)) - (disposition (mml-minibuffer-read-disposition type))) + (disposition (mml-minibuffer-read-disposition type nil file))) (list file type description disposition))) (save-excursion (unless (message-in-body-p) (goto-char (point-max))) @@ -1170,7 +1256,7 @@ (when (memq 'description mml-dnd-attach-options) (setq description (mml-minibuffer-read-description))) (when (memq 'disposition mml-dnd-attach-options) - (setq disposition (mml-minibuffer-read-disposition type))) + (setq disposition (mml-minibuffer-read-disposition type nil file))) (mml-attach-file file type description disposition))))) (defun mml-attach-buffer (buffer &optional type description) @@ -1227,10 +1313,20 @@ (message-position-on-field "Mail-Followup-To" "X-Draft-From") (insert (message-make-mail-followup-to)))) +(defvar mml-preview-buffer nil) + (defun mml-preview (&optional raw) "Display current buffer with Gnus, in a new buffer. -If RAW, display a raw encoded MIME message." +If RAW, display a raw encoded MIME message. + +The window layout for the preview buffer is controled by the variables +`special-display-buffer-names', `special-display-regexps', or +`gnus-buffer-configuration' (the first match made will be used), +or the `pop-to-buffer' function." (interactive "P") + (setq mml-preview-buffer (generate-new-buffer + (concat (if raw "*Raw MIME preview of " + "*MIME preview of ") (buffer-name)))) (save-excursion (let* ((buf (current-buffer)) (message-options message-options) @@ -1242,13 +1338,13 @@ (message-fetch-field "Newsgroups"))) message-posting-charset))) (message-options-set-recipient) - (pop-to-buffer (generate-new-buffer - (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) (when (boundp 'gnus-buffers) - (push (current-buffer) gnus-buffers)) - (erase-buffer) - (insert-buffer-substring buf) + (push mml-preview-buffer gnus-buffers)) + (save-restriction + (widen) + (set-buffer mml-preview-buffer) + (erase-buffer) + (insert-buffer-substring buf)) (mml-preview-insert-mail-followup-to) (let ((message-deletable-headers (if (message-news-p) nil @@ -1261,6 +1357,7 @@ (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (replace-match "\n")) (let ((mail-header-separator ""));; mail-header-separator is removed. + (message-sort-headers) (mml-to-mime)) (if raw (when (fboundp 'set-buffer-multibyte) @@ -1293,7 +1390,15 @@ (lambda (event) (interactive "@e") (widget-button-press (widget-event-point event) event))) - (goto-char (point-min))))) + ;; FIXME: Buffer is in article mode, but most tool bar commands won't + ;; work. Maybe only keep the following icons: search, print, quit + (goto-char (point-min)))) + (if (and (not (mm-special-display-p (buffer-name mml-preview-buffer))) + (boundp 'gnus-buffer-configuration) + (assq 'mml-preview gnus-buffer-configuration)) + (let ((gnus-message-buffer (current-buffer))) + (gnus-configure-windows 'mml-preview)) + (pop-to-buffer mml-preview-buffer))) (defun mml-validate () "Validate the current MML document." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mml1991.el --- a/lisp/gnus/mml1991.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mml1991.el Sun Oct 28 09:18:39 2007 +0000 @@ -3,7 +3,7 @@ ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007 Free Software Foundation, Inc. -;; Author: Sascha Lüdecke , +;; Author: Sascha Ldecke , ;; Simon Josefsson (Mailcrypt interface, Gnus glue) ;; Keywords PGP @@ -32,6 +32,8 @@ (require 'cl) (require 'mm-util)) +(require 'mml-sec) + (defvar mc-pgp-always-sign) (autoload 'quoted-printable-decode-region "qp") @@ -46,9 +48,28 @@ (gpg mml1991-gpg-sign mml1991-gpg-encrypt) (pgg mml1991-pgg-sign - mml1991-pgg-encrypt)) + mml1991-pgg-encrypt) + (epg mml1991-epg-sign + mml1991-epg-encrypt)) "Alist of PGP functions.") +(defvar mml1991-verbose mml-secure-verbose + "If non-nil, ask the user about the current operation more verbosely.") + +(defvar mml1991-cache-passphrase mml-secure-cache-passphrase + "If t, cache passphrase.") + +(defvar mml1991-passphrase-cache-expiry mml-secure-passphrase-cache-expiry + "How many seconds the passphrase is cached. +Whether the passphrase is cached at all is controlled by +`mml1991-cache-passphrase'.") + +(defvar mml1991-signers nil + "A list of your own key ID which will be used to sign a message.") + +(defvar mml1991-encrypt-to-self nil + "If t, add your own key ID to recipient list when encryption.") + ;;; mailcrypt wrapper (eval-and-compile @@ -290,6 +311,183 @@ (insert-buffer-substring pgg-output-buffer) t) +;; epg wrapper + +(eval-and-compile + (autoload 'epg-make-context "epg")) + +(eval-when-compile + (defvar epg-user-id-alist) + (autoload 'epg-passphrase-callback-function "epg") + (autoload 'epa-select-keys "epa") + (autoload 'epg-list-keys "epg") + (autoload 'epg-context-set-armor "epg") + (autoload 'epg-context-set-textmode "epg") + (autoload 'epg-context-set-signers "epg") + (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-sign-string "epg") + (autoload 'epg-encrypt-string "epg") + (autoload 'epg-configuration "epg-config") + (autoload 'epg-expand-group "epg-config")) + +(eval-when-compile + (defvar password-cache-expiry) + (autoload 'password-read "password") + (autoload 'password-cache-add "password") + (autoload 'password-cache-remove "password")) + +(defvar mml1991-epg-secret-key-id-list nil) + +(defun mml1991-epg-passphrase-callback (context key-id ignore) + (if (eq key-id 'SYM) + (epg-passphrase-callback-function context key-id nil) + (let* ((entry (assoc key-id epg-user-id-alist)) + (passphrase + (password-read + (format "GnuPG passphrase for %s: " + (if entry + (cdr entry) + key-id)) + (if (eq key-id 'PIN) + "PIN" + key-id)))) + (when passphrase + (let ((password-cache-expiry mml1991-passphrase-cache-expiry)) + (password-cache-add key-id passphrase)) + (setq mml1991-epg-secret-key-id-list + (cons key-id mml1991-epg-secret-key-id-list)) + (copy-sequence passphrase))))) + +(defun mml1991-epg-sign (cont) + (let ((context (epg-make-context)) + headers cte signers signature) + (if mml1991-verbose + (setq signers (epa-select-keys context "Select keys for signing. +If no one is selected, default secret key is used. " + mml1991-signers t)) + (if mml1991-signers + (setq signers (mapcar (lambda (name) + (car (epg-list-keys context name t))) + mml1991-signers)))) + (epg-context-set-armor context t) + (epg-context-set-textmode context t) + (epg-context-set-signers context signers) + (if mml1991-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml1991-epg-passphrase-callback)) + ;; Don't sign headers. + (goto-char (point-min)) + (when (re-search-forward "^$" nil t) + (setq headers (buffer-substring (point-min) (point))) + (save-restriction + (narrow-to-region (point-min) (point)) + (setq cte (mail-fetch-field "content-transfer-encoding"))) + (forward-line 1) + (delete-region (point-min) (point)) + (when cte + (setq cte (intern (downcase cte))) + (mm-decode-content-transfer-encoding cte))) + (condition-case error + (setq signature (epg-sign-string context (buffer-string) 'clear) + mml1991-epg-secret-key-id-list nil) + (error + (while mml1991-epg-secret-key-id-list + (password-cache-remove (car mml1991-epg-secret-key-id-list)) + (setq mml1991-epg-secret-key-id-list + (cdr mml1991-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (delete-region (point-min) (point-max)) + (mm-with-unibyte-current-buffer + (insert signature) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (when cte + (mm-encode-content-transfer-encoding cte)) + (goto-char (point-min)) + (when headers + (insert headers)) + (insert "\n")) + t)) + +(defun mml1991-epg-encrypt (cont &optional sign) + (goto-char (point-min)) + (when (re-search-forward "^$" nil t) + (let ((cte (save-restriction + (narrow-to-region (point-min) (point)) + (mail-fetch-field "content-transfer-encoding")))) + ;; Strip MIME headers since it will be ASCII armoured. + (forward-line 1) + (delete-region (point-min) (point)) + (when cte + (mm-decode-content-transfer-encoding (intern (downcase cte)))))) + (let ((context (epg-make-context)) + (recipients + (if (message-options-get 'message-recipients) + (split-string + (message-options-get 'message-recipients) + "[ \f\t\n\r\v,]+"))) + cipher signers config) + ;; We should remove this check if epg-0.0.6 is released. + (if (and (condition-case nil + (require 'epg-config) + (error)) + (functionp #'epg-expand-group)) + (setq config (epg-configuration) + recipients + (apply #'nconc + (mapcar (lambda (recipient) + (or (epg-expand-group config recipient) + (list recipient))) + recipients)))) + (if mml1991-verbose + (setq recipients + (epa-select-keys context "Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients)) + (setq recipients + (delq nil (mapcar (lambda (name) + (car (epg-list-keys context name))) + recipients)))) + (if mml1991-encrypt-to-self + (if mml1991-signers + (setq recipients + (nconc recipients + (mapcar (lambda (name) + (car (epg-list-keys context name))) + mml1991-signers))) + (error "mml1991-signers not set"))) + (when sign + (if mml1991-verbose + (setq signers (epa-select-keys context "Select keys for signing. +If no one is selected, default secret key is used. " + mml1991-signers t)) + (if mml1991-signers + (setq signers (mapcar (lambda (name) + (car (epg-list-keys context name t))) + mml1991-signers)))) + (epg-context-set-signers context signers)) + (epg-context-set-armor context t) + (epg-context-set-textmode context t) + (if mml1991-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml1991-epg-passphrase-callback)) + (condition-case error + (setq cipher + (epg-encrypt-string context (buffer-string) recipients sign) + mml1991-epg-secret-key-id-list nil) + (error + (while mml1991-epg-secret-key-id-list + (password-cache-remove (car mml1991-epg-secret-key-id-list)) + (setq mml1991-epg-secret-key-id-list + (cdr mml1991-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (delete-region (point-min) (point-max)) + (insert "\n" cipher)) + t) + ;;;###autoload (defun mml1991-encrypt (cont &optional sign) (let ((func (nth 2 (assq mml1991-use mml1991-function-alist)))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/mml2015.el --- a/lisp/gnus/mml2015.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/mml2015.el Sun Oct 28 09:18:39 2007 +0000 @@ -34,13 +34,23 @@ (require 'mm-decode) (require 'mm-util) (require 'mml) +(require 'mml-sec) (defvar mc-pgp-always-sign) (defvar mml2015-use (or + (condition-case nil + (progn + (require 'epg-config) + (epg-check-configuration (epg-configuration)) + 'epg) + (error)) (progn (ignore-errors - (require 'pgg)) + ;; Avoid the "Recursive load suspected" error + ;; in Emacs 21.1. + (let ((recursive-load-depth-limit 100)) + (require 'pgg))) (and (fboundp 'pgg-sign-region) 'pgg)) (progn @@ -54,7 +64,8 @@ (fboundp 'mc-sign-generic) (fboundp 'mc-cleanup-recipient-headers) 'mailcrypt))) - "The package used for PGP/MIME.") + "The package used for PGP/MIME. +Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist @@ -75,7 +86,13 @@ mml2015-pgg-verify mml2015-pgg-decrypt mml2015-pgg-clear-verify - mml2015-pgg-clear-decrypt)) + mml2015-pgg-clear-decrypt) + (epg mml2015-epg-sign + mml2015-epg-encrypt + mml2015-epg-verify + mml2015-epg-decrypt + mml2015-epg-clear-verify + mml2015-epg-clear-decrypt)) "Alist of PGP/MIME functions.") (defvar mml2015-result-buffer nil) @@ -92,6 +109,60 @@ :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key")))) +(defcustom mml2015-verbose mml-secure-verbose + "If non-nil, ask the user about the current operation more verbosely." + :group 'mime-security + :type 'boolean) + +(defcustom mml2015-cache-passphrase mml-secure-cache-passphrase + "If t, cache passphrase." + :group 'mime-security + :type 'boolean) + +(defcustom mml2015-passphrase-cache-expiry mml-secure-passphrase-cache-expiry + "How many seconds the passphrase is cached. +Whether the passphrase is cached at all is controlled by +`mml2015-cache-passphrase'." + :group 'mime-security + :type 'integer) + +(defcustom mml2015-signers nil + "A list of your own key ID which will be used to sign a message." + :group 'mime-security + :type '(repeat (string :tag "Key ID"))) + +(defcustom mml2015-encrypt-to-self nil + "If t, add your own key ID to recipient list when encryption." + :group 'mime-security + :type 'boolean) + +(defcustom mml2015-always-trust t + "If t, GnuPG skip key validation on encryption." + :group 'mime-security + :type 'boolean) + +;; Extract plaintext from cleartext signature. IMO, this kind of task +;; should be done by GnuPG rather than Elisp, but older PGP backends +;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. +(defun mml2015-extract-cleartext-signature () + (goto-char (point-min)) + (forward-line) + ;; We need to be careful not to strip beyond the armor headers. + ;; Previously, an attacker could replace the text inside our + ;; markup with trailing garbage by injecting whitespace into the + ;; message. + (while (looking-at "Hash:") ; The only header allowed in cleartext + (forward-line)) ; signatures according to RFC2440. + (when (looking-at "[\t ]*$") + (forward-line)) + (delete-region (point-min) (point)) + (if (re-search-forward "^-----BEGIN PGP SIGNATURE-----" nil t) + (delete-region (match-beginning 0) (point-max))) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (replace-match "" t t) + (forward-line 1))) + ;;; mailcrypt wrapper (eval-and-compile @@ -278,7 +349,8 @@ (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) + mm-security-handle 'gnus-info "Failed"))) + (mml2015-extract-cleartext-signature)) (defun mml2015-mailcrypt-sign (cont) (mc-sign-generic (message-options-get 'message-sender) @@ -475,9 +547,8 @@ (with-temp-buffer (setq message (current-buffer)) (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. + ;; Convert to in signed text. If --textmode is + ;; specified when signing, the conversion is not necessary. (goto-char (point-min)) (end-of-line) (while (not (eobp)) @@ -545,7 +616,8 @@ (with-current-buffer mml2015-result-buffer (mml2015-gpg-extract-signature-details))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed"))) + mm-security-handle 'gnus-info "Failed")) + (mml2015-extract-cleartext-signature)) (defun mml2015-gpg-sign (cont) (let ((boundary (mml-compute-boundary cont)) @@ -734,9 +806,8 @@ handle) (with-temp-buffer (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. + ;; Convert to in signed text. If --textmode is + ;; specified when signing, the conversion is not necessary. (goto-char (point-min)) (end-of-line) (while (not (eobp)) @@ -809,7 +880,8 @@ (with-current-buffer pgg-errors-buffer (mml2015-gpg-extract-signature-details))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) + mm-security-handle 'gnus-info "Failed"))) + (mml2015-extract-cleartext-signature)) (defun mml2015-pgg-sign (cont) (let ((pgg-errors-buffer mml2015-result-buffer) @@ -871,6 +943,397 @@ (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) +;;; epg wrapper + +(eval-and-compile + (autoload 'epg-make-context "epg")) + +(eval-when-compile + (defvar epg-user-id-alist) + (defvar epg-digest-algorithm-alist) + (defvar inhibit-redisplay) + (autoload 'epg-context-set-armor "epg") + (autoload 'epg-context-set-textmode "epg") + (autoload 'epg-context-set-signers "epg") + (autoload 'epg-context-result-for "epg") + (autoload 'epg-new-signature-digest-algorithm "epg") + (autoload 'epg-verify-result-to-string "epg") + (autoload 'epg-list-keys "epg") + (autoload 'epg-decrypt-string "epg") + (autoload 'epg-verify-string "epg") + (autoload 'epg-sign-string "epg") + (autoload 'epg-encrypt-string "epg") + (autoload 'epg-passphrase-callback-function "epg") + (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-key-sub-key-list "epg") + (autoload 'epg-sub-key-capability "epg") + (autoload 'epg-sub-key-validity "epg") + (autoload 'epg-configuration "epg-config") + (autoload 'epg-expand-group "epg-config") + (autoload 'epa-select-keys "epa")) + +(eval-when-compile + (defvar password-cache-expiry) + (autoload 'password-read "password") + (autoload 'password-cache-add "password") + (autoload 'password-cache-remove "password")) + +(defvar mml2015-epg-secret-key-id-list nil) + +(defun mml2015-epg-passphrase-callback (context key-id ignore) + (if (eq key-id 'SYM) + (epg-passphrase-callback-function context key-id nil) + (let* (entry + (passphrase + (password-read + (if (eq key-id 'PIN) + "Passphrase for PIN: " + (if (setq entry (assoc key-id epg-user-id-alist)) + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))) + (if (eq key-id 'PIN) + "PIN" + key-id)))) + (when passphrase + (let ((password-cache-expiry mml2015-passphrase-cache-expiry)) + (password-cache-add key-id passphrase)) + (setq mml2015-epg-secret-key-id-list + (cons key-id mml2015-epg-secret-key-id-list)) + (copy-sequence passphrase))))) + +(defun mml2015-epg-find-usable-key (keys usage) + (catch 'found + (while keys + (let ((pointer (epg-key-sub-key-list (car keys)))) + (while pointer + (if (and (memq usage (epg-sub-key-capability (car pointer))) + (not (memq (epg-sub-key-validity (car pointer)) + '(revoked expired)))) + (throw 'found (car keys))) + (setq pointer (cdr pointer)))) + (setq keys (cdr keys))))) + +(defun mml2015-epg-decrypt (handle ctl) + (catch 'error + (let ((inhibit-redisplay t) + context plain child handles result decrypt-status) + (unless (setq child (mm-find-part-by-type + (cdr handle) + "application/octet-stream" nil t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (setq context (epg-make-context)) + (if mml2015-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml2015-epg-passphrase-callback)) + (condition-case error + (setq plain (epg-decrypt-string context (mm-get-part child)) + mml2015-epg-secret-key-id-list nil) + (error + (while mml2015-epg-secret-key-id-list + (password-cache-remove (car mml2015-epg-secret-key-id-list)) + (setq mml2015-epg-secret-key-id-list + (cdr mml2015-epg-secret-key-id-list))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (if (eq (car error) 'quit) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error error))) + (throw 'error handle))) + (with-temp-buffer + (insert plain) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) + (setq handles (mm-dissect-buffer t)) + (mm-destroy-parts handle) + (if (epg-context-result-for context 'verify) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (concat "OK\n" + (epg-verify-result-to-string + (epg-context-result-for context 'verify)))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK")) + (if (stringp (car handles)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (mm-handle-multipart-ctl-parameter handles 'gnus-details)))) + (if (listp (car handles)) + handles + (list handles))))) + +(defun mml2015-epg-clear-decrypt () + (let ((inhibit-redisplay t) + (context (epg-make-context)) + plain) + (if mml2015-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml2015-epg-passphrase-callback)) + (condition-case error + (setq plain (epg-decrypt-string context (buffer-string)) + mml2015-epg-secret-key-id-list nil) + (error + (while mml2015-epg-secret-key-id-list + (password-cache-remove (car mml2015-epg-secret-key-id-list)) + (setq mml2015-epg-secret-key-id-list + (cdr mml2015-epg-secret-key-id-list))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (if (eq (car error) 'quit) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error error))))) + (when plain + (erase-buffer) + ;; Treat data which epg returns as a unibyte string. + (mm-disable-multibyte) + (insert plain) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "OK") + (if (epg-context-result-for context 'verify) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (epg-verify-result-to-string + (epg-context-result-for context 'verify))))))) + +(defun mml2015-epg-verify (handle ctl) + (catch 'error + (let ((inhibit-redisplay t) + context plain signature-file part signature) + (when (or (null (setq part (mm-find-raw-part-by-type + ctl (or (mm-handle-multipart-ctl-parameter + ctl 'protocol) + "application/pgp-signature") + t))) + (null (setq signature (mm-find-part-by-type + (cdr handle) "application/pgp-signature" + nil t)))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Corrupted") + (throw 'error handle)) + (setq part (mm-replace-in-string part "\n" "\r\n" t) + signature (mm-get-part signature) + context (epg-make-context)) + (condition-case error + (setq plain (epg-verify-string context signature part)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (if (eq (car error) 'quit) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error error))) + (throw 'error handle))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (epg-verify-result-to-string (epg-context-result-for context 'verify))) + handle))) + +(defun mml2015-epg-clear-verify () + (let ((inhibit-redisplay t) + (context (epg-make-context)) + (signature (mm-encode-coding-string (buffer-string) + coding-system-for-write)) + plain) + (condition-case error + (setq plain (epg-verify-string context signature)) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info "Failed") + (if (eq (car error) 'quit) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (mml2015-format-error error))))) + (if plain + (progn + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (epg-verify-result-to-string + (epg-context-result-for context 'verify))) + (delete-region (point-min) (point-max)) + (insert (mm-decode-coding-string plain coding-system-for-read))) + (mml2015-extract-cleartext-signature)))) + +(defun mml2015-epg-sign (cont) + (let* ((inhibit-redisplay t) + (context (epg-make-context)) + (boundary (mml-compute-boundary cont)) + signer-key + (signers + (or (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (if mml2015-verbose + (epa-select-keys context "\ +Select keys for signing. +If no one is selected, default secret key is used. " + mml2015-signers t) + (if mml2015-signers + (mapcar + (lambda (signer) + (setq signer-key (mml2015-epg-find-usable-key + (epg-list-keys context signer t) + 'sign)) + (unless (or signer-key + (y-or-n-p + (format "No secret key for %s; skip it? " + signer))) + (error "No secret key for %s" signer)) + signer-key) + mml2015-signers)))))) + signature micalg) + (epg-context-set-armor context t) + (epg-context-set-textmode context t) + (epg-context-set-signers context signers) + (if mml2015-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml2015-epg-passphrase-callback)) + (condition-case error + (setq signature (epg-sign-string context (buffer-string) t) + mml2015-epg-secret-key-id-list nil) + (error + (while mml2015-epg-secret-key-id-list + (password-cache-remove (car mml2015-epg-secret-key-id-list)) + (setq mml2015-epg-secret-key-id-list + (cdr mml2015-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (if (epg-context-result-for context 'sign) + (setq micalg (epg-new-signature-digest-algorithm + (car (epg-context-result-for context 'sign))))) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" + boundary)) + (if micalg + (insert (format "\tmicalg=pgp-%s; " + (downcase + (cdr (assq micalg + epg-digest-algorithm-alist)))))) + (insert "protocol=\"application/pgp-signature\"\n") + (insert (format "\n--%s\n" boundary)) + (goto-char (point-max)) + (insert (format "\n--%s\n" boundary)) + (insert "Content-Type: application/pgp-signature\n\n") + (insert signature) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + +(defun mml2015-epg-encrypt (cont &optional sign) + (let ((inhibit-redisplay t) + (context (epg-make-context)) + (config (epg-configuration)) + (recipients (message-options-get 'mml2015-epg-recipients)) + cipher signers + (boundary (mml-compute-boundary cont)) + recipient-key signer-key) + (unless recipients + (setq recipients + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list (concat "<" recipient ">")))) + (split-string + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+")))) + (when mml2015-encrypt-to-self + (unless mml2015-signers + (error "mml2015-signers not set")) + (setq recipients (nconc recipients mml2015-signers))) + (if mml2015-verbose + (setq recipients + (epa-select-keys context "\ +Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients)) + (setq recipients + (mapcar + (lambda (recipient) + (setq recipient-key (mml2015-epg-find-usable-key + (epg-list-keys context recipient) + 'encrypt)) + (unless (or recipient-key + (y-or-n-p + (format "No public key for %s; skip it? " + recipient))) + (error "No public key for %s" recipient)) + recipient-key) + recipients)) + (unless recipients + (error "No recipient specified"))) + (message-options-set 'mml2015-epg-recipients recipients)) + (when sign + (setq signers + (or (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (if mml2015-verbose + (epa-select-keys context "\ +Select keys for signing. +If no one is selected, default secret key is used. " + mml2015-signers t) + (if mml2015-signers + (mapcar + (lambda (signer) + (setq signer-key (mml2015-epg-find-usable-key + (epg-list-keys context signer t) + 'sign)) + (unless (or signer-key + (y-or-n-p + (format + "No secret key for %s; skip it? " + signer))) + (error "No secret key for %s" signer)) + signer-key) + mml2015-signers)))))) + (epg-context-set-signers context signers)) + (epg-context-set-armor context t) + (epg-context-set-textmode context t) + (if mml2015-cache-passphrase + (epg-context-set-passphrase-callback + context + #'mml2015-epg-passphrase-callback)) + (condition-case error + (setq cipher + (epg-encrypt-string context (buffer-string) recipients sign + mml2015-always-trust) + mml2015-epg-secret-key-id-list nil) + (error + (while mml2015-epg-secret-key-id-list + (password-cache-remove (car mml2015-epg-secret-key-id-list)) + (setq mml2015-epg-secret-key-id-list + (cdr mml2015-epg-secret-key-id-list))) + (signal (car error) (cdr error)))) + (delete-region (point-min) (point-max)) + (goto-char (point-min)) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (insert cipher) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))) + ;;; General wrapper (defun mml2015-clean-buffer () @@ -879,7 +1342,7 @@ (erase-buffer) t) (setq mml2015-result-buffer - (gnus-get-buffer-create "*MML2015 Result*")) + (gnus-get-buffer-create " *MML2015 Result*")) nil)) (defsubst mml2015-clear-decrypt-function () diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnagent.el --- a/lisp/gnus/nnagent.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnagent.el Sun Oct 28 09:18:39 2007 +0000 @@ -121,7 +121,7 @@ (gnus-request-accept-article "nndraft:queue" nil t t)) (deffoo nnagent-request-set-mark (group action server) - (with-temp-buffer + (mm-with-unibyte-buffer (insert "(gnus-agent-synchronize-group-flags \"" group "\" '") @@ -130,7 +130,17 @@ (gnus-method-to-server gnus-command-method) "\"") (insert ")\n") - (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags"))) + (let ((coding-system-for-write nnheader-file-coding-system)) + (write-region (point-min) (point-max) (gnus-agent-lib-file "flags") + t 'silent))) + ;; Also set the marks for the original back end that keeps marks in + ;; the local system. + (let ((gnus-agent nil)) + (when (and (memq (car gnus-command-method) '(nntp)) + (gnus-check-backend-function 'request-set-mark + (car gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-set-mark) + group action server))) nil) (deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) @@ -148,7 +158,8 @@ (pop arts))) (set-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-nov-file file (car articles)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (nnheader-insert-nov-file file (car articles))) (goto-char (point-min)) (gnus-parse-without-error (while (and arts (not (eobp))) @@ -214,10 +225,10 @@ (list (nnagent-server server)))) (deffoo nnagent-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (nnoo-parent-function 'nnagent 'nnml-request-move-article (list article group (nnagent-server server) - accept-form last))) + accept-form last move-is-internal))) (deffoo nnagent-request-rename-group (group new-name &optional server) (nnoo-parent-function 'nnagent 'nnml-request-rename-group diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnbabyl.el --- a/lisp/gnus/nnbabyl.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnbabyl.el Sun Oct 28 09:18:39 2007 +0000 @@ -70,9 +70,6 @@ (defvoo nnbabyl-previous-buffer-mode nil) -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - ;;; Interface functions @@ -271,7 +268,7 @@ (save-excursion (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) (when (search-forward (nnbabyl-article-string (car articles)) nil t) @@ -308,7 +305,7 @@ (nconc rest articles)))) (deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnbabyl move*")) result) (and diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nndb.el --- a/lisp/gnus/nndb.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nndb.el Sun Oct 28 09:18:39 2007 +0000 @@ -241,7 +241,7 @@ (nndb-request-expire-articles-local articles group server force))) (deffoo nndb-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) "Move ARTICLE (a number) from GROUP on SERVER. Evals ACCEPT-FORM in current buffer, where the article is. Optional LAST is ignored." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nndiary.el --- a/lisp/gnus/nndiary.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nndiary.el Sun Oct 28 09:18:39 2007 +0000 @@ -606,7 +606,7 @@ (nconc rest articles))) (deffoo nndiary-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nndiary move*")) result) (nndiary-possibly-change-directory group server) @@ -875,7 +875,7 @@ (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (gnus-point-at-bol) t)))) + (not (search-backward"\t" (point-at-bol) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -1096,9 +1096,7 @@ (push (list group (cons (or (caar files) (1+ last)) (max last - (or (let ((f files)) - (while (cdr f) (setq f (cdr f))) - (caar f)) + (or (caar (last files)) 0)))) nndiary-group-alist))) @@ -1577,13 +1575,11 @@ ;; The end... =============================================================== -(mapcar - (lambda (elt) - (let ((header (intern (format "X-Diary-%s" (car elt))))) - ;; Required for building NOV databases and some other stuff - (add-to-list 'gnus-extra-headers header) - (add-to-list 'nnmail-extra-headers header))) - nndiary-headers) +(dolist (header nndiary-headers) + (setq header (intern (format "X-Diary-%s" (car header)))) + ;; Required for building NOV databases and some other stuff. + (add-to-list 'gnus-extra-headers header) + (add-to-list 'nnmail-extra-headers header)) (unless (assoc "nndiary" gnus-valid-select-methods) (gnus-declare-backend "nndiary" 'post-mail 'respool 'address)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nndoc.el --- a/lisp/gnus/nndoc.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nndoc.el Sun Oct 28 09:18:39 2007 +0000 @@ -122,7 +122,7 @@ (subtype digest guess)) (lanl-gov-announce (article-begin . "^\\\\\\\\\n") - (head-begin . "^Paper.*:") + (head-begin . "^\\(Paper.*:\\|arXiv:\\)") (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") (body-begin . "") (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)") @@ -624,25 +624,28 @@ (defun nndoc-lanl-gov-announce-type-p () (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t)) + (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+\\|arXiv:\\)" nil t)) t)) (defun nndoc-transform-lanl-gov-announce (article) - (goto-char (point-max)) - (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil)) - (goto-char (point-min)) - (while (re-search-forward "^\\\\\\\\$" nil t) - (replace-match "" t nil)) - (goto-char (point-min)) - (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t) - (replace-match "Date: \\1 (revised) " t nil)) - (goto-char (point-min)) - (unless (re-search-forward "^From" nil t) + (let ((case-fold-search nil)) + (goto-char (point-max)) + (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) + (replace-match "\n\nGet it at \\1 (\\2)" t nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\\\\\\\$" nil t) + (replace-match "" t nil)) (goto-char (point-min)) - (when (re-search-forward "^Authors?: \\(.*\\)" nil t) + (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t) + (replace-match "Date: \\1 (revised) " t nil)) + (goto-char (point-min)) + (unless (re-search-forward "^From" nil t) (goto-char (point-min)) - (insert "From: " (match-string 1) "\n")))) + (when (re-search-forward "^Authors?: \\(.*\\)" nil t) + (goto-char (point-min)) + (insert "From: " (match-string 1) "\n"))) + (when (re-search-forward "^arXiv:" nil t) + (replace-match "Paper: arXiv:" t nil)))) (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) @@ -653,8 +656,8 @@ (save-restriction (narrow-to-region (car entry) (nth 1 entry)) (goto-char (point-min)) - (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)") - (setq subject (concat " (" (match-string 1) ")")) + (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z-\\./]+\\)") + (setq subject (concat " (" (match-string 2) ")")) (when (re-search-forward "^From: \\(.*\\)" nil t) (setq from (concat "<" (cadr (funcall gnus-extract-address-components diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nndraft.el --- a/lisp/gnus/nndraft.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nndraft.el Sun Oct 28 09:18:39 2007 +0000 @@ -42,6 +42,11 @@ "Where nndraft will store its files." nnmh-directory) +(defvar nndraft-required-headers '(Date) + "*Headers to be generated when saving a draft message. +The headers in this variable and the ones in `message-required-headers' +are generated if and only if they are also in `message-draft-headers'.") + (defvoo nndraft-current-group "" nil nnmh-current-group) @@ -156,7 +161,7 @@ (save-excursion (message-generate-headers (message-headers-to-generate - message-required-headers message-draft-headers nil)))) + nndraft-required-headers message-draft-headers nil)))) (deffoo nndraft-request-associate-buffer (group) "Associate the current buffer with some article in the draft group." @@ -199,8 +204,8 @@ 'nnmh-request-group (list group server dont-check))) -(deffoo nndraft-request-move-article (article group server - accept-form &optional last) +(deffoo nndraft-request-move-article (article group server accept-form + &optional last move-is-internal) (nndraft-possibly-change-group group) (let ((buf (get-buffer-create " *nndraft move*")) result) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nneething.el --- a/lisp/gnus/nneething.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nneething.el Sun Oct 28 09:18:39 2007 +0000 @@ -423,7 +423,7 @@ (if (numberp article) (if (setq fname (cadr (assq article nneething-map))) (expand-file-name fname dir) - (mm-make-temp-file (expand-file-name "nneething" dir))) + (make-temp-name (expand-file-name "nneething" dir))) (expand-file-name article dir)))) (provide 'nneething) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnfolder.el --- a/lisp/gnus/nnfolder.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnfolder.el Sun Oct 28 09:18:39 2007 +0000 @@ -203,7 +203,7 @@ (goto-char (match-end 0)) (setq num (string-to-number (buffer-substring - (point) (gnus-point-at-eol)))) + (point) (point-at-eol)))) (goto-char start) (< num article))) ;; Check that we are before an article with a @@ -213,7 +213,7 @@ (progn (setq num (string-to-number (buffer-substring - (point) (gnus-point-at-eol)))) + (point) (point-at-eol)))) (> num article)) ;; Discard any article numbers before the one we're ;; now looking at. @@ -287,31 +287,36 @@ (if (search-forward (concat "\n" nnfolder-article-marker) nil t) (string-to-number (buffer-substring - (point) (gnus-point-at-eol))) + (point) (point-at-eol))) -1)))))))) (deffoo nnfolder-request-group (group &optional server dont-check) (nnfolder-possibly-change-group group server t) (save-excursion - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) + (cond ((not (assoc group nnfolder-group-alist)) + (nnheader-report 'nnfolder "No such group: %s" group)) + ((file-directory-p (nnfolder-group-pathname group)) + (nnheader-report 'nnfolder "%s is a directory" + (file-name-as-directory + (let ((nnmail-pathname-coding-system nil)) + (nnfolder-group-pathname group))))) + (dont-check + (nnheader-report 'nnfolder "Selected group %s" group) + t) + (t + (let* ((active (assoc group nnfolder-group-alist)) + (group (car active)) + (range (cadr active))) + (cond + ((null active) + (nnheader-report 'nnfolder "No such group: %s" group)) + ((null nnfolder-current-group) + (nnheader-report 'nnfolder "Empty group: %s" group)) + (t + (nnheader-report 'nnfolder "Selected group %s" group) + (nnheader-insert "211 %d %d %d %s\n" + (1+ (- (cdr range) (car range))) + (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group nil server) @@ -371,13 +376,21 @@ (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) - (when (and group - (not (assoc group nnfolder-group-alist))) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (save-current-buffer - (nnfolder-read-folder group))) - t) + (cond ((zerop (length group)) + (nnheader-report 'nnfolder "Invalid (empty) group name")) + ((file-directory-p (nnfolder-group-pathname group)) + (nnheader-report 'nnfolder "%s is a directory" + (file-name-as-directory + (let ((nnmail-pathname-coding-system nil)) + (nnfolder-group-pathname group))))) + ((assoc group nnfolder-group-alist) + t) + (t + (push (list group (cons 1 0)) nnfolder-group-alist) + (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) + (save-current-buffer + (nnfolder-read-folder group)) + t))) (deffoo nnfolder-request-list (&optional server) (nnfolder-possibly-change-group nil server) @@ -416,16 +429,17 @@ ;; The article numbers are increasing, so this result is sorted. (nreverse numbers))))) -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) +(deffoo nnfolder-request-expire-articles (articles newsgroup + &optional server force) (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - ;; The articles we have deleted so far. - (deleted-articles nil) - ;; The articles that really exist and will - ;; be expired if they are old enough. - (maybe-expirable - (gnus-sorted-intersection articles (nnfolder-existing-articles)))) + (let ((is-old t) + ;; The articles we have deleted so far. + (deleted-articles nil) + ;; The articles that really exist and will + ;; be expired if they are old enough. + (maybe-expirable + (gnus-sorted-intersection articles (nnfolder-existing-articles))) + target) (nnmail-activate 'nnfolder) (save-excursion @@ -445,21 +459,28 @@ (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) - (unless (eq nnmail-expiry-target 'delete) + (setq target nnmail-expiry-target) + (unless (eq target 'delete) (with-temp-buffer (nnfolder-request-article (car maybe-expirable) newsgroup server (current-buffer)) (let ((nnfolder-current-directory nil)) - (nnmail-expiry-target-group - nnmail-expiry-target newsgroup))) + (when (functionp target) + (setq target (funcall target newsgroup))) + (if (and target + (or (gnus-request-group target) + (gnus-request-create-group target))) + (nnmail-expiry-target-group target newsgroup) + (setq target nil)))) (nnfolder-possibly-change-group newsgroup server)) - (nnheader-message 5 "Deleting article %d in %s..." - (car maybe-expirable) newsgroup) - (nnfolder-delete-mail) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) - ;; Must remember which articles were actually deleted - (push (car maybe-expirable) deleted-articles))) + (when target + (nnheader-message 5 "Deleting article %d in %s..." + (car maybe-expirable) newsgroup) + (nnfolder-delete-mail) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-nov-delete-article newsgroup (car maybe-expirable))) + ;; Must remember which articles were actually deleted + (push (car maybe-expirable) deleted-articles)))) (setq maybe-expirable (cdr maybe-expirable))) (unless nnfolder-inhibit-expiry (nnheader-message 5 "Deleting articles...done")) @@ -468,8 +489,8 @@ (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) (gnus-sorted-difference articles (nreverse deleted-articles))))) -(deffoo nnfolder-request-move-article (article group server - accept-form &optional last) +(deffoo nnfolder-request-move-article (article group server accept-form + &optional last move-is-internal) (save-excursion (let ((buf (get-buffer-create " *nnfolder move*")) result) @@ -1029,9 +1050,7 @@ (when (not (message-mail-file-mbox-p file)) (ignore-errors (delete-file file))))) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) + (dolist (file (directory-files nnfolder-directory)) (when (and (not (backup-file-name-p file)) (message-mail-file-mbox-p (nnheader-concat nnfolder-directory file))) @@ -1046,7 +1065,7 @@ (nnfolder-possibly-change-folder file) (nnfolder-possibly-change-group file) (nnfolder-close-group file)))) - (nnheader-message 5 ""))) + (nnheader-message 5 "")) (defun nnfolder-group-pathname (group) "Make file name for GROUP." @@ -1073,7 +1092,8 @@ (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))) + nnfolder-file-coding-system)) + (copyright-update nil)) (save-buffer))) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) (nnfolder-save-nov))) @@ -1197,16 +1217,16 @@ (nnheader-message 8 "Updating marks for %s..." group) (nnfolder-open-marks group server) ;; Update info using `nnfolder-marks'. - (mapcar (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) + (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)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnheader.el --- a/lisp/gnus/nnheader.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnheader.el Sun Oct 28 09:18:39 2007 +0000 @@ -115,7 +115,6 @@ (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") (autoload 'message-remove-header "message") - (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. @@ -209,9 +208,9 @@ "Return the extra headers in HEADER." `(aref ,header 9)) -(defmacro mail-header-set-extra (header extra) +(defun mail-header-set-extra (header extra) "Set the extra headers in HEADER to EXTRA." - `(aset ,header 9 ',extra)) + (aset header 9 extra)) (defsubst make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." @@ -227,12 +226,16 @@ (defvar nnheader-fake-message-id 1) -(defsubst nnheader-generate-fake-message-id () - (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) +(defsubst nnheader-generate-fake-message-id (&optional number) + (if (numberp number) + (format "fake+none+%s+%d" gnus-newsgroup-name number) + (format "fake+none+%s+%s" + gnus-newsgroup-name + (int-to-string (incf nnheader-fake-message-id))))) (defsubst nnheader-fake-message-id-p (id) (save-match-data ; regular message-id's are <.*> - (string-match "\\`fake\\+none\\+[0-9]+\\'" id))) + (string-match "\\`fake\\+none\\+.*\\+[0-9]+\\'" id))) ;; Parsing headers and NOV lines. @@ -243,7 +246,7 @@ (defsubst nnheader-header-value () (skip-chars-forward " \t") - (buffer-substring (point) (gnus-point-at-eol))) + (buffer-substring (point) (point-at-eol))) (defun nnheader-parse-naked-head (&optional number) ;; This function unfolds continuation lines in this buffer @@ -289,12 +292,12 @@ (goto-char p) (if (search-forward "\nmessage-id:" nil t) (buffer-substring - (1- (or (search-forward "<" (gnus-point-at-eol) t) + (1- (or (search-forward "<" (point-at-eol) t) (point))) - (or (search-forward ">" (gnus-point-at-eol) t) (point))) + (or (search-forward ">" (point-at-eol) t) (point))) ;; If there was no message-id, we just fake one to make ;; subsequent routines simpler. - (nnheader-generate-fake-message-id))) + (nnheader-generate-fake-message-id number))) ;; References. (progn (goto-char p) @@ -392,20 +395,29 @@ out))) out)) -(defmacro nnheader-nov-read-message-id () - '(let ((id (nnheader-nov-field))) +(eval-and-compile + (defvar nnheader-uniquify-message-id nil)) + +(defmacro nnheader-nov-read-message-id (&optional number) + `(let ((id (nnheader-nov-field))) (if (string-match "^<[^>]+>$" id) - id - (nnheader-generate-fake-message-id)))) + ,(if nnheader-uniquify-message-id + `(if (string-match "__[^@]+@" id) + (concat (substring id 0 (match-beginning 0)) + (substring id (1- (match-end 0)))) + id) + 'id) + (nnheader-generate-fake-message-id ,number)))) (defun nnheader-parse-nov () - (let ((eol (gnus-point-at-eol))) + (let ((eol (point-at-eol)) + (number (nnheader-nov-read-integer))) (vector - (nnheader-nov-read-integer) ; number + number ; number (nnheader-nov-field) ; subject (nnheader-nov-field) ; from (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id + (nnheader-nov-read-message-id number) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines @@ -628,7 +640,7 @@ ;; This is invalid, but not all articles have Message-IDs. () (mail-position-on-field "References") - (let ((begin (gnus-point-at-bol)) + (let ((begin (point-at-bol)) (fill-column 78) (fill-prefix "\t")) (when references @@ -662,6 +674,14 @@ (point-max))) (goto-char (point-min))) +(defun nnheader-get-lines-and-char () + "Return the number of lines and chars in the article body." + (goto-char (point-min)) + (if (not (re-search-forward "\n\r?\n" nil t)) + (list 0 0) + (list (count-lines (point) (point-max)) + (- (point-max) (point))))) + (defun nnheader-remove-body () "Remove the body from an article in this current buffer." (goto-char (point-min)) @@ -701,8 +721,7 @@ (defvar nnheader-directory-files-is-safe (or (eq system-type 'windows-nt) - (and (not (featurep 'xemacs)) - (> emacs-major-version 20))) + (not (featurep 'xemacs))) "If non-nil, Gnus believes `directory-files' is safe. It has been reported numerous times that `directory-files' fails with an alarming frequency on NFS mounted file systems. If it is nil, @@ -848,7 +867,9 @@ "Message if the Gnus backends are talkative." (if (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends)) - (apply 'message args) + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)) (apply 'format args))) (defun nnheader-be-verbose (level) @@ -972,6 +993,7 @@ (after-insert-file-functions nil) (enable-local-eval nil) (coding-system-for-read nnheader-file-coding-system) + (version-control 'never) (ffh (if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)) @@ -1033,7 +1055,6 @@ "Strip all \r's from the current buffer." (nnheader-skeleton-replace "\r")) -(defalias 'nnheader-run-at-time 'run-at-time) (defalias 'nnheader-cancel-timer 'cancel-timer) (defalias 'nnheader-cancel-function-timers 'cancel-function-timers) (defalias 'nnheader-string-as-multibyte 'string-as-multibyte) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnimap.el --- a/lisp/gnus/nnimap.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnimap.el Sun Oct 28 09:18:39 2007 +0000 @@ -250,10 +250,15 @@ :type 'boolean :group 'nnimap) -(defvoo nnimap-need-unselect-to-notice-new-mail nil +(defvoo nnimap-need-unselect-to-notice-new-mail t "Unselect mailboxes before looking for new mail in them. Some servers seem to need this under some circumstances.") +(defvoo nnimap-logout-timeout nil + "Close server immediately if it can't logout in this number of seconds. +If it is nil, never close server until logout completes. This variable +overrides `imap-logout-timeout' on a per-server basis.") + ;; Authorization / Privacy variables (defvoo nnimap-auth-method nil @@ -417,6 +422,43 @@ If this is 'imap-mailbox-lsub, then use a server-side subscription list to restrict visible folders.") +(defcustom nnimap-id nil + "Plist with client identity to send to server upon login. +Nil means no information is sent, symbol `no' to disable ID query +alltogheter, or plist with identifier-value pairs to send to +server. RFC 2971 describes the list as follows: + + Any string may be sent as a field, but the following are defined to + describe certain values that might be sent. Implementations are free + to send none, any, or all of these. Strings are not case-sensitive. + Field strings MUST NOT be longer than 30 octets. Value strings MUST + NOT be longer than 1024 octets. Implementations MUST NOT send more + than 30 field-value pairs. + + name Name of the program + version Version number of the program + os Name of the operating system + os-version Version of the operating system + vendor Vendor of the client/server + support-url URL to contact for support + address Postal address of contact/vendor + date Date program was released, specified as a date-time + in IMAP4rev1 + command Command used to start the program + arguments Arguments supplied on the command line, if any + if any + environment Description of environment, i.e., UNIX environment + variables or Windows registry settings + + Implementations MUST NOT send the same field name more than once. + +An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number +\"os\" system-configuration \"vendor\" \"GNU\")." + :group 'nnimap + :type '(choice (const :tag "No information" nil) + (const :tag "Disable ID query" no) + (plist :key-type string :value-type string))) + (defcustom nnimap-debug nil "If non-nil, random debug spews are placed in *nnimap-debug* buffer. Note that username, passwords and other privacy sensitive @@ -451,6 +493,14 @@ "Return buffer for SERVER, if nil use current server." (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist))) +(defun nnimap-remove-server-from-buffer-alist (server list) + "Remove SERVER from LIST." + (let (l) + (dolist (e list) + (unless (equal server (car-safe e)) + (push e l))) + l)) + (defun nnimap-possibly-change-server (server) "Return buffer for SERVER, changing the current server as a side-effect. If SERVER is nil, uses the current server." @@ -569,7 +619,7 @@ (with-temp-buffer (buffer-disable-undo) (insert headers) - (let ((head (nnheader-parse-naked-head))) + (let ((head (nnheader-parse-naked-head uid))) (mail-header-set-number head uid) (mail-header-set-chars head chars) (mail-header-set-lines head lines) @@ -730,6 +780,8 @@ 'nov))) (defun nnimap-open-connection (server) + ;; Note: `nnimap-open-server' that calls this function binds + ;; `imap-logout-timeout' to `nnimap-logout-timeout'. (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream nnimap-authenticator nnimap-server-buffer)) (nnheader-report 'nnimap "Can't open connection to server %s" server) @@ -739,26 +791,35 @@ (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server)) (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'." nnimap-authinfo-file) - (gnus-parse-netrc nnimap-authinfo-file))) - (port (if nnimap-server-port - (int-to-string nnimap-server-port) - "imap")) - (alist (or (gnus-netrc-machine list server port "imap") - (gnus-netrc-machine list server port "imaps") - (gnus-netrc-machine list - (or nnimap-server-address - nnimap-address) - port "imap") - (gnus-netrc-machine list - (or nnimap-server-address - nnimap-address) - port "imaps"))) - (user (gnus-netrc-get alist "login")) - (passwd (gnus-netrc-get alist "password"))) + (netrc-parse nnimap-authinfo-file))) + (port (if nnimap-server-port + (int-to-string nnimap-server-port) + "imap")) + (user (netrc-machine-user-or-password + "login" + list + (list server + (or nnimap-server-address + nnimap-address)) + (list port) + (list "imap" "imaps"))) + (passwd (netrc-machine-user-or-password + "password" + list + (list server + (or nnimap-server-address + nnimap-address)) + (list port) + (list "imap" "imaps")))) (if (imap-authenticate user passwd nnimap-server-buffer) - (prog1 + (prog2 + (setq nnimap-server-buffer-alist + (nnimap-remove-server-from-buffer-alist + server + nnimap-server-buffer-alist)) (push (list server nnimap-server-buffer) nnimap-server-buffer-alist) + (imap-id nnimap-id nnimap-server-buffer) (nnimap-possibly-change-server server)) (imap-close nnimap-server-buffer) (kill-buffer nnimap-server-buffer) @@ -782,14 +843,15 @@ (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs)))) (with-current-buffer (get-buffer-create nnimap-server-buffer) (nnoo-change-server 'nnimap server defs)) - (or (and nnimap-server-buffer - (imap-opened nnimap-server-buffer) - (if (with-current-buffer nnimap-server-buffer - (memq imap-state '(auth select examine))) - t - (imap-close nnimap-server-buffer) - (nnimap-open-connection server))) - (nnimap-open-connection server)))) + (let ((imap-logout-timeout nnimap-logout-timeout)) + (or (and nnimap-server-buffer + (imap-opened nnimap-server-buffer) + (if (with-current-buffer nnimap-server-buffer + (memq imap-state '(auth selected examine))) + t + (imap-close nnimap-server-buffer) + (nnimap-open-connection server))) + (nnimap-open-connection server))))) (deffoo nnimap-server-opened (&optional server) "Whether SERVER is opened. @@ -804,7 +866,8 @@ (deffoo nnimap-close-server (&optional server) "Close connection to server and free all resources connected to it. Return nil if the server couldn't be closed for some reason." - (let ((server (or server nnimap-current-server))) + (let ((server (or server nnimap-current-server)) + (imap-logout-timeout nnimap-logout-timeout)) (when (or (nnimap-server-opened server) (imap-opened (nnimap-get-server-buffer server))) (imap-close (nnimap-get-server-buffer server)) @@ -812,7 +875,9 @@ (setq nnimap-server-buffer nil nnimap-current-server nil nnimap-server-buffer-alist - (delq server nnimap-server-buffer-alist))) + (nnimap-remove-server-from-buffer-alist + server + nnimap-server-buffer-alist))) (nnoo-close-server 'nnimap server))) (deffoo nnimap-request-close () @@ -820,8 +885,8 @@ All buffers that have been created by that backend should be killed. (Not the nntp-server-buffer, though.) This function is generally only called when Gnus is shutting down." - (mapcar (lambda (server) (nnimap-close-server (car server))) - nnimap-server-buffer-alist) + (mapc (lambda (server) (nnimap-close-server (car server))) + nnimap-server-buffer-alist) (setq nnimap-server-buffer-alist nil)) (deffoo nnimap-status-message (&optional server) @@ -1142,20 +1207,19 @@ seen)) (gnus-info-set-read info seen))) - (mapcar (lambda (pred) - (when (or (eq (cdr pred) 'recent) - (and (nnimap-mark-permanent-p (cdr pred)) - (member (nnimap-mark-to-flag (cdr pred)) - (imap-mailbox-get 'flags)))) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (gnus-compress-sequence - (imap-search (nnimap-mark-to-predicate (cdr pred)))) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) + (dolist (pred gnus-article-mark-lists) + (when (or (eq (cdr pred) 'recent) + (and (nnimap-mark-permanent-p (cdr pred)) + (member (nnimap-mark-to-flag (cdr pred)) + (imap-mailbox-get 'flags)))) + (gnus-info-set-marks + info + (gnus-update-alist-soft + (cdr pred) + (gnus-compress-sequence + (imap-search (nnimap-mark-to-predicate (cdr pred)))) + (gnus-info-marks info)) + t))) (when nnimap-importantize-dormant ;; nnimap mark dormant article as ticked too (for other clients) @@ -1207,11 +1271,11 @@ (if (memq 'dormant cmdmarks) (setq cmdmarks (cons 'tick cmdmarks)))) ;; remove stuff we are forbidden to store - (mapcar (lambda (mark) - (if (imap-message-flag-permanent-p - (nnimap-mark-to-flag mark)) - (setq marks (cons mark marks)))) - cmdmarks) + (mapc (lambda (mark) + (if (imap-message-flag-permanent-p + (nnimap-mark-to-flag mark)) + (setq marks (cons mark marks)))) + cmdmarks) (when (and range marks) (cond ((eq what 'del) (imap-message-flags-del @@ -1472,8 +1536,8 @@ ;; return articles not deleted articles) -(deffoo nnimap-request-move-article (article group server - accept-form &optional last) +(deffoo nnimap-request-move-article (article group server accept-form + &optional last move-is-internal) (when (nnimap-possibly-change-server server) (save-excursion (let ((buf (get-buffer-create " *nnimap move*")) @@ -1481,7 +1545,13 @@ (nnimap-current-move-group group) (nnimap-current-move-server nnimap-current-server) result) - (and (nnimap-request-article article group server) + (gnus-message 10 "nnimap-request-move-article: this is an %s move" + (if move-is-internal + "internal" + "external")) + ;; request the article only when the move is NOT internal + (and (or move-is-internal + (nnimap-request-article article group server)) (save-excursion (set-buffer buf) (buffer-disable-undo (current-buffer)) @@ -1558,21 +1628,21 @@ (error "Your server does not support ACL editing")) (with-current-buffer nnimap-server-buffer ;; delete all removed identifiers - (mapcar (lambda (old-acl) - (unless (assoc (car old-acl) new-acls) - (or (imap-mailbox-acl-delete (car old-acl) mailbox) - (error "Can't delete ACL for %s" (car old-acl))))) - old-acls) + (mapc (lambda (old-acl) + (unless (assoc (car old-acl) new-acls) + (or (imap-mailbox-acl-delete (car old-acl) mailbox) + (error "Can't delete ACL for %s" (car old-acl))))) + old-acls) ;; set all changed acl's - (mapcar (lambda (new-acl) - (let ((new-rights (cdr new-acl)) - (old-rights (cdr (assoc (car new-acl) old-acls)))) - (unless (and old-rights new-rights - (string= old-rights new-rights)) - (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) - (error "Can't set ACL for %s to %s" (car new-acl) - new-rights))))) - new-acls) + (mapc (lambda (new-acl) + (let ((new-rights (cdr new-acl)) + (old-rights (cdr (assoc (car new-acl) old-acls)))) + (unless (and old-rights new-rights + (string= old-rights new-rights)) + (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox) + (error "Can't set ACL for %s to %s" (car new-acl) + new-rights))))) + new-acls) t))) @@ -1651,64 +1721,64 @@ (when nnimap-debug (require 'trace) (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) - (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer)) - '( - nnimap-possibly-change-server - nnimap-verify-uidvalidity - nnimap-find-minmax-uid - nnimap-before-find-minmax-bugworkaround - nnimap-possibly-change-group - ;;nnimap-replace-whitespace - nnimap-retrieve-headers-progress - nnimap-retrieve-which-headers - nnimap-group-overview-filename - nnimap-retrieve-headers-from-file - nnimap-retrieve-headers-from-server - nnimap-retrieve-headers - nnimap-open-connection - nnimap-open-server - nnimap-server-opened - nnimap-close-server - nnimap-request-close - nnimap-status-message - ;;nnimap-demule - nnimap-request-article-part - nnimap-request-article - nnimap-request-head - nnimap-request-body - nnimap-request-group - nnimap-close-group - nnimap-pattern-to-list-arguments - nnimap-request-list - nnimap-request-post - nnimap-retrieve-groups - nnimap-request-update-info-internal - nnimap-request-type - nnimap-request-set-mark - nnimap-split-to-groups - nnimap-split-find-rule - nnimap-split-find-inbox - nnimap-split-articles - nnimap-request-scan - nnimap-request-newgroups - nnimap-request-create-group - nnimap-time-substract - nnimap-date-days-ago - nnimap-request-expire-articles-progress - nnimap-request-expire-articles - nnimap-request-move-article - nnimap-request-accept-article - nnimap-request-delete-group - nnimap-request-rename-group - gnus-group-nnimap-expunge - gnus-group-nnimap-edit-acl - gnus-group-nnimap-edit-acl-done - nnimap-group-mode-hook - nnimap-mark-to-predicate - nnimap-mark-to-flag-1 - nnimap-mark-to-flag - nnimap-mark-permanent-p - ))) + (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer)) + '( + nnimap-possibly-change-server + nnimap-verify-uidvalidity + nnimap-find-minmax-uid + nnimap-before-find-minmax-bugworkaround + nnimap-possibly-change-group + ;;nnimap-replace-whitespace + nnimap-retrieve-headers-progress + nnimap-retrieve-which-headers + nnimap-group-overview-filename + nnimap-retrieve-headers-from-file + nnimap-retrieve-headers-from-server + nnimap-retrieve-headers + nnimap-open-connection + nnimap-open-server + nnimap-server-opened + nnimap-close-server + nnimap-request-close + nnimap-status-message + ;;nnimap-demule + nnimap-request-article-part + nnimap-request-article + nnimap-request-head + nnimap-request-body + nnimap-request-group + nnimap-close-group + nnimap-pattern-to-list-arguments + nnimap-request-list + nnimap-request-post + nnimap-retrieve-groups + nnimap-request-update-info-internal + nnimap-request-type + nnimap-request-set-mark + nnimap-split-to-groups + nnimap-split-find-rule + nnimap-split-find-inbox + nnimap-split-articles + nnimap-request-scan + nnimap-request-newgroups + nnimap-request-create-group + nnimap-time-substract + nnimap-date-days-ago + nnimap-request-expire-articles-progress + nnimap-request-expire-articles + nnimap-request-move-article + nnimap-request-accept-article + nnimap-request-delete-group + nnimap-request-rename-group + gnus-group-nnimap-expunge + gnus-group-nnimap-edit-acl + gnus-group-nnimap-edit-acl-done + nnimap-group-mode-hook + nnimap-mark-to-predicate + nnimap-mark-to-flag-1 + nnimap-mark-to-flag + nnimap-mark-permanent-p + ))) (provide 'nnimap) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnkiboze.el --- a/lisp/gnus/nnkiboze.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnkiboze.el Sun Oct 28 09:18:39 2007 +0000 @@ -227,7 +227,7 @@ "." gnus-score-file-suffix)))))) (defun nnkiboze-generate-group (group &optional inhibit-list-groups) - (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) + (let* ((info (gnus-get-info group)) (newsrc-file (concat nnkiboze-directory (nnheader-translate-file-chars (concat group ".newsrc")))) @@ -269,8 +269,7 @@ (numberp (car (symbol-value group))) ; It is active (or (> nnkiboze-level 7) (and (setq glevel - (nth 1 (nth 2 (gnus-gethash - gname gnus-newsrc-hashtb)))) + (gnus-info-level (gnus-get-info gname))) (>= nnkiboze-level glevel))) (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes (push (cons gname (1- (car (symbol-value group)))) @@ -282,8 +281,7 @@ ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc - (if (not (setq active (gnus-gethash - (caar newsrc) gnus-active-hashtb))) + (if (not (setq active (gnus-active (caar newsrc)))) ;; This group isn't active after all, so we remove it from ;; the list of component groups. (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) @@ -294,8 +292,7 @@ (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) (setq ginfo (gnus-get-info (gnus-group-group-name)) orig-info (gnus-copy-sequence ginfo) - num-unread (car (gnus-gethash (caar newsrc) - gnus-newsrc-hashtb))) + num-unread (gnus-group-unread (caar newsrc))) (unwind-protect (progn ;; We set all list of article marks to nil. Since we operate @@ -338,8 +335,7 @@ ;; Restore the proper info. (when ginfo (setcdr ginfo (cdr orig-info))) - (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb) - num-unread))) + (setcar (gnus-group-entry (caar newsrc)) num-unread))) (setcdr (car newsrc) (cdr active)) (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) (setq newsrc (cdr newsrc))))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnmail.el --- a/lisp/gnus/nnmail.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnmail.el Sun Oct 28 09:18:39 2007 +0000 @@ -32,7 +32,6 @@ (require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) -(require 'custom) (require 'gnus-util) (require 'mail-source) (require 'mm-util) @@ -298,7 +297,10 @@ \(add-hook 'nnmail-read-incoming-hook (lambda () (call-process \"/local/bin/mailsend\" nil nil nil - \"read\" nnmail-spool-file))) + \"read\" + ;; The incoming mail box file. + (expand-file-name (user-login-name) + rmail-spool-directory)))) If you have xwatch running, this will alert it that mail has been read. @@ -412,13 +414,13 @@ (const :format "" &) (editable-list :inline t nnmail-split-fancy)) (list :tag "Function with fixed arguments (:)" - :value (: nil) + :value (:) (const :format "" :value :) function (editable-list :inline t (sexp :tag "Arg")) ) (list :tag "Function with split arguments (!)" - :value (! nil) + :value (!) (const :format "" !) function (editable-list :inline t nnmail-split-fancy)) @@ -476,7 +478,7 @@ word according to the `nnmail-split-fancy-syntax-table' syntax table. You can use \".*\" in the regexps to match partial field names or words. -FIELD and VALUE can also be lisp symbols, in that case they are expanded +FIELD and VALUE can also be Lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. GROUP can contain \\& and \\N which will substitute from matching @@ -660,9 +662,7 @@ (expand-file-name group dir) ;; If not, we translate dots into slashes. (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) + (nnheader-replace-chars-in-string group ?. ?/) dir)))) (or file ""))) @@ -687,7 +687,7 @@ (while (not (eobp)) (condition-case err (progn - (narrow-to-region (point) (gnus-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) (setq group (symbol-name group))) @@ -1047,6 +1047,9 @@ (nnmail-check-duplication message-id func artnum-func)) 1)) +(defvar nnmail-group-names-not-encoded-p nil + "Non-nil means group names are not encoded.") + (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. @@ -1056,7 +1059,8 @@ (nnmail-split-methods (if (and group (not nnmail-resplit-incoming)) (list (list group "")) - nnmail-split-methods))) + nnmail-split-methods)) + (nnmail-group-names-not-encoded-p t)) (save-excursion ;; Insert the incoming file. (set-buffer (get-buffer-create nnmail-article-buffer)) @@ -1125,7 +1129,7 @@ (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (gnus-point-at-eol))) + (delete-region (point) (point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1247,11 +1251,11 @@ (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - (insert (format " %s:%d" - (mm-encode-coding-string - (caar group-alist) - nnmail-pathname-coding-system) - (cdar group-alist))) + (insert (if (mm-multibyte-p) + (mm-string-as-multibyte + (format " %s:%d" (caar group-alist) (cdar group-alist))) + (mm-string-as-unibyte + (format " %s:%d" (caar group-alist) (cdar group-alist))))) (setq group-alist (cdr group-alist))) (insert "\n"))) @@ -1285,10 +1289,20 @@ "Translate TAB characters into SPACE characters." (subst-char-in-region (point-min) (point-max) ?\t ? t)) -(defun nnmail-fix-eudora-headers () - "Eudora has a broken References line, but an OK In-Reply-To." +(defcustom nnmail-broken-references-mailers + "^X-Mailer:.*\\(Eudora\\|Pegasus\\)" + "Header line matching mailer producing bogus References lines. +See `nnmail-ignore-broken-references'." + :group 'nnmail-prepare + :version "23.0" ;; No Gnus + :type 'regexp) + +(defun nnmail-ignore-broken-references () + "Ignore the References line and use In-Reply-To + +Eudora has a broken References line, but an OK In-Reply-To." (goto-char (point-min)) - (when (re-search-forward "^X-Mailer:.*Eudora" nil t) + (when (re-search-forward nnmail-broken-references-mailers nil t) (goto-char (point-min)) (when (re-search-forward "^References:" nil t) (beginning-of-line) @@ -1297,8 +1311,11 @@ (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) (replace-match "\\1" t)))) +(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) +(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) + (custom-add-option 'nnmail-prepare-incoming-header-hook - 'nnmail-fix-eudora-headers) + 'nnmail-ignore-broken-references) ;;; Utility functions @@ -1327,12 +1344,8 @@ (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for details." - (let ((syntab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table nnmail-split-fancy-syntax-table) - (nnmail-split-it nnmail-split-fancy)) - (set-syntax-table syntab)))) + (with-syntax-table nnmail-split-fancy-syntax-table + (nnmail-split-it nnmail-split-fancy))) (defvar nnmail-split-cache nil) ;; Alist of split expressions their equivalent regexps. @@ -1644,7 +1657,7 @@ (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) (gnus-point-at-eol))))))) + (buffer-substring (point) (point-at-eol))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. @@ -1672,12 +1685,11 @@ (setq references (nreverse (gnus-split-references refstr))) (unless (gnus-buffer-live-p nnmail-cache-buffer) (nnmail-cache-open)) - (mapcar (lambda (x) - (setq res (or (nnmail-cache-fetch-group x) res)) - (when (or (member res '("delayed" "drafts" "queue")) - (and regexp res (string-match regexp res))) - (setq res nil))) - references) + (dolist (x references) + (setq res (or (nnmail-cache-fetch-group x) res)) + (when (or (member res '("delayed" "drafts" "queue")) + (and regexp res (string-match regexp res))) + (setq res nil))) res))) (defun nnmail-cache-id-exists-p (id) @@ -1902,7 +1914,7 @@ (or (string-match (cadr regexp-target-pair) from) (and (string-match (cadr regexp-target-pair) to) (let ((rmail-dont-reply-to-names - message-dont-reply-to-names)) + (message-dont-reply-to-names))) (equal (rmail-dont-reply-to from) ""))))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) @@ -1995,14 +2007,12 @@ (with-output-to-temp-buffer "*nnmail split history*" (with-current-buffer standard-output (fundamental-mode)) ; for Emacs 20.4+ - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) + (dolist (elem nnmail-split-history) (princ (mapconcat (lambda (ga) (concat (car ga) ":" (int-to-string (cdr ga)))) elem ", ")) - (princ "\n"))))) + (princ "\n")))) (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnmaildir.el --- a/lisp/gnus/nnmaildir.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnmaildir.el Sun Oct 28 09:18:39 2007 +0000 @@ -41,6 +41,8 @@ ;; copying, restoring, etc. ;; ;; Todo: +;; * When moving an article for expiry, copy all the marks except 'expire +;; from the original article. ;; * Add a hook for when moving messages from new/ to cur/, to support ;; nnmail's duplicate detection. ;; * Improve generated Xrefs, so crossposts are detectable. @@ -54,6 +56,7 @@ (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0) (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0) (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0) + (put 'nnmaildir--condcase 'lisp-indent-function 2) ) ] @@ -229,7 +232,6 @@ (defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) (defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) (defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num")) -(defmacro nnmaildir--num-file (dir) `(concat ,dir ":")) (defmacro nnmaildir--unlink (file-arg) `(let ((file ,file-arg)) @@ -237,20 +239,36 @@ (defun nnmaildir--mkdir (dir) (or (file-exists-p (file-name-as-directory dir)) (make-directory-internal (directory-file-name dir)))) +(defun nnmaildir--mkfile (file) + (write-region "" nil file nil 'no-message)) (defun nnmaildir--delete-dir-files (dir ls) (when (file-attributes dir) - (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) + (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) (delete-directory dir))) (defun nnmaildir--group-maxnum (server group) - (if (zerop (nnmaildir--grp-count group)) 0 - (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server) - (nnmaildir--grp-name group)))) - (setq x (nnmaildir--nndir x) - x (nnmaildir--num-dir x) - x (nnmaildir--num-file x) - x (file-attributes x)) - (if x (1- (nth 1 x)) 0)))) + (catch 'return + (if (zerop (nnmaildir--grp-count group)) (throw 'return 0)) + (let ((dir (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server) + (nnmaildir--grp-name group))) + (number-opened 1) + attr ino-opened nlink number-linked) + (setq dir (nnmaildir--nndir dir) + dir (nnmaildir--num-dir dir)) + (while t + (setq attr (file-attributes + (concat dir (number-to-string number-opened)))) + (or attr (throw 'return (1- number-opened))) + (setq ino-opened (nth 10 attr) + nlink (nth 1 attr) + number-linked (+ number-opened nlink)) + (if (or (< nlink 1) (< number-linked nlink)) + (signal 'error '("Arithmetic overflow"))) + (setq attr (file-attributes + (concat dir (number-to-string number-linked)))) + (or attr (throw 'return (1- number-linked))) + (if (/= ino-opened (nth 10 attr)) + (setq number-opened number-linked)))))) ;; Make the given server, if non-nil, be the current server. Then make the ;; given group, if non-nil, be the current group of the current server. Then @@ -287,6 +305,64 @@ (setq pos (match-end 0)))) string) +(defmacro nnmaildir--condcase (errsym body &rest handler) + `(condition-case ,errsym + (let ((system-messages-locale "C")) ,body) + (error . ,handler))) + +(defun nnmaildir--emlink-p (err) + (and (eq (car err) 'file-error) + (string= (downcase (caddr err)) "too many links"))) + +(defun nnmaildir--enoent-p (err) + (and (eq (car err) 'file-error) + (string= (downcase (caddr err)) "no such file or directory"))) + +(defun nnmaildir--eexist-p (err) + (eq (car err) 'file-already-exists)) + +(defun nnmaildir--new-number (nndir) + "Allocate a new article number by atomically creating a file under NNDIR." + (let ((numdir (nnmaildir--num-dir nndir)) + (make-new-file t) + (number-open 1) + number-link previous-number-link path-open path-link ino-open) + (nnmaildir--mkdir numdir) + (catch 'return + (while t + (setq path-open (concat numdir (number-to-string number-open))) + (if (not make-new-file) + (setq previous-number-link number-link) + (nnmaildir--mkfile path-open) + ;; If Emacs had O_CREAT|O_EXCL, we could return number-open here. + (setq make-new-file nil + previous-number-link 0)) + (let* ((attr (file-attributes path-open)) + (nlink (nth 1 attr))) + (setq ino-open (nth 10 attr) + number-link (+ number-open nlink)) + (if (or (< nlink 1) (< number-link nlink)) + (signal 'error '("Arithmetic overflow")))) + (if (= number-link previous-number-link) + ;; We've already tried this number, in the previous loop iteration, + ;; and failed. + (signal 'error `("Corrupt internal nnmaildir data" ,path-open))) + (setq path-link (concat numdir (number-to-string number-link))) + (nnmaildir--condcase err + (progn + (add-name-to-file path-open path-link) + (throw 'return number-link)) + (cond + ((nnmaildir--emlink-p err) + (setq make-new-file t + number-open number-link)) + ((nnmaildir--eexist-p err) + (let ((attr (file-attributes path-link))) + (if (/= (nth 10 attr) ino-open) + (setq number-open number-link + number-link 0)))) + (t (signal (car err) (cdr err))))))))) + (defun nnmaildir--update-nov (server group article) (let ((nnheader-file-coding-system 'binary) (srv-dir (nnmaildir--srv-dir server)) @@ -398,30 +474,7 @@ nnmaildir--extra) num (nnmaildir--art-num article)) (unless num - ;; Allocate a new article number. - (erase-buffer) - (setq numdir (nnmaildir--num-dir dir) - file (nnmaildir--num-file numdir) - num -1) - (nnmaildir--mkdir numdir) - (write-region "" nil file nil 'no-message) - (while file - ;; Get the number of links to file. - (setq attr (nth 1 (file-attributes file))) - (if (= attr num) - ;; We've already tried this number, in the previous loop - ;; iteration, and failed. - (signal 'error `("Corrupt internal nnmaildir data" ,numdir))) - ;; If attr is 123, try to link file to "123". This atomically - ;; increases the link count and creates the "123" link, failing - ;; if that link was already created by another Gnus, just after - ;; we stat()ed file. - (condition-case nil - (progn - (add-name-to-file file (concat numdir (format "%x" attr))) - (setq file nil)) ;; Stop looping. - (file-already-exists nil)) - (setq num attr)) + (setq num (nnmaildir--new-number dir)) (setf (nnmaildir--art-num article) num)) ;; Store this new NOV data in a file (erase-buffer) @@ -683,8 +736,7 @@ group (make-nnmaildir--grp :name gname :index 0)) (nnmaildir--mkdir nndir) (nnmaildir--mkdir (nnmaildir--nov-dir nndir)) - (nnmaildir--mkdir (nnmaildir--marks-dir nndir)) - (write-region "" nil (concat nndir "markfile") nil 'no-message)) + (nnmaildir--mkdir (nnmaildir--marks-dir nndir))) (setq read-only (nnmaildir--param pgname 'read-only) ls (or (nnmaildir--param pgname 'directory-files) srv-ls)) (unless read-only @@ -693,12 +745,10 @@ (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "Maildir spans filesystems: " absdir)) (throw 'return nil)) - (mapcar - (lambda (file) - (setq x (file-attributes file)) - (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago)) - (delete-file file))) - (funcall ls tdir 'full "\\`[^.]" 'nosort))) + (dolist (file (funcall ls tdir 'full "\\`[^.]" 'nosort)) + (setq x (file-attributes file)) + (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago)) + (delete-file file)))) (or scan-msgs isnew (throw 'return t)) @@ -707,12 +757,10 @@ (setq nattr nil)) (if read-only (setq dir (and (or isnew nattr) ndir)) (when (or isnew nattr) - (mapcar - (lambda (file) - (let ((path (concat ndir file))) - (and (time-less-p (nth 5 (file-attributes path)) (current-time)) - (rename-file path (concat cdir file ":2,"))))) - (funcall ls ndir nil "\\`[^.]" 'nosort)) + (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort)) + (setq x (concat ndir file)) + (and (time-less-p (nth 5 (file-attributes x)) (current-time)) + (rename-file x (concat cdir file ":2,")))) (setf (nnmaildir--grp-new group) nattr)) (setq cattr (nth 5 (file-attributes cdir))) (if (equal cattr (nnmaildir--grp-cur group)) @@ -737,13 +785,11 @@ cdir (nnmaildir--marks-dir nndir) ndir (nnmaildir--subdir cdir "tick") cdir (nnmaildir--subdir cdir "read")) - (mapcar - (lambda (file) - (setq file (car file)) - (if (or (not (file-exists-p (concat cdir file))) - (file-exists-p (concat ndir file))) - (setq num (1+ num)))) - files)) + (dolist (file files) + (setq file (car file)) + (if (or (not (file-exists-p (concat cdir file))) + (file-exists-p (concat ndir file))) + (setq num (1+ num))))) (setf (nnmaildir--grp-cache group) (make-vector num nil)) (let ((inhibit-quit t)) (set (intern gname groups) group)) @@ -757,12 +803,10 @@ files (delq nil files) files (mapcar 'nnmaildir--parse-filename files) files (sort files 'nnmaildir--sort-files)) - (mapcar - (lambda (file) - (setq file (if (consp file) file (aref file 3)) - x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) - (nnmaildir--grp-add-art nnmaildir--cur-server group x)) - files) + (dolist (file files) + (setq file (if (consp file) file (aref file 3)) + x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) + (nnmaildir--grp-add-art nnmaildir--cur-server group x)) (if read-only (setf (nnmaildir--grp-new group) nattr) (setf (nnmaildir--grp-cur group) cattr))) t)) @@ -809,19 +853,18 @@ dirs)) seen (nnmaildir--up2-1 (length dirs)) seen (make-vector seen 0)) - (mapcar - (lambda (grp-dir) - (if (nnmaildir--scan grp-dir scan-group groups method srv-dir - srv-ls) - (intern grp-dir seen))) - dirs) + (dolist (grp-dir dirs) + (if (nnmaildir--scan grp-dir scan-group groups method srv-dir + srv-ls) + (intern grp-dir seen))) (setq x nil) (mapatoms (lambda (group) (setq group (symbol-name group)) (unless (intern-soft group seen) (setq x (cons group x)))) groups) - (mapcar (lambda (grp) (unintern grp groups)) x) + (dolist (grp x) + (unintern grp groups)) (setf (nnmaildir--srv-mtime nnmaildir--cur-server) (nth 5 (file-attributes srv-dir)))) (and scan-group @@ -857,19 +900,17 @@ (nnmaildir--prepare server nil) (nnmaildir--with-nntp-buffer (erase-buffer) - (mapcar - (lambda (gname) - (setq group (nnmaildir--prepare nil gname)) - (if (null group) (insert "411 no such news group\n") - (insert "211 ") - (princ (nnmaildir--grp-count group) nntp-server-buffer) - (insert " ") - (princ (nnmaildir--grp-min group) nntp-server-buffer) - (insert " ") - (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) - nntp-server-buffer) - (insert " " gname "\n"))) - groups))) + (dolist (gname groups) + (setq group (nnmaildir--prepare nil gname)) + (if (null group) (insert "411 no such news group\n") + (insert "211 ") + (princ (nnmaildir--grp-count group) nntp-server-buffer) + (insert " ") + (princ (nnmaildir--grp-min group) nntp-server-buffer) + (insert " ") + (princ (nnmaildir--group-maxnum nnmaildir--cur-server group) + nntp-server-buffer) + (insert " " gname "\n"))))) 'group) (defun nnmaildir-request-update-info (gname info &optional server) @@ -909,33 +950,29 @@ new-mmth (nnmaildir--up2-1 (length markdirs)) new-mmth (make-vector new-mmth 0) old-mmth (nnmaildir--grp-mmth group)) - (mapcar - (lambda (mark) - (setq markdir (nnmaildir--subdir dir mark) - mark-sym (intern mark) - ranges nil) - (catch 'got-ranges - (if (memq mark-sym never-marks) (throw 'got-ranges nil)) - (when (memq mark-sym always-marks) - (setq ranges existing) - (throw 'got-ranges nil)) - (setq mtime (nth 5 (file-attributes markdir))) - (set (intern mark new-mmth) mtime) - (when (equal mtime (symbol-value (intern-soft mark old-mmth))) - (setq ranges (assq mark-sym old-marks)) - (if ranges (setq ranges (cdr ranges))) - (throw 'got-ranges nil)) - (mapcar - (lambda (prefix) - (setq article (nnmaildir--flist-art flist prefix)) - (if article - (setq ranges - (gnus-add-to-range ranges - `(,(nnmaildir--art-num article)))))) - (funcall ls markdir nil "\\`[^.]" 'nosort))) - (if (eq mark-sym 'read) (setq read ranges) - (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) - markdirs) + (dolist (mark markdirs) + (setq markdir (nnmaildir--subdir dir mark) + mark-sym (intern mark) + ranges nil) + (catch 'got-ranges + (if (memq mark-sym never-marks) (throw 'got-ranges nil)) + (when (memq mark-sym always-marks) + (setq ranges existing) + (throw 'got-ranges nil)) + (setq mtime (nth 5 (file-attributes markdir))) + (set (intern mark new-mmth) mtime) + (when (equal mtime (symbol-value (intern-soft mark old-mmth))) + (setq ranges (assq mark-sym old-marks)) + (if ranges (setq ranges (cdr ranges))) + (throw 'got-ranges nil)) + (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort)) + (setq article (nnmaildir--flist-art flist prefix)) + (if article + (setq ranges + (gnus-add-to-range ranges + `(,(nnmaildir--art-num article))))))) + (if (eq mark-sym 'read) (setq read ranges) + (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) (gnus-info-set-read info (gnus-range-add read missing)) (gnus-info-set-marks info marks 'extend) (setf (nnmaildir--grp-mmth group) new-mmth) @@ -1087,10 +1124,10 @@ (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls) (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls)) (setq dir (nnmaildir--nndir grp-dir)) - (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls)) - `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir) - ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" - 'nosort))) + (dolist (subdir `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir) + ,@(funcall ls (nnmaildir--marks-dir dir) + 'full "\\`[^.]" 'nosort))) + (nnmaildir--delete-dir-files subdir ls)) (setq dir (nnmaildir--nndir grp-dir)) (nnmaildir--unlink (concat dir "markfile")) (nnmaildir--unlink (concat dir "markfile{new}")) @@ -1144,11 +1181,9 @@ (nnmaildir--nlist-iterate nlist 'all insert-nov)) ((null articles)) ((stringp (car articles)) - (mapcar - (lambda (msgid) - (setq article (nnmaildir--mlist-art mlist msgid)) - (if article (funcall insert-nov article))) - articles)) + (dolist (msgid articles) + (setq article (nnmaildir--mlist-art mlist msgid)) + (if article (funcall insert-nov article)))) (t (if fetch-old ;; Assume the article range list is sorted ascending @@ -1254,7 +1289,7 @@ t))) (defun nnmaildir-request-move-article (article gname server accept-form - &optional last) + &optional last move-is-internal) (let ((group (nnmaildir--prepare server gname)) pgname suffix result nnmaildir--file deactivate-mark) (catch 'return @@ -1339,8 +1374,7 @@ nnmaildir--cur-server) "24-hour timer expired") (throw 'return nil)))) - (condition-case nil - (add-name-to-file nnmaildir--file tmpfile) + (condition-case nil (add-name-to-file nnmaildir--file tmpfile) (error (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil 'excl) @@ -1470,7 +1504,12 @@ (not (string-equal target pgname))) ;; Move it. (erase-buffer) (nnheader-insert-file-contents nnmaildir--file) - (gnus-request-accept-article target nil nil 'no-encode)) + (let ((group-art (gnus-request-accept-article + target nil nil 'no-encode))) + (when (consp group-art) + ;; Maybe also copy: dormant forward reply save tick + ;; (gnus-add-mark? gnus-request-set-mark?) + (gnus-group-mark-article-read target (cdr group-art))))) (if (equal target pgname) ;; Leave it here. (setq didnt (cons (nnmaildir--art-num article) didnt)) @@ -1484,8 +1523,8 @@ (coding-system-for-write nnheader-file-coding-system) (buffer-file-coding-system nil) (file-coding-system-alist nil) - del-mark del-action add-action set-action marksdir markfile nlist - ranges begin end article all-marks todo-marks did-marks mdir mfile + del-mark del-action add-action set-action marksdir nlist + ranges begin end article all-marks todo-marks mdir mfile pgname ls permarkfile deactivate-mark) (setq del-mark (lambda (mark) @@ -1500,17 +1539,19 @@ (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) permarkfile (concat mdir ":") mfile (concat mdir (nnmaildir--art-prefix article))) - (unless (memq mark did-marks) - (setq did-marks (cons mark did-marks)) - (nnmaildir--mkdir mdir) - (unless (file-attributes permarkfile) - (condition-case nil - (add-name-to-file markfile permarkfile) - (file-error - ;; AFS can't make hard links in separate directories - (write-region "" nil permarkfile nil 'no-message))))) - (unless (file-exists-p mfile) - (add-name-to-file permarkfile mfile))) + (nnmaildir--condcase err (add-name-to-file permarkfile mfile) + (cond + ((nnmaildir--eexist-p err)) + ((nnmaildir--enoent-p err) + (nnmaildir--mkdir mdir) + (nnmaildir--mkfile permarkfile) + (add-name-to-file permarkfile mfile)) + ((nnmaildir--emlink-p err) + (let ((permarkfilenew (concat permarkfile "{new}"))) + (nnmaildir--mkfile permarkfilenew) + (rename-file permarkfilenew permarkfile 'replace) + (add-name-to-file permarkfile mfile))) + (t (signal (car err) (cdr err)))))) todo-marks)) set-action (lambda (article) (funcall add-action) @@ -1522,32 +1563,29 @@ (unless group (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "No such group: " gname)) - (mapcar (lambda (action) - (setq ranges (gnus-range-add ranges (car action)))) - actions) + (dolist (action actions) + (setq ranges (gnus-range-add ranges (car action)))) (throw 'return ranges)) (setq nlist (nnmaildir--grp-nlist group) marksdir (nnmaildir--srv-dir nnmaildir--cur-server) marksdir (nnmaildir--srvgrp-dir marksdir gname) marksdir (nnmaildir--nndir marksdir) - markfile (concat marksdir "markfile") marksdir (nnmaildir--marks-dir marksdir) gname (nnmaildir--grp-name group) pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) all-marks (mapcar 'intern all-marks)) - (mapcar - (lambda (action) - (setq ranges (car action) - todo-marks (caddr action)) - (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks) - (if (numberp (cdr ranges)) (setq ranges (list ranges))) - (nnmaildir--nlist-iterate nlist ranges - (cond ((eq 'del (cadr action)) del-action) - ((eq 'add (cadr action)) add-action) - (t set-action)))) - actions) + (dolist (action actions) + (setq ranges (car action) + todo-marks (caddr action)) + (dolist (mark todo-marks) + (add-to-list 'all-marks mark)) + (if (numberp (cdr ranges)) (setq ranges (list ranges))) + (nnmaildir--nlist-iterate nlist ranges + (cond ((eq 'del (cadr action)) del-action) + ((eq 'add (cadr action)) add-action) + (t set-action)))) nil))) (defun nnmaildir-close-group (gname &optional server) @@ -1576,22 +1614,16 @@ flist (nnmaildir--up2-1 (length files)) flist (make-vector flist 0)) (save-match-data - (mapcar - (lambda (file) - (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) - (intern (match-string 1 file) flist)) - files)) - (mapcar - (lambda (dir) - (setq files (cdr dir) - dir (file-name-as-directory (car dir))) - (mapcar - (lambda (file) - (unless (or (intern-soft file flist) (string= file ":")) - (setq file (concat dir file)) - (delete-file file))) - files)) - dirs) + (dolist (file files) + (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) + (intern (match-string 1 file) flist))) + (dolist (dir dirs) + (setq files (cdr dir) + dir (file-name-as-directory (car dir))) + (dolist (file files) + (unless (or (intern-soft file flist) (string= file ":")) + (setq file (concat dir file)) + (delete-file file)))) t))) (defun nnmaildir-close-server (&optional server) @@ -1608,7 +1640,7 @@ (mapatoms (lambda (server) (setq servers (cons (symbol-name server) servers))) nnmaildir--servers) - (mapcar 'nnmaildir-close-server servers) + (mapc 'nnmaildir-close-server servers) (setq buffer (get-buffer " *nnmaildir work*")) (if buffer (kill-buffer buffer)) (setq buffer (get-buffer " *nnmaildir nov*")) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnmbox.el --- a/lisp/gnus/nnmbox.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnmbox.el Sun Oct 28 09:18:39 2007 +0000 @@ -284,7 +284,7 @@ (nconc rest articles)))) (deffoo nnmbox-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnmbox move*")) result) (and diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnmh.el --- a/lisp/gnus/nnmh.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnmh.el Sun Oct 28 09:18:39 2007 +0000 @@ -176,7 +176,7 @@ (nnheader-re-read-dir pathname) (setq dir (sort - (mapcar (lambda (name) (string-to-number name)) + (mapcar 'string-to-number (directory-files pathname nil "^[0-9]+$" t)) '<)) (cond @@ -211,7 +211,6 @@ (setq dir (expand-file-name dir)) ;; Recurse down all directories. (let ((dirs (and (file-readable-p dir) - (> (nth 1 (file-attributes (file-chase-links dir))) 2) (nnheader-directory-files dir t nil t))) rdir) ;; Recurse down directories. @@ -223,9 +222,8 @@ (nnmh-request-list-1 rdir)))) ;; For each directory, generate an active file line. (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar - (lambda (name) (string-to-number name)) - (directory-files dir nil "^[0-9]+$" t)))) + (let ((files (mapcar 'string-to-number + (directory-files dir nil "^[0-9]+$" t)))) (when files (save-excursion (set-buffer nntp-server-buffer) @@ -290,8 +288,8 @@ (deffoo nnmh-close-group (group &optional server) t) -(deffoo nnmh-request-move-article (article group server - accept-form &optional last) +(deffoo nnmh-request-move-article (article group server accept-form + &optional last move-is-internal) (let ((buf (get-buffer-create " *nnmh move*")) result) (and @@ -356,11 +354,9 @@ nnmh-group-alist) (nnmh-possibly-create-directory group) (nnmh-possibly-change-directory group server) - (let ((articles (mapcar - (lambda (file) - (string-to-number file)) - (directory-files - nnmh-current-directory nil "^[0-9]+$")))) + (let ((articles (mapcar 'string-to-number + (directory-files + nnmh-current-directory nil "^[0-9]+$")))) (when articles (setcar active (apply 'min articles)) (setcdr active (apply 'max articles)))))) @@ -484,10 +480,8 @@ (gnus-make-directory dir)) ;; Find the highest number in the group. (let ((files (sort - (mapcar - (lambda (f) - (string-to-number f)) - (directory-files dir nil "^[0-9]+$")) + (mapcar 'string-to-number + (directory-files dir nil "^[0-9]+$")) '>))) (when files (setcdr active (car files))))) @@ -509,7 +503,7 @@ ;; articles in this folder. The articles that are "new" will be ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) - (files (sort (mapcar (function (lambda (name) (string-to-number name))) + (files (sort (mapcar 'string-to-number (directory-files nnmh-current-directory nil "^[0-9]+$" t)) '<)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnml.el --- a/lisp/gnus/nnml.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnml.el Sun Oct 28 09:18:39 2007 +0000 @@ -3,8 +3,9 @@ ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. -;; Author: Simon Josefsson (adding MARKS) -;; Lars Magne Ingebrigtsen +;; Authors: Didier Verna (adding compaction) +;; Simon Josefsson (adding MARKS) +;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -40,7 +41,8 @@ (eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'gnus-article-unpropagatable-p "gnus-sum")) + (autoload 'gnus-article-unpropagatable-p "gnus-sum") + (autoload 'gnus-backlog-remove-article "gnus-bcklg")) (nnoo-declare nnml) @@ -83,7 +85,18 @@ "If non-nil, inhibit expiry.") (defvoo nnml-use-compressed-files nil - "If non-nil, allow using compressed message files.") + "If non-nil, allow using compressed message files. + +If it is a string, use it as the file extension which specifies +the compression program. You can set it to \".bz2\" if your Emacs +supports auto-compression using the bzip2 program. A value of t +is equivalent to \".gz\".") + +(defvoo nnml-compressed-files-size-threshold 1000 + "Default size threshold for compressed message files. +Message files with bodies larger than that many characters will +be automatically compressed if `nnml-use-compressed-files' is +non-nil.") @@ -116,6 +129,37 @@ (nnoo-define-basics nnml) +(eval-when-compile + (defsubst nnml-group-name-charset (group server-or-method) + (gnus-group-name-charset + (if (stringp server-or-method) + (gnus-server-to-method + (if (string-match "\\+" server-or-method) + (concat (substring server-or-method 0 (match-beginning 0)) + ":" (substring server-or-method (match-end 0))) + (concat "nnml:" server-or-method))) + (or server-or-method gnus-command-method '(nnml ""))) + group))) + +(defun nnml-decoded-group-name (group &optional server-or-method) + "Return a decoded group name of GROUP on SERVER-OR-METHOD." + (if nnmail-group-names-not-encoded-p + group + (mm-decode-coding-string + group + (nnml-group-name-charset group server-or-method)))) + +(defun nnml-encoded-group-name (group &optional server-or-method) + "Return an encoded group name of GROUP on SERVER-OR-METHOD." + (mm-encode-coding-string + group + (nnml-group-name-charset group server-or-method))) + +(defun nnml-group-pathname (group &optional file server) + "Return an absolute file name of FILE for GROUP on SERVER." + (nnmail-group-pathname (inline (nnml-decoded-group-name group server)) + nnml-directory file)) + (deffoo nnml-retrieve-headers (sequence &optional group server fetch-old) (when (nnml-possibly-change-directory group server) (save-excursion @@ -188,14 +232,12 @@ (file-name-coding-system nnmail-pathname-coding-system) path gpath group-num) (if (stringp id) - (when (and (setq group-num (nnml-find-group-number id)) + (when (and (setq group-num (nnml-find-group-number id server)) (cdr (assq (cdr group-num) (nnheader-article-to-file-alist - (setq gpath - (nnmail-group-pathname - (car group-num) - nnml-directory)))))) + (setq gpath (nnml-group-pathname (car group-num) + nil server)))))) (setq path (concat gpath (int-to-string (cdr group-num))))) (setq path (nnml-article-to-file id))) (cond @@ -252,19 +294,23 @@ (nnml-possibly-change-directory nil server) (nnmail-activate 'nnml) (cond + ((let ((file (directory-file-name (nnml-group-pathname group nil server))) + (file-name-coding-system nnmail-pathname-coding-system)) + (and (file-exists-p file) + (not (file-directory-p file)))) + (nnheader-report 'nnml "%s is a file" + (directory-file-name (nnml-group-pathname group + nil server)))) ((assoc group nnml-group-alist) t) - ((and (file-exists-p (nnmail-group-pathname group nnml-directory)) - (not (file-directory-p (nnmail-group-pathname group nnml-directory)))) - (nnheader-report 'nnml "%s is a file" - (nnmail-group-pathname group nnml-directory))) (t (let (active) (push (list group (setq active (cons 1 0))) nnml-group-alist) - (nnml-possibly-create-directory group) + (nnml-possibly-create-directory group server) (nnml-possibly-change-directory group server) - (let ((articles (nnml-directory-articles nnml-current-directory))) + (let* ((file-name-coding-system nnmail-pathname-coding-system) + (articles (nnml-directory-articles nnml-current-directory))) (when articles (setcar active (apply 'min articles)) (setcdr active (apply 'max articles)))) @@ -288,10 +334,12 @@ (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) - (let ((active-articles - (nnml-directory-articles nnml-current-directory)) - (is-old t) - article rest mod-time number) + (let* ((file-name-coding-system nnmail-pathname-coding-system) + (active-articles + (nnml-directory-articles nnml-current-directory)) + (is-old t) + (decoded (nnml-decoded-group-name group server)) + article rest mod-time number target) (nnmail-activate 'nnml) (setq active-articles (sort active-articles '<)) @@ -308,23 +356,33 @@ nnml-inhibit-expiry))) (progn ;; Allow a special target group. - (unless (eq nnmail-expiry-target 'delete) + (setq target nnmail-expiry-target) + (unless (eq target 'delete) (with-temp-buffer (nnml-request-article number group server (current-buffer)) (let (nnml-current-directory nnml-current-group nnml-article-file-alist) - (nnmail-expiry-target-group nnmail-expiry-target group))) + (when (functionp target) + (setq target (funcall target group))) + (if (and target + (or (gnus-request-group target) + (gnus-request-create-group target))) + (nnmail-expiry-target-group target group) + (setq target nil)))) ;; Maybe directory is changed during nnmail-expiry-target-group. (nnml-possibly-change-directory group server)) - (nnheader-message 5 "Deleting article %s in %s" - number group) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (push number rest))) - (setq active-articles (delq number active-articles)) - (nnml-nov-delete-article group number)) + (if target + (progn + (nnheader-message 5 "Deleting article %s in %s" + number decoded) + (condition-case () + (funcall nnmail-delete-file-function article) + (file-error + (push number rest))) + (setq active-articles (delq number active-articles)) + (nnml-nov-delete-article group number)) + (push number rest))) (push number rest))) (let ((active (nth 1 (assoc group nnml-group-alist)))) (when active @@ -336,8 +394,9 @@ (nconc rest articles))) (deffoo nnml-request-move-article - (article group server accept-form &optional last) + (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnml move*")) + (file-name-coding-system nnmail-pathname-coding-system) result) (nnml-possibly-change-directory group server) (nnml-update-file-alist) @@ -370,7 +429,7 @@ (nnmail-check-syntax) (let (result) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -378,16 +437,20 @@ (and (nnmail-activate 'nnml) (setq result (car (nnml-save-mail - (list (cons group (nnml-active-number group)))))) + (list (cons group (nnml-active-number group + server))) + server))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) (and last (nnml-save-nov)))) (and (nnmail-activate 'nnml) - (if (and (not (setq result (nnmail-article-group 'nnml-active-number))) + (if (and (not (setq result (nnmail-article-group + `(lambda (group) + (nnml-active-number group ,server))))) (yes-or-no-p "Moved to `junk' group; delete article? ")) (setq result 'junk) - (setq result (car (nnml-save-mail result)))) + (setq result (car (nnml-save-mail result server)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) (when nnmail-cache-accepted-message-ids @@ -439,47 +502,54 @@ (deffoo nnml-request-delete-group (group &optional force server) (nnml-possibly-change-directory group server) - (when force - ;; Delete all articles in GROUP. - (let ((articles - (directory-files - nnml-current-directory t - (concat nnheader-numerical-short-files - "\\|" (regexp-quote nnml-nov-file-name) "$" - "\\|" (regexp-quote nnml-marks-file-name) "$"))) - article) - (while articles - (setq article (pop articles)) - (when (file-writable-p article) - (nnheader-message 5 "Deleting article %s in %s..." article group) - (funcall nnmail-delete-file-function article)))) - ;; Try to delete the directory itself. - (ignore-errors (delete-directory nnml-current-directory))) - ;; Remove the group from all structures. - (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) - nnml-current-group nil - nnml-current-directory nil) - ;; Save the active file. - (nnmail-save-active nnml-group-alist nnml-active-file) + (let ((file (directory-file-name nnml-current-directory)) + (file-name-coding-system nnmail-pathname-coding-system)) + (if (file-exists-p file) + (if (file-directory-p file) + (progn + (when force + ;; Delete all articles in GROUP. + (let ((articles + (directory-files + nnml-current-directory t + (concat + nnheader-numerical-short-files + "\\|" (regexp-quote nnml-nov-file-name) "$" + "\\|" (regexp-quote nnml-marks-file-name) "$"))) + (decoded (nnml-decoded-group-name group server))) + (dolist (article articles) + (when (file-writable-p article) + (nnheader-message 5 "Deleting article %s in %s..." + (file-name-nondirectory article) + decoded) + (funcall nnmail-delete-file-function article)))) + ;; Try to delete the directory itself. + (ignore-errors (delete-directory nnml-current-directory)))) + (nnheader-report 'nnml "%s is not a directory" file)) + (nnheader-report 'nnml "No such directory: %s/" file)) + ;; Remove the group from all structures. + (setq nnml-group-alist + (delq (assoc group nnml-group-alist) nnml-group-alist) + nnml-current-group nil + nnml-current-directory nil) + ;; Save the active file. + (nnmail-save-active nnml-group-alist nnml-active-file)) t) (deffoo nnml-request-rename-group (group new-name &optional server) (nnml-possibly-change-directory group server) - (let ((new-dir (nnmail-group-pathname new-name nnml-directory)) - (old-dir (nnmail-group-pathname group nnml-directory))) + (let ((new-dir (nnml-group-pathname new-name nil server)) + (old-dir (nnml-group-pathname group nil server))) (when (ignore-errors (make-directory new-dir t) t) ;; We move the articles file by file instead of renaming ;; the directory -- there may be subgroups in this group. ;; One might be more clever, I guess. - (let ((files (nnheader-article-to-file-alist old-dir))) - (while files - (rename-file - (concat old-dir (cdar files)) - (concat new-dir (cdar files))) - (pop files))) + (dolist (file (nnheader-article-to-file-alist old-dir)) + (rename-file + (concat old-dir (cdr file)) + (concat new-dir (cdr file)))) ;; Move .overview file. (let ((overview (concat old-dir nnml-nov-file-name))) (when (file-exists-p overview) @@ -534,7 +604,8 @@ (defun nnml-deletable-article-p (group article) "Say whether ARTICLE in GROUP can be deleted." - (let (path) + (let ((file-name-coding-system nnmail-pathname-coding-system) + path) (when (setq path (nnml-article-to-file article)) (when (file-writable-p path) (or (not nnmail-keep-last-article) @@ -542,7 +613,7 @@ article))))))) ;; Find an article number in the current group given the Message-ID. -(defun nnml-find-group-number (id) +(defun nnml-find-group-number (id server) (save-excursion (set-buffer (get-buffer-create " *nnml id*")) (let ((alist nnml-group-alist) @@ -550,22 +621,21 @@ ;; We want to look through all .overview files, but we want to ;; start with the one in the current directory. It seems most ;; likely that the article we are looking for is in that group. - (if (setq number (nnml-find-id nnml-current-group id)) + (if (setq number (nnml-find-id nnml-current-group id server)) (cons nnml-current-group number) ;; It wasn't there, so we look through the other groups as well. (while (and (not number) alist) (or (string= (caar alist) nnml-current-group) - (setq number (nnml-find-id (caar alist) id))) + (setq number (nnml-find-id (caar alist) id server))) (or number (setq alist (cdr alist)))) (and number (cons (caar alist) number)))))) -(defun nnml-find-id (group id) +(defun nnml-find-id (group id server) (erase-buffer) - (let ((nov (expand-file-name nnml-nov-file-name - (nnmail-group-pathname group nnml-directory))) + (let ((nov (nnml-group-pathname group nnml-nov-file-name server)) number found) (when (file-exists-p nov) (nnheader-insert-file-contents nov) @@ -573,7 +643,7 @@ (search-forward id nil t)) ; We find the ID. ;; And the id is in the fourth field. (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (gnus-point-at-bol) t)))) + (not (search-backward "\t" (point-at-bol) t)))) (forward-line 1) (beginning-of-line) (setq found t) @@ -606,7 +676,7 @@ (nnml-open-server server)) (if (not group) t - (let ((pathname (nnmail-group-pathname group nnml-directory)) + (let ((pathname (nnml-group-pathname group nil server)) (file-name-coding-system nnmail-pathname-coding-system)) (when (not (equal pathname nnml-current-directory)) (setq nnml-current-directory pathname @@ -614,20 +684,32 @@ nnml-article-file-alist nil)) (file-exists-p nnml-current-directory)))) -(defun nnml-possibly-create-directory (group) - (let ((dir (nnmail-group-pathname group nnml-directory))) +(defun nnml-possibly-create-directory (group &optional server) + (let ((dir (nnml-group-pathname group nil server)) + (file-name-coding-system nnmail-pathname-coding-system)) (unless (file-exists-p dir) (make-directory (directory-file-name dir) t) (nnheader-message 5 "Creating mail directory %s" dir)))) -(defun nnml-save-mail (group-art) - "Called narrowed to an article." - (let (chars headers extension) - (setq chars (nnmail-insert-lines)) - (setq extension - (and nnml-use-compressed-files - (> chars 1000) - ".gz")) +(defun nnml-save-mail (group-art &optional server) + "Save a mail into the groups GROUP-ART in the nnml server SERVER. +GROUP-ART is a list that each element is a cons of a group name and an +article number. This function is called narrowed to an article." + (let* ((chars (nnmail-insert-lines)) + (extension (and nnml-use-compressed-files + (> chars nnml-compressed-files-size-threshold) + (if (stringp nnml-use-compressed-files) + nnml-use-compressed-files + ".gz"))) + decoded dec file first headers) + (when nnmail-group-names-not-encoded-p + (dolist (ga (prog1 group-art (setq group-art nil))) + (setq group-art (nconc group-art + (list (cons (nnml-encoded-group-name (car ga) + server) + (cdr ga)))) + decoded (nconc decoded (list (car ga))))) + (setq dec decoded)) (nnmail-insert-xref group-art) (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnml-prepare-save-mail-hook) @@ -636,43 +718,50 @@ (replace-match "X-From-Line: ") (forward-line 1)) ;; We save the article in all the groups it belongs in. - (let ((ga group-art) - first) - (while ga - (nnml-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nnml-directory) - (int-to-string (cdar ga)) - extension))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (nnmail-write-region (point-min) (point-max) file nil - (if (nnheader-be-verbose 5) nil 'nomesg)) - (setq first file))) - (setq ga (cdr ga)))) + (dolist (ga group-art) + (if nnmail-group-names-not-encoded-p + (progn + (nnml-possibly-create-directory (car decoded) server) + (setq file (nnmail-group-pathname + (pop decoded) nnml-directory + (concat (number-to-string (cdr ga)) extension)))) + (nnml-possibly-create-directory (car ga) server) + (setq file (nnml-group-pathname + (car ga) (concat (number-to-string (cdr ga)) extension) + server))) + (if first + ;; It was already saved, so we just make a hard link. + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (funcall nnmail-crosspost-link-function first file t)) + ;; Save the article. + (nnmail-write-region (point-min) (point-max) file nil + (if (nnheader-be-verbose 5) nil 'nomesg)) + (setq first file))) ;; Generate a nov line for this article. We generate the nov ;; line after saving, because nov generation destroys the ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. - (let ((ga group-art)) - (while ga - (nnml-add-nov (caar ga) (cdar ga) headers) - (setq ga (cdr ga)))) - group-art)) + (if nnmail-group-names-not-encoded-p + (dolist (ga group-art) + (nnml-add-nov (pop dec) (cdr ga) headers)) + (dolist (ga group-art) + (nnml-add-nov (car ga) (cdr ga) headers)))) + group-art) -(defun nnml-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nnml-group-alist)))) +(defun nnml-active-number (group &optional server) + "Compute the next article number in GROUP on SERVER." + (let ((active (cadr (assoc (if nnmail-group-names-not-encoded-p + (nnml-encoded-group-name group server) + group) + nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (unless active ;; Perhaps the active file was corrupt? See whether ;; there are any articles in this group. - (nnml-possibly-create-directory group) - (nnml-possibly-change-directory group) + (nnml-possibly-create-directory group server) + (nnml-possibly-change-directory group server) (unless nnml-article-file-alist (setq nnml-article-file-alist (sort @@ -686,8 +775,7 @@ (push (list group active) nnml-group-alist)) (setcdr active (1+ (cdr active))) (while (file-exists-p - (expand-file-name (int-to-string (cdr active)) - (nnmail-group-pathname group nnml-directory))) + (nnml-group-pathname group (int-to-string (cdr active)) server)) (setcdr active (1+ (cdr active)))) (cdr active))) @@ -700,7 +788,7 @@ (nnheader-insert-nov headers))) (defsubst nnml-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) + (buffer-substring (match-end 0) (point-at-eol))) (defun nnml-parse-head (chars &optional number) "Parse the head of the current buffer." @@ -718,13 +806,13 @@ headers)))) (defun nnml-get-nov-buffer (group) - (let ((buffer (get-buffer-create (format " *nnml overview %s*" group)))) + (let* ((decoded (nnml-decoded-group-name group)) + (buffer (get-buffer-create (format " *nnml overview %s*" decoded))) + (file-name-coding-system nnmail-pathname-coding-system)) (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) - (expand-file-name - nnml-nov-file-name - (nnmail-group-pathname group nnml-directory))) + (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name)) (erase-buffer) (when (file-exists-p nnml-nov-buffer-file-name) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) @@ -759,53 +847,57 @@ (nnml-open-server server)) (setq nnml-directory (expand-file-name nnml-directory)) ;; Recurse down the directories. - (nnml-generate-nov-databases-1 nnml-directory nil t) + (nnml-generate-nov-databases-directory nnml-directory nil t) ;; Save the active file. (nnmail-save-active nnml-group-alist nnml-active-file)) -(defun nnml-generate-nov-databases-1 (dir &optional seen no-active) - "Regenerate the NOV database in DIR." - (interactive "DRegenerate NOV in: ") +(defun nnml-generate-nov-databases-directory (dir &optional seen no-active) + "Regenerate the NOV database in DIR. + +Unless no-active is non-nil, update the active file too." + (interactive (list (let ((file-name-coding-system + nnmail-pathname-coding-system)) + (read-directory-name "Regenerate NOV in: " + nnml-directory nil t)))) (setq dir (file-name-as-directory dir)) - ;; Only scan this sub-tree if we haven't been here yet. - (unless (member (file-truename dir) seen) - (push (file-truename dir) seen) - ;; We descend recursively - (let ((dirs (directory-files dir t nil t)) - dir) - (while (setq dir (pop dirs)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + ;; Only scan this sub-tree if we haven't been here yet. + (unless (member (file-truename dir) seen) + (push (file-truename dir) seen) + ;; We descend recursively + (dolist (dir (directory-files dir t nil t)) (when (and (not (string-match "^\\." (file-name-nondirectory dir))) (file-directory-p dir)) - (nnml-generate-nov-databases-1 dir seen)))) - ;; Do this directory. - (let ((files (sort (nnheader-article-to-file-alist dir) - 'car-less-than-car))) - (if (not files) - (let* ((group (nnheader-file-to-group - (directory-file-name dir) nnml-directory)) - (info (cadr (assoc group nnml-group-alist)))) - (when info - (setcar info (1+ (cdr info))))) - (funcall nnml-generate-active-function dir) - ;; Generate the nov file. - (nnml-generate-nov-file dir files) - (unless no-active - (nnmail-save-active nnml-group-alist nnml-active-file)))))) + (nnml-generate-nov-databases-directory dir seen))) + ;; Do this directory. + (let ((files (sort (nnheader-article-to-file-alist dir) + 'car-less-than-car))) + (if (not files) + (let* ((group (nnheader-file-to-group + (directory-file-name dir) nnml-directory)) + (info (cadr (assoc group nnml-group-alist)))) + (when info + (setcar info (1+ (cdr info))))) + (funcall nnml-generate-active-function dir) + ;; Generate the nov file. + (nnml-generate-nov-file dir files) + (unless no-active + (nnmail-save-active nnml-group-alist nnml-active-file))))))) (eval-when-compile (defvar files)) (defun nnml-generate-active-info (dir) ;; Update the active info for this group. - (let* ((group (nnheader-file-to-group - (directory-file-name dir) nnml-directory)) - (entry (assoc group nnml-group-alist)) - (last (or (caadr entry) 0))) - (setq nnml-group-alist (delq entry nnml-group-alist)) + (let ((group (directory-file-name dir)) + entry last) + (setq group (nnheader-file-to-group (nnml-encoded-group-name group) + nnml-directory) + entry (assoc group nnml-group-alist) + last (or (caadr entry) 0) + nnml-group-alist (delq entry nnml-group-alist)) (push (list group (cons (or (caar files) (1+ last)) (max last - (or (let ((f files)) - (while (cdr f) (setq f (cdr f))) - (caar f)) + (or (caar (last files)) 0)))) nnml-group-alist))) @@ -938,20 +1030,20 @@ (deffoo nnml-request-update-info (group info &optional server) (nnml-possibly-change-directory group server) - (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group)) + (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'. - (mapcar (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) + (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)) @@ -961,9 +1053,8 @@ (nnheader-message 8 "Updating marks for %s...done" group)) info) -(defun nnml-marks-changed-p (group) - (let ((file (expand-file-name nnml-marks-file-name - (nnmail-group-pathname group nnml-directory)))) +(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) @@ -971,11 +1062,10 @@ (defun nnml-save-marks (group server) (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (expand-file-name nnml-marks-file-name - (nnmail-group-pathname group nnml-directory)))) + (file (nnml-group-pathname group nnml-marks-file-name server))) (condition-case err (progn - (nnml-possibly-create-directory group) + (nnml-possibly-create-directory group server) (with-temp-file file (erase-buffer) (gnus-prin1 nnml-marks) @@ -988,9 +1078,10 @@ (error "Cannot write to %s (%s)" file err)))))) (defun nnml-open-marks (group server) - (let ((file (expand-file-name - nnml-marks-file-name - (nnmail-group-pathname group nnml-directory)))) + (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 @@ -1008,14 +1099,211 @@ (let ((info (gnus-get-info (gnus-group-prefixed-name group - (gnus-server-to-method (format "nnml:%s" server)))))) - (nnheader-message 7 "Bootstrapping marks for %s..." 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" group))))) + (nnheader-message 7 "Bootstrapping marks for %s...done" decoded))))) + + +;;; +;;; Group and server compaction. -- dvl +;;; + +;; #### FIXME: this function handles self Xref: entry correctly, but I don't +;; #### know how to handle external cross-references. I actually don't know if +;; #### this is handled correctly elsewhere. For instance, what happens if you +;; #### move all articles to a new group (that's what people do for manual +;; #### compaction) ? + +;; #### NOTE: the function below handles the article backlog. This is +;; #### conceptually the wrong place to do it because the backend is at a +;; #### lower level. However, this is the only place where we have the needed +;; #### information to do the job. Ideally, this function should not handle +;; #### the backlog by itself, but return a list of moved groups / articles to +;; #### the caller. This will become important to avoid code duplication when +;; #### other backends get a compaction feature. Also, note that invalidating +;; #### the "original article buffer" is already done at an upper level. + +;; Shouldn't `nnml-request-compact-group' be interactive? --rsteib + +(defun nnml-request-compact-group (group &optional server save) + (nnml-possibly-change-directory group server) + (unless nnml-article-file-alist + (setq nnml-article-file-alist + (sort (nnml-current-group-article-to-file-alist) + 'car-less-than-car))) + (if (not nnml-article-file-alist) + ;; The group is empty: do nothing but return t + t + ;; The group is not empty: + (let* ((group-full-name + (gnus-group-prefixed-name + group + (gnus-server-to-method (format "nnml:%s" server)))) + (info (gnus-get-info group-full-name)) + (new-number 1) + compacted) + (let ((articles nnml-article-file-alist) + article) + (while (setq article (pop articles)) + (let ((old-number (car article))) + (when (> old-number new-number) + ;; There is a gap here: + (let ((old-number-string (int-to-string old-number)) + (new-number-string (int-to-string new-number))) + (setq compacted t) + ;; #### NOTE: `nnml-article-to-file' calls + ;; #### `nnml-update-file-alist' (which in turn calls + ;; #### `nnml-current-group-article-to-file-alist', which + ;; #### might use the NOV database). This might turn out to be + ;; #### inefficient. In that case, we will do the work + ;; #### manually. + ;; 1/ Move the article to a new file: + (let* ((oldfile (nnml-article-to-file old-number)) + (newfile + (gnus-replace-in-string + oldfile + ;; nnml-use-compressed-files might be any string, but + ;; probably it's sufficient to take into account only + ;; "\\.[a-z0-9]+". Note that we can't only use the + ;; value of nnml-use-compressed-files because old + ;; articles might have been saved with a different + ;; value. + (concat + "\\(" old-number-string "\\)\\(\\(\\.[a-z0-9]+\\)?\\)$") + (concat new-number-string "\\2")))) + (with-current-buffer nntp-server-buffer + (nnmail-find-file oldfile) + ;; Update the Xref header in the article itself: + (when (and (re-search-forward "^Xref: [^ ]+ " nil t) + (re-search-forward + (concat "\\<" + (regexp-quote + (concat group ":" old-number-string)) + "\\>") + (point-at-eol) t)) + (replace-match + (concat group ":" new-number-string))) + ;; Save to the new file: + (nnmail-write-region (point-min) (point-max) newfile)) + (funcall nnmail-delete-file-function oldfile)) + ;; 2/ Update all marks for this article: + ;; #### NOTE: it is possible that the new article number + ;; #### already belongs to a range, whereas the corresponding + ;; #### article doesn't exist (for example, if you delete an + ;; #### article). For that reason, it is important to update + ;; #### the ranges (meaning remove inexistant articles) before + ;; #### doing anything on them. + ;; 2 a/ read articles: + (let ((read (gnus-info-read info))) + (setq read (gnus-remove-from-range read (list new-number))) + (when (gnus-member-of-range old-number read) + (setq read (gnus-remove-from-range read (list old-number))) + (setq read (gnus-add-to-range read (list new-number)))) + (gnus-info-set-read info read)) + ;; 2 b/ marked articles: + (let ((oldmarks (gnus-info-marks info)) + mark newmarks) + (while (setq mark (pop oldmarks)) + (setcdr mark (gnus-remove-from-range (cdr mark) + (list new-number))) + (when (gnus-member-of-range old-number (cdr mark)) + (setcdr mark (gnus-remove-from-range (cdr mark) + (list old-number))) + (setcdr mark (gnus-add-to-range (cdr mark) + (list new-number)))) + (push mark newmarks)) + (gnus-info-set-marks info newmarks)) + ;; 3/ Update the NOV entry for this article: + (unless nnml-nov-is-evil + (save-excursion + (set-buffer (nnml-open-nov group)) + (when (nnheader-find-nov-line old-number) + ;; Replace the article number: + (looking-at old-number-string) + (replace-match new-number-string nil t) + ;; Update the Xref header: + (when (re-search-forward + (concat "\\(Xref:[^\t\n]* \\)\\<" + (regexp-quote + (concat group ":" old-number-string)) + "\\>") + (point-at-eol) t) + (replace-match + (concat "\\1" group ":" new-number-string)))))) + ;; 4/ Possibly remove the article from the backlog: + (when gnus-keep-backlog + ;; #### NOTE: instead of removing the article, we could + ;; #### modify the backlog to reflect the numbering change, + ;; #### but I don't think it's worth it. + (gnus-backlog-remove-article group-full-name old-number) + (gnus-backlog-remove-article group-full-name new-number)))) + (setq new-number (1+ new-number))))) + (if (not compacted) + ;; No compaction had to be done: + t + ;; Some articles have actually been renamed: + ;; 1/ Rebuild active information: + (let ((entry (assoc group nnml-group-alist)) + (active (cons 1 (1- new-number)))) + (setq nnml-group-alist (delq entry nnml-group-alist)) + (push (list group active) nnml-group-alist) + ;; Update the active hashtable to let the *Group* buffer display + ;; up-to-date lines. I don't think that either gnus-newsrc-hashtb or + ;; gnus-newwrc-alist are out of date, since all we did is to modify + ;; the info of the group internally. + (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: + (if (not save) + ;; Nothing to save (yet): + t + ;; Something to save: + ;; a/ Save the NOV databases: + ;; #### NOTE: this should be done directory per directory in 1bis + ;; #### above. See comment there. + (nnml-save-nov) + ;; b/ Save the active file: + (nnmail-save-active nnml-group-alist nnml-active-file) + t))))) + +(defun nnml-request-compact (&optional server) + "Request compaction of all SERVER nnml groups." + (interactive (list (or (nnoo-current-server 'nnml) ""))) + (nnmail-activate 'nnml) + (unless (nnml-server-opened server) + (nnml-open-server server)) + (setq nnml-directory (expand-file-name nnml-directory)) + (let* ((groups (gnus-groups-from-server + (gnus-server-to-method (format "nnml:%s" server)))) + (first (pop groups)) + group) + (when first + (while (setq group (pop groups)) + (nnml-request-compact-group (gnus-group-real-name group) server)) + (nnml-request-compact-group (gnus-group-real-name first) server t)))) + (provide 'nnml) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnnil.el --- a/lisp/gnus/nnnil.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnnil.el Sun Oct 28 09:18:39 2007 +0000 @@ -32,8 +32,7 @@ (defvar nnnil-status-string "") (defun nnnil-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer)) 'nov) @@ -69,8 +68,7 @@ t) (defun nnnil-request-list (&optional server) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer)) t) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnrss.el --- a/lisp/gnus/nnrss.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnrss.el Sun Oct 28 09:18:39 2007 +0000 @@ -50,6 +50,15 @@ (defvoo nnrss-directory (nnheader-concat gnus-directory "rss/") "Where nnrss will save its files.") +(defvoo nnrss-ignore-article-fields '(slash:comments) + "*List of fields that should be ignored when comparing RSS articles. +Some RSS feeds update article fields during their lives, e.g. to +indicate the number of comments or the number of times the +articles have been seen. However, if there is a difference +between the local article and the distant one, the latter is +considered to be new. To avoid this and discard some fields, set +this variable to the list of fields to be ignored.") + ;; (group max rss-url) (defvoo nnrss-server-data nil) @@ -58,7 +67,7 @@ (defvoo nnrss-group-max 0) (defvoo nnrss-group-min 1) (defvoo nnrss-group nil) -(defvoo nnrss-group-hashtb nil) +(defvoo nnrss-group-hashtb (make-hash-table :test 'equal)) (defvoo nnrss-status-string "") (defconst nnrss-version "nnrss 1.0") @@ -83,7 +92,13 @@ ARTICLE is the article number of the current headline.") (defvar nnrss-file-coding-system mm-universal-coding-system - "Coding system used when reading and writing files.") + "*Coding system used when reading and writing files. +If you run Gnus with various versions of Emacsen, the value of this +variable should be the coding system that all those Emacsen support. +Note that you have to regenerate all the nnrss groups if you change +the value. Moreover, you should be patient even if you are made to +read the same articles twice, that arises for the difference of the +versions of xml.el.") (defvar nnrss-compatible-encoding-alist (delq nil (mapcar (lambda (elem) @@ -365,7 +380,8 @@ (delq (assoc group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors - (delete-file (nnrss-make-filename group server))) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + (delete-file (nnrss-make-filename group server)))) t) (deffoo nnrss-request-list-newsgroups (&optional server) @@ -391,10 +407,10 @@ otherwise return nil." (goto-char (point-min)) (if (re-search-forward - "<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" + "<\\?[^>]*encoding=\\(?:\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)" nil t) - (let ((encoding (intern (downcase (or (match-string 2) - (match-string 3)))))) + (let ((encoding (intern (downcase (or (match-string 1) + (match-string 2)))))) (or (mm-coding-system-p (cdr (assq encoding nnrss-compatible-encoding-alist))) @@ -462,8 +478,7 @@ (defun nnrss-generate-active () (when (y-or-n-p "Fetch extra categories? ") - (dolist (func nnrss-extra-categories) - (funcall func))) + (mapc 'funcall nnrss-extra-categories)) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) @@ -500,37 +515,37 @@ (concat ;; 1. year "\\(199[0-9]\\|20[0-9][0-9]\\)" - "\\(-" - ;; 3. month + "\\(?:-" + ;; 2. month "\\([01][0-9]\\)" - "\\(-" - ;; 5. day + "\\(?:-" + ;; 3. day "\\([0-3][0-9]\\)" - "\\)?\\)?\\(T" - ;; 7. hh:mm + "\\)?\\)?\\(?:T" + ;; 4. hh:mm "\\([012][0-9]:[0-5][0-9]\\)" - "\\(" - ;; 9. :ss + "\\(?:" + ;; 5. :ss "\\(:[0-5][0-9]\\)" - "\\(\\.[0-9]+\\)?\\)?\\)?" - ;; 13+14,15,16. zone - "\\(\\(\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)" + "\\(?:\\.[0-9]+\\)?\\)?\\)?" + ;; 6+7,8,9. zone + "\\(?:\\(?:\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)" "\\|\\([+-][012][0-9][0-5][0-9]\\)" "\\|\\(Z\\)\\)?")) date) (setq year (string-to-number (match-string 1 date)) - month (string-to-number (or (match-string 3 date) "1")) - day (string-to-number (or (match-string 5 date) "1")) - time (if (match-beginning 9) - (substring date (match-beginning 7) (match-end 9)) - (concat (or (match-string 7 date) "00:00") ":00")) - zone (cond ((match-beginning 13) - (concat (match-string 13 date) - (match-string 14 date))) - ((match-beginning 16) ;; Z + month (string-to-number (or (match-string 2 date) "1")) + day (string-to-number (or (match-string 3 date) "1")) + time (if (match-beginning 5) + (substring date (match-beginning 4) (match-end 5)) + (concat (or (match-string 4 date) "00:00") ":00")) + zone (cond ((match-beginning 6) + (concat (match-string 6 date) + (match-string 7 date))) + ((match-beginning 9) ;; Z "+0000") (t ;; nil if zone is not provided. - (match-string 15 date)))))) + (match-string 8 date)))))) (if month (progn (setq cts (current-time-string (encode-time 0 0 0 day month year))) @@ -545,13 +560,13 @@ (defun nnrss-read-server-data (server) (setq nnrss-server-data nil) - (let ((file (nnrss-make-filename "nnrss" server))) + (let ((file (nnrss-make-filename "nnrss" server)) + (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p file) ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII ;; file names. So, we use `insert-file-contents' instead. (mm-with-multibyte-buffer - (let ((coding-system-for-read nnrss-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) + (let ((coding-system-for-read nnrss-file-coding-system)) (insert-file-contents file) (eval-region (point-min) (point-max))))))) @@ -568,21 +583,23 @@ (defun nnrss-read-group-data (group server) (setq nnrss-group-data nil) - (setq nnrss-group-hashtb (gnus-make-hashtable)) + (if (hash-table-p nnrss-group-hashtb) + (clrhash nnrss-group-hashtb) + (setq nnrss-group-hashtb (make-hash-table :test 'equal))) (let ((pair (assoc group nnrss-server-data))) (setq nnrss-group-max (or (cadr pair) 0)) (setq nnrss-group-min (+ nnrss-group-max 1))) - (let ((file (nnrss-make-filename group server))) + (let ((file (nnrss-make-filename group server)) + (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p file) ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII ;; file names. So, we use `insert-file-contents' instead. (mm-with-multibyte-buffer - (let ((coding-system-for-read nnrss-file-coding-system) - (file-name-coding-system nnmail-pathname-coding-system)) + (let ((coding-system-for-read nnrss-file-coding-system)) (insert-file-contents file) (eval-region (point-min) (point-max)))) (dolist (e nnrss-group-data) - (gnus-sethash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb) + (puthash (nth 9 e) t nnrss-group-hashtb) (when (and (car e) (> nnrss-group-min (car e))) (setq nnrss-group-min (car e))) (when (and (car e) (< nnrss-group-max (car e))) @@ -662,9 +679,20 @@ ;;; Snarf functions +(defun nnrss-make-hash-index (item) + (setq item (gnus-remove-if + (lambda (field) + (when (listp field) + (memq (car field) nnrss-ignore-article-fields))) + item)) + (md5 (gnus-prin1-to-string item) + nil nil + nnrss-file-coding-system)) + (defun nnrss-check-group (group server) (let (file xml subject url extra changed author date feed-subject - enclosure comments rss-ns rdf-ns content-ns dc-ns) + enclosure comments rss-ns rdf-ns content-ns dc-ns + hash-index) (if (and nnrss-use-local (file-exists-p (setq file (expand-file-name (nnrss-translate-file-chars @@ -696,15 +724,12 @@ (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) (when (and (listp item) (string= (concat rss-ns "item") (car item)) - (if (setq url (nnrss-decode-entities-string - (nnrss-node-text rss-ns 'link (cddr item)))) - (not (gnus-gethash url nnrss-group-hashtb)) - (setq extra (or (nnrss-node-text content-ns 'encoded item) - (nnrss-node-text rss-ns 'description item))) - (not (gnus-gethash extra nnrss-group-hashtb)))) + (progn (setq hash-index (nnrss-make-hash-index item)) + (not (gethash hash-index nnrss-group-hashtb)))) (setq subject (nnrss-node-text rss-ns 'title item)) - (setq extra (or extra - (nnrss-node-text content-ns 'encoded item) + (setq url (nnrss-decode-entities-string + (nnrss-node-text rss-ns 'link (cddr item)))) + (setq extra (or (nnrss-node-text content-ns 'encoded item) (nnrss-node-text rss-ns 'description item))) (if (setq feed-subject (nnrss-node-text dc-ns 'subject item)) (setq extra (concat feed-subject "

    " extra))) @@ -746,9 +771,10 @@ date (and extra (nnrss-decode-entities-string extra)) enclosure - comments) + comments + hash-index) nnrss-group-data) - (gnus-sethash (or url extra) t nnrss-group-hashtb) + (puthash hash-index t nnrss-group-hashtb) (setq changed t)) (setq extra nil)) (when changed @@ -947,7 +973,7 @@ (let (rss-onsite-end rdf-onsite-end xml-onsite-end rss-onsite-in rdf-onsite-in xml-onsite-in rss-offsite-end rdf-offsite-end xml-offsite-end - rss-offsite-in rdf-offsite-in xml-offsite-in) + rss-offsite-in rdf-offsite-in xml-offsite-in) (dolist (href hrefs) (cond ((null href)) ((string-match "\\.rss$" href) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnslashdot.el --- a/lisp/gnus/nnslashdot.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnslashdot.el Sun Oct 28 09:18:39 2007 +0000 @@ -459,11 +459,9 @@ (insert-file-contents file) (goto-char (point-min)) (setq nnslashdot-groups (read (current-buffer)))) - (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) - (let ((groups nnslashdot-groups)) - (while groups - (nnslashdot-make-tuple (car groups) 5) - (setq groups (cdr groups)))))))) + (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) + (dolist (group nnslashdot-groups) + (nnslashdot-make-tuple group 5)))))) (defun nnslashdot-write-groups () (with-temp-file (expand-file-name "groups" nnslashdot-directory) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnsoup.el --- a/lisp/gnus/nnsoup.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnsoup.el Sun Oct 28 09:18:39 2007 +0000 @@ -371,9 +371,7 @@ entry e min max) (while (setq e (cdr (setq entry (pop alist)))) (setq min (caaar e)) - (while (cdr e) - (setq e (cdr e))) - (setq max (cdar (car e))) + (setq max (cdar (car (last e)))) (setcdr entry (cons (cons min max) (cdr entry))))) (setq nnsoup-group-alist-touched t)) nnsoup-group-alist)) @@ -558,9 +556,8 @@ (defun nnsoup-unpack-packets () "Unpack all packets in `nnsoup-packet-directory'." (let ((packets (directory-files - nnsoup-packet-directory t nnsoup-packet-regexp)) - packet) - (while (setq packet (pop packets)) + nnsoup-packet-directory t nnsoup-packet-regexp))) + (dolist (packet packets) (nnheader-message 5 "nnsoup: unpacking %s..." packet) (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) @@ -759,20 +756,18 @@ (string-to-number (match-string 1 f2))))))) active group lines ident elem min) (set-buffer (get-buffer-create " *nnsoup work*")) - (while files - (nnheader-message 5 "Doing %s..." (car files)) + (dolist (file files) + (nnheader-message 5 "Doing %s..." file) (erase-buffer) - (nnheader-insert-file-contents (car files)) + (nnheader-insert-file-contents file) (goto-char (point-min)) (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) (setq group "unknown") (setq group (match-string 2))) (setq lines (count-lines (point-min) (point-max))) (setq ident (progn (string-match - "/\\([0-9]+\\)\\." (car files)) - (substring - (car files) (match-beginning 1) - (match-end 1)))) + "/\\([0-9]+\\)\\." file) + (match-string 1 file))) (if (not (setq elem (assoc group active))) (push (list group (cons 1 lines) (list (cons 1 lines) @@ -783,8 +778,7 @@ (list (cons (1+ (setq min (cdadr elem))) (+ min lines)) (vector ident group "ucm" "" lines)))) - (setcdr (cadr elem) (+ min lines))) - (setq files (cdr files))) + (setcdr (cadr elem) (+ min lines)))) (nnheader-message 5 "") (setq nnsoup-group-alist active) (nnsoup-write-active-file t))) @@ -801,9 +795,9 @@ nnsoup-group-alist))) (regexp "\\.MSG$\\|\\.IDX$") (files (directory-files nnsoup-directory nil regexp)) - non-files file) + non-files) ;; Find all files that aren't known by nnsoup. - (while (setq file (pop files)) + (dolist (file files) (string-match regexp file) (unless (member (substring file 0 (match-beginning 0)) known) (push file non-files))) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnspool.el --- a/lisp/gnus/nnspool.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnspool.el Sun Oct 28 09:18:39 2007 +0000 @@ -246,13 +246,11 @@ ;; Yes, completely empty spool directories *are* possible. ;; Fix by Sudish Joseph (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) - (setq dir - (sort (mapcar (lambda (name) (string-to-number name)) dir) '<))) + (setq dir (sort (mapcar 'string-to-number dir) '<))) (if dir (nnheader-insert "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group) + (car (last dir)) group) (nnheader-report 'nnspool "Empty group %s" group) (nnheader-insert "211 0 0 0 %s\n" group)))))) @@ -311,9 +309,8 @@ groups) (zerop (forward-line -1)))) (erase-buffer) - (while groups - (insert (car groups) " 0 0 y\n") - (setq groups (cdr groups)))) + (dolist (group groups) + (insert group " 0 0 y\n"))) t) nil)) @@ -400,8 +397,7 @@ (<= last (car arts))) (pop arts)) ;; The articles in `arts' are missing from the buffer. - (while arts - (nnspool-insert-nov-head (pop arts))) + (mapc 'nnspool-insert-nov-head arts) t)))))))))) (defun nnspool-insert-nov-head (article) @@ -421,8 +417,7 @@ (defun nnspool-sift-nov-with-sed (articles file) (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles)))) + (last (car (last articles)))) (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) @@ -431,16 +426,12 @@ ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. (defun nnspool-find-id (id) - (save-excursion - (set-buffer (get-buffer-create " *nnspool work*")) - (erase-buffer) + (with-temp-buffer (ignore-errors (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) (goto-char (point-min)) - (prog1 - (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-number (match-string 2)))) - (kill-buffer (current-buffer))))) + (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") + (cons (match-string 1) (string-to-number (match-string 2)))))) (defun nnspool-find-file (file) "Insert FILE in server buffer safely." diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nntp.el --- a/lisp/gnus/nntp.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nntp.el Sun Oct 28 09:18:39 2007 +0000 @@ -31,6 +31,8 @@ (require 'nnheader) (require 'nnoo) (require 'gnus-util) +(require 'gnus) +(require 'gnus-group) ;; gnus-group-name-charset (nnoo-declare nntp) @@ -86,6 +88,7 @@ Indirect connections: - `nntp-open-via-rlogin-and-telnet', +- `nntp-open-via-rlogin-and-netcat', - `nntp-open-via-telnet-and-telnet'.") (defvoo nntp-never-echoes-commands nil @@ -109,20 +112,22 @@ (defvoo nntp-telnet-command "telnet" "*Telnet command used to connect to the nntp server. -This command is used by the various nntp-open-via-* methods.") +This command is used by the methods `nntp-open-telnet-stream', +`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.") (defvoo nntp-telnet-switches '("-8") "*Switches given to the telnet command `nntp-telnet-command'.") (defvoo nntp-end-of-line "\r\n" "*String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when -using an indirect connection method (nntp-open-via-*).") +This is \"\\r\\n\" by default, but should be \"\\n\" when using an indirect +connection method (nntp-open-via-*).") (defvoo nntp-via-rlogin-command "rsh" "*Rlogin command used to connect to an intermediate host. -This command is used by the `nntp-open-via-rlogin-and-telnet' method. -The default is \"rsh\", but \"ssh\" is a popular alternative.") +This command is used by the methods `nntp-open-via-rlogin-and-telnet' +and `nntp-open-via-rlogin-and-netcat'. The default is \"rsh\", but \"ssh\" +is a popular alternative.") (defvoo nntp-via-rlogin-command-switches nil "*Switches given to the rlogin command `nntp-via-rlogin-command'. @@ -138,9 +143,16 @@ (defvoo nntp-via-telnet-switches '("-8") "*Switches given to the telnet command `nntp-via-telnet-command'.") +(defvoo nntp-via-netcat-command "nc" + "*Netcat command used to connect to the nntp server. +This command is used by the `nntp-open-via-rlogin-and-netcat' method.") + +(defvoo nntp-via-netcat-switches nil + "*Switches given to the netcat command `nntp-via-netcat-command'.") + (defvoo nntp-via-user-name nil "*User name to log in on an intermediate host with. -This variable is used by the `nntp-open-via-telnet-and-telnet' method.") +This variable is used by the various nntp-open-via-* methods.") (defvoo nntp-via-user-password nil "*Password to use to log in on an intermediate host with. @@ -148,8 +160,7 @@ (defvoo nntp-via-address nil "*Address of an intermediate host to connect to. -This variable is used by the `nntp-open-via-rlogin-and-telnet' and -`nntp-open-via-telnet-and-telnet' methods.") +This variable is used by the various nntp-open-via-* methods.") (defvoo nntp-via-envuser nil "*Whether both telnet client and server support the ENVIRON option. @@ -206,6 +217,21 @@ (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 @@ -252,6 +278,7 @@ (defvoo nntp-last-command nil) (defvoo nntp-authinfo-password nil) (defvoo nntp-authinfo-user nil) +(defvoo nntp-authinfo-force nil) (defvar nntp-connection-list nil) @@ -339,14 +366,16 @@ (defsubst nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." + (save-excursion (set-buffer (process-buffer process)) (goto-char (point-min)) + (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) (looking-at "48[02]")) (memq (process-status process) '(open run))) (cond ((looking-at "480") - (nntp-handle-authinfo process)) + (nntp-handle-authinfo process)) ((looking-at "482") (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message)) (signal 'nntp-authinfo-rejected nil)) @@ -394,6 +423,11 @@ (kill-buffer buffer) (nnheader-init-server-buffer))) +(defun nntp-erase-buffer (buffer) + "Erase contents of BUFFER." + (with-current-buffer buffer + (erase-buffer))) + (defsubst nntp-find-connection (buffer) "Find the connection delivering to BUFFER." (let ((alist nntp-connection-alist) @@ -428,9 +462,7 @@ (if process (progn (unless (or nntp-inhibit-erase nnheader-callback-function) - (save-excursion - (set-buffer (process-buffer process)) - (erase-buffer))) + (nntp-erase-buffer (process-buffer process))) (condition-case err (progn (when command @@ -459,9 +491,7 @@ "Send STRINGS to server and wait until WAIT-FOR returns." (when (and (not nnheader-callback-function) (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) + (nntp-erase-buffer nntp-server-buffer)) (let* ((command (mapconcat 'identity strings " ")) (process (nntp-find-connection nntp-server-buffer)) (buffer (and process (process-buffer process))) @@ -488,8 +518,7 @@ (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (gnus-point-at-bol)))) - ))) + (point-at-bol))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -513,7 +542,7 @@ (goto-char pos) (if (looking-at (regexp-quote command)) (delete-region pos (progn (forward-line 1) - (gnus-point-at-bol))))))) + (point-at-bol))))))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -521,9 +550,7 @@ "Send STRINGS to server and wait until WAIT-FOR returns." (when (and (not nnheader-callback-function) (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) + (nntp-erase-buffer nntp-server-buffer)) (let* ((command (mapconcat 'identity strings " ")) (process (nntp-find-connection nntp-server-buffer)) (buffer (and process (process-buffer process))) @@ -538,11 +565,11 @@ (unless wait-for (nntp-accept-response) (save-excursion - (set-buffer buffer) - (goto-char pos) - (if (looking-at (regexp-quote command)) - (delete-region pos (progn (forward-line 1) (gnus-point-at-bol)))) - ))) + (set-buffer buffer) + (goto-char pos) + (if (looking-at (regexp-quote command)) + (delete-region pos (progn (forward-line 1) (point-at-bol)))) + ))) (nnheader-report 'nntp "Couldn't open connection to %s." nntp-address)))) @@ -551,9 +578,8 @@ "Send the current buffer to server and wait until WAIT-FOR returns." (when (and (not nnheader-callback-function) (not nntp-inhibit-output)) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer))) + (nntp-erase-buffer + (nntp-find-connection-buffer nntp-server-buffer))) (nntp-encode-text) (mm-with-unibyte-current-buffer ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro. @@ -575,7 +601,12 @@ ;; a line with only a "." on it. ((eq (char-after) ?2) (if (re-search-forward "\n\\.\r?\n" nil t) - t + (progn + ;; Some broken news servers add another dot at the end. + ;; Protect against inflooping there. + (while (looking-at "^\\.\r?\n") + (forward-line 1)) + t) nil)) ;; A result that starts with a 3xx or 4xx code is terminated ;; by a newline. @@ -615,7 +646,7 @@ (let ((timer (and nntp-connection-timeout - (nnheader-run-at-time + (run-at-time nntp-connection-timeout nil '(lambda () (let ((process (nntp-find-connection @@ -637,7 +668,8 @@ (condition-case nil (progn ,@forms) (quit - (nntp-close-server) + (unless debug-on-quit + (nntp-close-server)) (signal 'quit nil)))) (when timer (nnheader-cancel-timer timer))) @@ -717,8 +749,7 @@ (catch 'done (save-excursion ;; Erase nntp-server-buffer before nntp-inhibit-erase. - (set-buffer nntp-server-buffer) - (erase-buffer) + (nntp-erase-buffer nntp-server-buffer) (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) ;; The first time this is run, this variable is `try'. So we ;; try. @@ -1046,6 +1077,54 @@ (deffoo nntp-asynchronous-p () t) +(deffoo nntp-request-set-mark (group actions &optional server) + (unless nntp-marks-is-evil + (nntp-possibly-create-directory group server) + (nntp-open-marks group server) + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (assert (or (eq what 'add) (eq what 'del)) nil + "Unknown request-set-mark action: %s" what) + (dolist (mark marks) + (setq nntp-marks (gnus-update-alist-soft + mark + (funcall (if (eq what 'add) 'gnus-range-add + 'gnus-remove-from-range) + (cdr (assoc mark nntp-marks)) range) + nntp-marks))))) + (nntp-save-marks group server)) + nil) + +(deffoo nntp-request-update-info (group info &optional server) + (unless nntp-marks-is-evil + (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. (defun nntp-send-mode-reader () @@ -1063,11 +1142,11 @@ If SEND-IF-FORCE, only send authinfo to the server if the .authinfo file has the FORCE token." - (let* ((list (gnus-parse-netrc nntp-authinfo-file)) - (alist (gnus-netrc-machine list nntp-address "nntp")) - (force (gnus-netrc-get alist "force")) - (user (or (gnus-netrc-get alist "login") nntp-authinfo-user)) - (passwd (gnus-netrc-get alist "password"))) + (let* ((list (netrc-parse nntp-authinfo-file)) + (alist (netrc-machine list nntp-address "nntp")) + (force (or (netrc-get alist "force") nntp-authinfo-force)) + (user (or (netrc-get alist "login") nntp-authinfo-user)) + (passwd (netrc-get alist "password"))) (when (or (not send-if-force) force) (unless user @@ -1106,7 +1185,7 @@ (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (gnus-point-at-eol)))))) + (buffer-substring (point) (point-at-eol)))))) ;;; Internal functions. @@ -1116,9 +1195,7 @@ (funcall nntp-authinfo-function) ;; We have to re-send the function that was interrupted by ;; the authinfo request. - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) + (nntp-erase-buffer nntp-server-buffer) (nntp-send-string process last))) (defun nntp-make-process-buffer (buffer) @@ -1144,7 +1221,7 @@ (let* ((pbuffer (nntp-make-process-buffer buffer)) (timer (and nntp-connection-timeout - (nnheader-run-at-time + (run-at-time nntp-connection-timeout nil `(lambda () (nntp-kill-buffer ,pbuffer))))) @@ -1155,7 +1232,7 @@ (funcall nntp-open-connection-function pbuffer)) (error nil) (quit - (message "Quit opening connection") + (message "Quit opening connection to %s" nntp-address) (nntp-kill-buffer pbuffer) (signal 'quit nil) nil)))) @@ -1223,12 +1300,9 @@ "Find out what the name of the server we have connected to is." ;; Wait for the status string to arrive. (setq nntp-server-type (buffer-string)) - (let ((alist nntp-server-action-alist) - (case-fold-search t) - entry) + (let ((case-fold-search t)) ;; Run server-specific commands. - (while alist - (setq entry (pop alist)) + (dolist (entry nntp-server-action-alist) (when (string-match (car entry) nntp-server-type) (if (and (listp (cadr entry)) (not (eq 'lambda (caadr entry)))) @@ -1254,7 +1328,7 @@ ;; doesn't trigger after-change-functions. (unless nntp-async-timer (setq nntp-async-timer - (nnheader-run-at-time 1 1 'nntp-async-timer-handler))) + (run-at-time 1 1 'nntp-async-timer-handler))) (add-to-list 'nntp-async-process-list process)) (defun nntp-async-timer-handler () @@ -1340,22 +1414,22 @@ (defun nntp-accept-process-output (process) "Wait for output from PROCESS and message some dots." - (save-excursion - (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) - nntp-server-buffer)) + (with-current-buffer (or (nntp-find-connection-buffer nntp-server-buffer) + nntp-server-buffer) (let ((len (/ (buffer-size) 1024)) message-log-max) (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) - (nnheader-accept-process-output process) - ;; accept-process-output may update status of process to indicate - ;; that the server has closed the connection. This MUST be - ;; handled here as the buffer restored by the save-excursion may - ;; be the process's former output buffer (i.e. now killed) - (or (and process - (memq (process-status process) '(open run))) - (nntp-report "Server closed connection")))) + (prog1 + (nnheader-accept-process-output process) + ;; accept-process-output may update status of process to indicate + ;; that the server has closed the connection. This MUST be + ;; handled here as the buffer restored by the save-excursion may + ;; be the process's former output buffer (i.e. now killed) + (or (and process + (memq (process-status process) '(open run))) + (nntp-report "Server closed connection"))))) (defun nntp-accept-response () "Wait for output from the process that outputs to BUFFER." @@ -1382,9 +1456,7 @@ (nntp-send-command "^[245].*\n" "GROUP" group) (setcar (cddr entry) group) (erase-buffer) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)))))))) + (nntp-erase-buffer nntp-server-buffer))))))) (defun nntp-decode-text (&optional cr-only) "Decode the text in the current buffer." @@ -1594,10 +1666,8 @@ (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. (when (eq nntp-server-xover 'try) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq nntp-server-xover nil))) + (nntp-erase-buffer nntp-server-buffer) + (setq nntp-server-xover nil)) nntp-server-xover)))) (defun nntp-find-group-and-number (&optional group) @@ -1847,6 +1917,36 @@ (delete-region (point) (point-max))) proc)) +(defun nntp-open-via-rlogin-and-netcat (buffer) + "Open a connection to an nntp server through an intermediate host. +First rlogin to the remote host, and then connect to the real news +server from there using the netcat command. + +Please refer to the following variables to customize the connection: +- `nntp-pre-command', +- `nntp-via-rlogin-command', +- `nntp-via-rlogin-command-switches', +- `nntp-via-user-name', +- `nntp-via-address', +- `nntp-via-netcat-command', +- `nntp-via-netcat-switches', +- `nntp-address', +- `nntp-port-number', +- `nntp-end-of-line'." + (let ((command `(,@(when nntp-pre-command + (list nntp-pre-command)) + ,nntp-via-rlogin-command + ,@(when nntp-via-rlogin-command-switches + nntp-via-rlogin-command-switches) + ,@(when nntp-via-user-name + (list "-l" nntp-via-user-name)) + ,nntp-via-address + ,nntp-via-netcat-command + ,@nntp-via-netcat-switches + ,nntp-address + ,nntp-port-number))) + (apply 'start-process "nntpd" buffer command))) + (defun nntp-open-via-telnet-and-telnet (buffer) "Open a connection to an nntp server through an intermediate host. First telnet the remote host, and then telnet the real news server @@ -1922,6 +2022,96 @@ (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)))) + +(eval-and-compile + (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) ;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnvirtual.el --- a/lisp/gnus/nnvirtual.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnvirtual.el Sun Oct 28 09:18:39 2007 +0000 @@ -339,9 +339,9 @@ (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) (gnus-expert-user t)) ;; Make sure all groups are activated. - (mapcar + (mapc (lambda (g) - (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) + (when (not (numberp (gnus-group-unread g))) (gnus-activate-group g))) nnvirtual-component-groups) (save-excursion @@ -384,14 +384,11 @@ (defun nnvirtual-convert-headers () "Convert HEAD headers into NOV headers." - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (let* ((dependencies (make-vector 100 0)) - (headers (gnus-get-newsgroup-headers dependencies)) - header) + (headers (gnus-get-newsgroup-headers dependencies))) (erase-buffer) - (while (setq header (pop headers)) - (nnheader-insert-nov header))))) + (mapc 'nnheader-insert-nov headers)))) (defun nnvirtual-update-xref-header (group article prefix system-name) @@ -401,7 +398,7 @@ (looking-at "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") (goto-char (match-end 0)) - (unless (search-forward "\t" (gnus-point-at-eol) 'move) + (unless (search-forward "\t" (point-at-eol) 'move) (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. @@ -417,8 +414,8 @@ ;; component server prefix. (save-restriction (narrow-to-region (point) - (or (search-forward "\t" (gnus-point-at-eol) t) - (gnus-point-at-eol))) + (or (search-forward "\t" (point-at-eol) t) + (point-at-eol))) (goto-char (point-min)) (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t) (replace-match "" t t)) @@ -465,7 +462,7 @@ (nnvirtual-partition-sequence (cdr ml))))) (gnus-info-marks (gnus-get-info (nnvirtual-current-group)))))) - mark type groups carticles info entry) + type groups info) ;; Ok, atomically move all of the (un)read info, clear any old ;; marks, and move all of the current marks. This way if someone @@ -474,13 +471,12 @@ ;; move (un)read ;; bind for workaround guns-update-read-articles (let ((gnus-newsgroup-active nil)) - (while (setq entry (pop unreads)) + (dolist (entry unreads) (gnus-update-read-articles (car entry) (cdr entry)))) ;; clear all existing marks on the component groups - (setq groups nnvirtual-component-groups) - (while groups - (when (and (setq info (gnus-get-info (pop groups))) + (dolist (group nnvirtual-component-groups) + (when (and (setq info (gnus-get-info group)) (gnus-info-marks info)) (gnus-info-set-marks info @@ -491,18 +487,17 @@ ;; Ok, currently type-marks is an assq list with keys of a mark type, ;; with data of an assq list with keys of component group names ;; and the articles which correspond to that key/group pair. - (while (setq mark (pop type-marks)) + (dolist (mark type-marks) (setq type (car mark)) (setq groups (cdr mark)) - (while (setq carticles (pop groups)) + (dolist (carticles groups) (gnus-add-marked-articles (car carticles) type (cdr carticles) nil t)))) ;; possibly update the display, it is really slow (when update-p - (setq groups nnvirtual-component-groups) - (while groups - (gnus-group-update-group (pop groups) t)))))) + (dolist (group nnvirtual-component-groups) + (gnus-group-update-group group t)))))) (defun nnvirtual-current-group () @@ -664,8 +659,7 @@ the result." (when (numberp (cdr-safe articles)) (setq articles (list articles))) - (let ((carticles (mapcar (lambda (g) (list g)) - nnvirtual-component-groups)) + (let ((carticles (mapcar 'list nnvirtual-component-groups)) a i j article entry) (while (setq a (pop articles)) (if (atom a) @@ -678,8 +672,8 @@ (setq entry (assoc (car article) carticles)) (setcdr entry (cons (cdr article) (cdr entry)))) (setq i (1+ i)))) - (mapcar (lambda (x) (setcdr x (nreverse (cdr x)))) - carticles) + (mapc (lambda (x) (setcdr x (nreverse (cdr x)))) + carticles) carticles)) @@ -701,29 +695,29 @@ ;; Into all-unreads we put (g unreads). ;; Into all-marks we put (g marks). ;; We also increment cnt and tot here, and compute M (max of sizes). - (mapcar (lambda (g) - (setq active (gnus-activate-group g) - min (car active) - max (cdr active)) - (when (and active (>= max min) (not (zerop max))) - ;; store active information - (push (list g (- max min -1) max) actives) - ;; collect unread/mark info for later - (setq unreads (gnus-list-of-unread-articles g)) - (setq marks (gnus-info-marks (gnus-get-info g))) - (when gnus-use-cache - (push (cons 'cache - (gnus-cache-articles-in-group g)) - marks)) - (push (cons g unreads) all-unreads) - (push (cons g marks) all-marks) - ;; count groups, total #articles, and max size - (setq size (- max min -1)) - (setq cnt (1+ cnt) - tot (+ tot size) - M (max M size)))) - nnvirtual-component-groups) - + (mapc (lambda (g) + (setq active (gnus-activate-group g) + min (car active) + max (cdr active)) + (when (and active (>= max min) (not (zerop max))) + ;; store active information + (push (list g (- max min -1) max) actives) + ;; collect unread/mark info for later + (setq unreads (gnus-list-of-unread-articles g)) + (setq marks (gnus-info-marks (gnus-get-info g))) + (when gnus-use-cache + (push (cons 'cache + (gnus-cache-articles-in-group g)) + marks)) + (push (cons g unreads) all-unreads) + (push (cons g marks) all-marks) + ;; count groups, total #articles, and max size + (setq size (- max min -1)) + (setq cnt (1+ cnt) + tot (+ tot size) + M (max M size)))) + nnvirtual-component-groups) + ;; Number of articles in the virtual group. (setq nnvirtual-mapping-len tot) @@ -785,10 +779,9 @@ ;; Remove any empty marks lists, and store. (setq nnvirtual-mapping-marks nil) - (while marks - (if (cdr (car marks)) - (push (car marks) nnvirtual-mapping-marks)) - (setq marks (cdr marks))) + (dolist (mark marks) + (when (cdr mark) + (push mark nnvirtual-mapping-marks))) ;; We need to convert the unreads to reads. We compress the ;; sequence as we go, otherwise it could be huge. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/nnweb.el --- a/lisp/gnus/nnweb.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/nnweb.el Sun Oct 28 09:18:39 2007 +0000 @@ -523,7 +523,9 @@ "?" (mm-url-encode-www-form-urlencoded `(("query" . ,search) - ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits)))))) + ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits)) + ;;("TOPDOC" . "1000") + )))) (setq buffer-file-name nil) (set-buffer-multibyte t) (mm-decode-coding-region (point-min) (point-max) 'utf-8) @@ -554,7 +556,7 @@ (nth 1 parse) " ")) (insert ">\n") - (mapcar 'nnweb-insert-html (nth 2 parse)) + (mapc 'nnweb-insert-html (nth 2 parse)) (insert "\n"))) (defun nnweb-parse-find (type parse &optional maxdepth) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/ntlm.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/ntlm.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,537 @@ +;;; ntlm.el --- NTLM (NT LanManager) authentication support + +;; Copyright (C) 2001 Taro Kawagishi +;; Author: Taro Kawagishi +;; Keywords: NTLM, SASL +;; Version: 1.00 +;; Created: February 2001 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This library is a direct translation of the Samba release 2.2.0 +;; implementation of Windows NT and LanManager compatible password +;; encryption. +;; +;; Interface functions: +;; +;; ntlm-build-auth-request +;; This will return a binary string, which should be used in the +;; base64 encoded form and it is the caller's responsibility to encode +;; the returned string with base64. +;; +;; ntlm-build-auth-response +;; It is the caller's responsibility to pass a base64 decoded string +;; (which will be a binary string) as the first argument and to +;; encode the returned string with base64. The second argument user +;; should be given in user@domain format. +;; +;; ntlm-get-password-hashes +;; +;; +;; NTLM authentication procedure example: +;; +;; 1. Open a network connection to the Exchange server at the IMAP port (143) +;; 2. Receive an opening message such as: +;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready" +;; 3. Ask for IMAP server capability by sending "NNN capability" +;; 4. Receive a capability message such as: +;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM" +;; 5. Ask for NTLM authentication by sending a string +;; "NNN authenticate ntlm" +;; 6. Receive continuation acknowledgment "+" +;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request +;; 8. Receive NTLM challenge string following acknowledgment "+" +;; 9. Generate response to challenge by 'ntlm-build-auth-response +;; (here two hash function values of the user password are encrypted) +;; 10. Receive authentication completion message such as +;; "NNN OK AUTHENTICATE NTLM completed." + +;;; Code: + +(require 'md4) + +;;; +;;; NTLM authentication interface functions + +(defun ntlm-build-auth-request (user &optional domain) + "Return the NTLM authentication request string for USER and DOMAIN. +USER is a string representing a user name to be authenticated and +DOMAIN is a NT domain. USER can include a NT domain part as in +user@domain where the string after @ is used as the domain if DOMAIN +is not given." + (interactive) + (let ((request-ident (concat "NTLMSSP" (make-string 1 0))) + (request-msgType (concat (make-string 1 1) (make-string 3 0))) + ;0x01 0x00 0x00 0x00 + (request-flags (concat (make-string 1 7) (make-string 1 178) + (make-string 2 0))) + ;0x07 0xb2 0x00 0x00 + lu ld off-d off-u) + (when (string-match "@" user) + (unless domain + (setq domain (substring user (1+ (match-beginning 0))))) + (setq user (substring user 0 (match-beginning 0)))) + ;; set fields offsets within the request struct + (setq lu (length user)) + (setq ld (length domain)) + (setq off-u 32) ;offset to the string 'user + (setq off-d (+ 32 lu)) ;offset to the string 'domain + ;; pack the request struct in a string + (concat request-ident ;8 bytes + request-msgType ;4 bytes + request-flags ;4 bytes + (md4-pack-int16 lu) ;user field, count field + (md4-pack-int16 lu) ;user field, max count field + (md4-pack-int32 (cons 0 off-u)) ;user field, offset field + (md4-pack-int16 ld) ;domain field, count field + (md4-pack-int16 ld) ;domain field, max count field + (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field + user ;bufer field + domain ;bufer field + ))) + +(eval-when-compile + (defmacro ntlm-string-as-unibyte (string) + (if (fboundp 'string-as-unibyte) + `(string-as-unibyte ,string) + string))) + +(defun ntlm-build-auth-response (challenge user password-hashes) + "Return the response string to a challenge string CHALLENGE given by +the NTLM based server for the user USER and the password hash list +PASSWORD-HASHES. NTLM uses two hash values which are represented +by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of + (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))" + (let* ((rchallenge (ntlm-string-as-unibyte challenge)) + ;; get fields within challenge struct + ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes + ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes + (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes + (flags (substring rchallenge 20 24)) ;flags, 4 bytes + (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes + uDomain-len uDomain-offs + ;; response struct and its fields + lmRespData ;lmRespData, 24 bytes + ntRespData ;ntRespData, 24 bytes + domain ;ascii domain string + lu ld off-lm off-nt off-d off-u off-w off-s) + ;; extract domain string from challenge string + (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) + (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) + (setq domain + (ntlm-unicode2ascii (substring challenge + (cdr uDomain-offs) + (+ (cdr uDomain-offs) uDomain-len)) + (/ uDomain-len 2))) + ;; overwrite domain in case user is given in @ format + (when (string-match "@" user) + (setq domain (substring user (1+ (match-beginning 0)))) + (setq user (substring user 0 (match-beginning 0)))) + + ;; generate response data + (setq lmRespData + (ntlm-smb-owf-encrypt (car password-hashes) challengeData)) + (setq ntRespData + (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)) + + ;; get offsets to fields to pack the response struct in a string + (setq lu (length user)) + (setq ld (length domain)) + (setq off-lm 64) ;offset to string 'lmResponse + (setq off-nt (+ 64 24)) ;offset to string 'ntResponse + (setq off-d (+ 64 48)) ;offset to string 'uDomain + (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser + (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks + (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey + ;; pack the response struct in a string + (concat "NTLMSSP\0" ;response ident field, 8 bytes + (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes + + ;; lmResponse field, 8 bytes + ;;AddBytes(response,lmResponse,lmRespData,24); + (md4-pack-int16 24) ;len field + (md4-pack-int16 24) ;maxlen field + (md4-pack-int32 (cons 0 off-lm)) ;field offset + + ;; ntResponse field, 8 bytes + ;;AddBytes(response,ntResponse,ntRespData,24); + (md4-pack-int16 24) ;len field + (md4-pack-int16 24) ;maxlen field + (md4-pack-int32 (cons 0 off-nt)) ;field offset + + ;; uDomain field, 8 bytes + ;;AddUnicodeString(response,uDomain,domain); + ;;AddBytes(response, uDomain, udomain, 2*ld); + (md4-pack-int16 (* 2 ld)) ;len field + (md4-pack-int16 (* 2 ld)) ;maxlen field + (md4-pack-int32 (cons 0 off-d)) ;field offset + + ;; uUser field, 8 bytes + ;;AddUnicodeString(response,uUser,u); + ;;AddBytes(response, uUser, uuser, 2*lu); + (md4-pack-int16 (* 2 lu)) ;len field + (md4-pack-int16 (* 2 lu)) ;maxlen field + (md4-pack-int32 (cons 0 off-u)) ;field offset + + ;; uWks field, 8 bytes + ;;AddUnicodeString(response,uWks,u); + (md4-pack-int16 (* 2 lu)) ;len field + (md4-pack-int16 (* 2 lu)) ;maxlen field + (md4-pack-int32 (cons 0 off-w)) ;field offset + + ;; sessionKey field, 8 bytes + ;;AddString(response,sessionKey,NULL); + (md4-pack-int16 0) ;len field + (md4-pack-int16 0) ;maxlen field + (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset + + ;; flags field, 4 bytes + flags ; + + ;; buffer field + lmRespData ;lmResponse, 24 bytes + ntRespData ;ntResponse, 24 bytes + (ntlm-ascii2unicode domain ;unicode domain string, 2*ld bytes + (length domain)) ; + (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes + (length user)) ; + (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes + (length user)) ; + ))) + +(defun ntlm-get-password-hashes (password) + "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD" + (list (ntlm-smb-passwd-hash password) + (ntlm-md4hash password))) + +(defun ntlm-ascii2unicode (str len) + "Convert an ASCII string into a NT Unicode string, which is +little-endian utf16." + (let ((utf (make-string (* 2 len) 0)) (i 0) val) + (while (and (< i len) + (not (zerop (setq val (aref str i))))) + (aset utf (* 2 i) val) + (aset utf (1+ (* 2 i)) 0) + (setq i (1+ i))) + utf)) + +(defun ntlm-unicode2ascii (str len) + "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN." + (let ((buf (make-string len 0)) (i 0) (j 0)) + (while (< i len) + (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16) + (setq i (1+ i) + j (+ 2 j))) + buf)) + +(defun ntlm-smb-passwd-hash (passwd) + "Return the SMB password hash string of 16 bytes long for the given password +string PASSWD. PASSWD is truncated to 14 bytes if longer." + (let ((len (min (length passwd) 14))) + (ntlm-smb-des-e-p16 + (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd + (make-string (- 15 len) 0))))) + +(defun ntlm-smb-owf-encrypt (passwd c8) + "Return the response string of 24 bytes long for the given password +string PASSWD based on the DES encryption. PASSWD is of at most 14 +bytes long and the challenge string C8 of 8 bytes long." + (let ((len (min (length passwd) 16)) p22) + (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd + (make-string (- 22 len) 0))) + (ntlm-smb-des-e-p24 p22 c8))) + +(defun ntlm-smb-des-e-p24 (p22 c8) + "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes +string C8." + (concat (ntlm-smb-hash c8 p22 t) ;hash first 8 bytes of p22 + (ntlm-smb-hash c8 (substring p22 7) t) + (ntlm-smb-hash c8 (substring p22 14) t))) + +(defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37]) + +(defun ntlm-smb-des-e-p16 (p15) + "Return a 16 bytes hashed string for a 15 bytes string P15." + (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t) ;hash of first 8 bytes of p15 + (ntlm-smb-hash ntlm-smb-sp8 ;hash of last 8 bytes of p15 + (substring p15 7) t))) + +(defun ntlm-smb-hash (in key forw) + "Return the hash string of length 8 for a string IN of length 8 and +a string KEY of length 8. FORW is t or nil." + (let ((out (make-string 8 0)) + outb ;string of length 64 + (inb (make-string 64 0)) + (keyb (make-string 64 0)) + (key2 (ntlm-smb-str-to-key key)) + (i 0) aa) + (while (< i 64) + (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (aset inb i 1)) + (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (aset keyb i 1)) + (setq i (1+ i))) + (setq outb (ntlm-smb-dohash inb keyb forw)) + (setq i 0) + (while (< i 64) + (unless (zerop (aref outb i)) + (setq aa (aref out (/ i 8))) + (aset out (/ i 8) + (logior aa (lsh 1 (- 7 (% i 8)))))) + (setq i (1+ i))) + out)) + +(defun ntlm-smb-str-to-key (str) + "Return a string of length 8 for the given string STR of length 7." + (let ((key (make-string 8 0)) + (i 7)) + (aset key 0 (lsh (aref str 0) -1)) + (aset key 1 (logior + (lsh (logand (aref str 0) 1) 6) + (lsh (aref str 1) -2))) + (aset key 2 (logior + (lsh (logand (aref str 1) 3) 5) + (lsh (aref str 2) -3))) + (aset key 3 (logior + (lsh (logand (aref str 2) 7) 4) + (lsh (aref str 3) -4))) + (aset key 4 (logior + (lsh (logand (aref str 3) 15) 3) + (lsh (aref str 4) -5))) + (aset key 5 (logior + (lsh (logand (aref str 4) 31) 2) + (lsh (aref str 5) -6))) + (aset key 6 (logior + (lsh (logand (aref str 5) 63) 1) + (lsh (aref str 6) -7))) + (aset key 7 (logand (aref str 6) 127)) + (while (>= i 0) + (aset key i (lsh (aref key i) 1)) + (setq i (1- i))) + key)) + +(defconst ntlm-smb-perm1 [57 49 41 33 25 17 9 + 1 58 50 42 34 26 18 + 10 2 59 51 43 35 27 + 19 11 3 60 52 44 36 + 63 55 47 39 31 23 15 + 7 62 54 46 38 30 22 + 14 6 61 53 45 37 29 + 21 13 5 28 20 12 4]) + +(defconst ntlm-smb-perm2 [14 17 11 24 1 5 + 3 28 15 6 21 10 + 23 19 12 4 26 8 + 16 7 27 20 13 2 + 41 52 31 37 47 55 + 30 40 51 45 33 48 + 44 49 39 56 34 53 + 46 42 50 36 29 32]) + +(defconst ntlm-smb-perm3 [58 50 42 34 26 18 10 2 + 60 52 44 36 28 20 12 4 + 62 54 46 38 30 22 14 6 + 64 56 48 40 32 24 16 8 + 57 49 41 33 25 17 9 1 + 59 51 43 35 27 19 11 3 + 61 53 45 37 29 21 13 5 + 63 55 47 39 31 23 15 7]) + +(defconst ntlm-smb-perm4 [32 1 2 3 4 5 + 4 5 6 7 8 9 + 8 9 10 11 12 13 + 12 13 14 15 16 17 + 16 17 18 19 20 21 + 20 21 22 23 24 25 + 24 25 26 27 28 29 + 28 29 30 31 32 1]) + +(defconst ntlm-smb-perm5 [16 7 20 21 + 29 12 28 17 + 1 15 23 26 + 5 18 31 10 + 2 8 24 14 + 32 27 3 9 + 19 13 30 6 + 22 11 4 25]) + +(defconst ntlm-smb-perm6 [40 8 48 16 56 24 64 32 + 39 7 47 15 55 23 63 31 + 38 6 46 14 54 22 62 30 + 37 5 45 13 53 21 61 29 + 36 4 44 12 52 20 60 28 + 35 3 43 11 51 19 59 27 + 34 2 42 10 50 18 58 26 + 33 1 41 9 49 17 57 25]) + +(defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1]) + +(defconst ntlm-smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7] + [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8] + [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0] + [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]] + [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10] + [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5] + [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15] + [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]] + [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8] + [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1] + [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7] + [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]] + [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15] + [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9] + [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4] + [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]] + [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9] + [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6] + [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14] + [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]] + [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11] + [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8] + [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6] + [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]] + [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1] + [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6] + [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2] + [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]] + [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7] + [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2] + [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8] + [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]]) + +(defsubst ntlm-string-permute (in perm n) + "Return a string of length N for a string IN and a permutation vector +PERM of size N. The length of IN should be height of PERM." + (let ((i 0) (out (make-string n 0))) + (while (< i n) + (aset out i (aref in (- (aref perm i) 1))) + (setq i (1+ i))) + out)) + +(defsubst ntlm-string-lshift (str count len) + "Return a string by circularly shifting a string STR by COUNT to the left. +length of STR is LEN." + (let ((c (% count len))) + (concat (substring str c len) (substring str 0 c)))) + +(defsubst ntlm-string-xor (in1 in2 n) + "Return exclusive-or of sequences in1 and in2" + (let ((w (make-string n 0)) (i 0)) + (while (< i n) + (aset w i (logxor (aref in1 i) (aref in2 i))) + (setq i (1+ i))) + w)) + +(defun ntlm-smb-dohash (in key forw) + "Return the hash value for a string IN and a string KEY. +Length of IN and KEY are 64. FORW non nill means forward, nil means +backward." + (let (pk1 ;string of length 56 + c ;string of length 28 + d ;string of length 28 + cd ;string of length 56 + (ki (make-vector 16 0)) ;vector of string of length 48 + pd1 ;string of length 64 + l ;string of length 32 + r ;string of length 32 + rl ;string of length 64 + (i 0) (j 0) (k 0)) + (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) + (setq c (substring pk1 0 28)) + (setq d (substring pk1 28 56)) + + (setq i 0) + (while (< i 16) + (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28)) + (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28)) + (setq cd (concat (substring c 0 28) (substring d 0 28))) + (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)) + (setq i (1+ i))) + + (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64)) + + (setq l (substring pd1 0 32)) + (setq r (substring pd1 32 64)) + + (setq i 0) + (let (er ;string of length 48 + erk ;string of length 48 + (b (make-vector 8 0)) ;vector of strings of length 6 + cb ;string of length 32 + pcb ;string of length 32 + r2 ;string of length 32 + jj m n bj sbox-jmn) + (while (< i 16) + (setq er (ntlm-string-permute r ntlm-smb-perm4 48)) + (setq erk (ntlm-string-xor er + (aref ki (if forw i (- 15 i))) + 48)) + (setq j 0) + (while (< j 8) + (setq jj (* 6 j)) + (aset b j (substring erk jj (+ jj 6))) + (setq j (1+ j))) + (setq j 0) + (while (< j 8) + (setq bj (aref b j)) + (setq m (logior (lsh (aref bj 0) 1) (aref bj 5))) + (setq n (logior (lsh (aref bj 1) 3) + (lsh (aref bj 2) 2) + (lsh (aref bj 3) 1) + (aref bj 4))) + (setq k 0) + (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n)) + (while (< k 4) + (aset bj k + (if (zerop (logand sbox-jmn (lsh 1 (- 3 k)))) + 0 1)) + (setq k (1+ k))) + (setq j (1+ j))) + + (setq j 0) + (setq cb nil) + (while (< j 8) + (setq cb (concat cb (substring (aref b j) 0 4))) + (setq j (1+ j))) + + (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32)) + (setq r2 (ntlm-string-xor l pcb 32)) + (setq l r) + (setq r r2) + (setq i (1+ i)))) + (setq rl (concat r l)) + (ntlm-string-permute rl ntlm-smb-perm6 64))) + +(defun ntlm-md4hash (passwd) + "Return the 16 bytes MD4 hash of a string PASSWD after converting it +into a Unicode string. PASSWD is truncated to 128 bytes if longer." + (let (len wpwd) + ;; Password cannot be longer than 128 characters + (setq len (length passwd)) + (if (> len 128) + (setq len 128)) + ;; Password must be converted to NT unicode + (setq wpwd (ntlm-ascii2unicode passwd len)) + ;; Calculate length in bytes + (setq len (* len 2)) + (md4 wpwd len))) + +(provide 'ntlm) + +;;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296 +;;; ntlm.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/password.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/password.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,140 @@ +;;; password.el --- Read passwords from user, possibly using a password cache. + +;; Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; Created: 2003-12-21 +;; Keywords: password cache passphrase key + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Greatly influenced by pgg.el written by Daiki Ueno, with timer +;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just +;; a rip-off. +;; +;; (password-read "Password? " "test") +;; ;; Minibuffer prompt for password. +;; => "foo" +;; +;; (password-cache-add "test" "foo") +;; => nil + +;; Note the previous two can be replaced with: +;; (password-read-and-add "Password? " "test") +;; ;; Minibuffer prompt for password. +;; => "foo" +;; ;; "foo" is now cached with key "test" + + +;; (password-read "Password? " "test") +;; ;; No minibuffer prompt +;; => "foo" +;; +;; (password-read "Password? " "test") +;; ;; No minibuffer prompt +;; => "foo" +;; +;; ;; Wait `password-cache-expiry' seconds. +;; +;; (password-read "Password? " "test") +;; ;; Minibuffer prompt for password is back. +;; => "foo" + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defcustom password-cache t + "Whether to cache passwords." + :group 'password + :type 'boolean) + +(defcustom password-cache-expiry 16 + "How many seconds passwords are cached, or nil to disable expiring. +Whether passwords are cached at all is controlled by `password-cache'." + :group 'password + :type '(choice (const :tag "Never" nil) + (integer :tag "Seconds"))) + +(defvar password-data (make-vector 7 0)) + +(defun password-read-from-cache (key) + "Obtain passphrase for KEY from time-limited passphrase cache. +Custom variables `password-cache' and `password-cache-expiry' +regulate cache behavior." + (and password-cache + key + (symbol-value (intern-soft key password-data)))) + +(defun password-read (prompt &optional key) + "Read password, for use with KEY, from user, or from cache if wanted. +KEY indicate the purpose of the password, so the cache can +separate passwords. The cache is not used if KEY is nil. It is +typically a string. +The variable `password-cache' control whether the cache is used." + (or (password-read-from-cache key) + (read-passwd prompt))) + +(defun password-read-and-add (prompt &optional key) + "Read password, for use with KEY, from user, or from cache if wanted. +Then store the password in the cache. Uses `password-read' and +`password-cache-add'. +Custom variables `password-cache' and `password-cache-expiry' +regulate cache behavior." + (let ((password (password-read prompt key))) + (when (and password key) + (password-cache-add key password)) + password)) + +(defun password-cache-remove (key) + "Remove password indexed by KEY from password cache. +This is typically run be a timer setup from `password-cache-add', +but can be invoked at any time to forcefully remove passwords +from the cache. This may be useful when it has been detected +that a password is invalid, so that `password-read' query the +user again." + (let ((password (symbol-value (intern-soft key password-data)))) + (when password + (if (fboundp 'clear-string) + (clear-string password) + (fillarray password ?_)) + (unintern key password-data)))) + +(defun password-cache-add (key password) + "Add password to cache. +The password is removed by a timer after `password-cache-expiry' +seconds." + (when (and password-cache-expiry (null (intern-soft key password-data))) + (run-at-time password-cache-expiry nil + #'password-cache-remove + key)) + (set (intern key password-data) password) + nil) + +(defun password-reset () + "Clear the password cache." + (interactive) + (fillarray password-data 0)) + +(provide 'password) + +;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 +;;; password.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/pop3.el --- a/lisp/gnus/pop3.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/pop3.el Sun Oct 28 09:18:39 2007 +0000 @@ -201,6 +201,23 @@ (pop3-quit process) message-count)) +(autoload 'open-tls-stream "tls") +(autoload 'starttls-open-stream "starttls") +(autoload 'starttls-negotiate "starttls") ; avoid warning + +(defcustom pop3-stream-type nil + "*Transport security type for POP3 connexions. +This may be either nil (plain connexion), `ssl' (use an +SSL/TSL-secured stream) or `starttls' (use the starttls mechanism +to turn on TLS security after opening the stream). However, if +this is nil, `ssl' is assumed for connexions to port +995 (pop3s)." + :version "23.0" ;; No Gnus + :group 'pop3 + :type '(choice (const :tag "Plain" nil) + (const :tag "SSL/TLS" ssl) + (const starttls))) + (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST on PORT. Returns the process associated with the connection." @@ -212,7 +229,44 @@ mailhost))) (erase-buffer) (setq pop3-read-point (point-min)) - (setq process (open-network-stream "POP" (current-buffer) mailhost port)) + (setq process + (cond + ((or (eq pop3-stream-type 'ssl) + (and (not pop3-stream-type) (member port '(995 "pop3s")))) + ;; gnutls-cli, openssl don't accept service names + (if (or (equal port "pop3s") + (null port)) + (setq port 995)) + (let ((process (open-tls-stream "POP" (current-buffer) + mailhost port))) + (when process + ;; There's a load of info printed that needs deleting. + (while (when (memq (process-status process) '(open run)) + (pop3-accept-process-output process) + (goto-char (point-max)) + (forward-line -1) + (if (looking-at "\\+OK") + (progn + (delete-region (point-min) (point)) + nil) + (pop3-quit process) + (error "POP SSL connexion failed")))) + process))) + ((eq pop3-stream-type 'starttls) + ;; gnutls-cli, openssl don't accept service names + (if (equal port "pop3") + (setq port 110)) + (let ((process (starttls-open-stream "POP" (current-buffer) + mailhost (or port 110)))) + (pop3-send-command process "STLS") + (let ((response (pop3-read-response process t))) + (if (and response (string-match "+OK" response)) + (starttls-negotiate process) + (pop3-quit process) + (error "POP server doesn't support starttls"))) + process)) + (t + (open-network-stream "POP" (current-buffer) mailhost port)))) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) @@ -357,37 +411,6 @@ ;; AUTHORIZATION STATE -(eval-when-compile - (if (not (fboundp 'md5)) ;; Emacs 20 - (defalias 'md5 'ignore))) - -(eval-and-compile - (if (and (fboundp 'md5) - ;; There might be an incompatible implementation. - (condition-case nil - (md5 "Check whether the 4th argument is allowed" - nil nil 'binary) - (error nil))) - (defun pop3-md5 (string) - (md5 string nil nil 'binary)) - (defvar pop3-md5-program "md5" - "*Program to encode its input in MD5. -\"openssl\" is a popular alternative; set `pop3-md5-program-args' to -'(\"md5\") if you use it.") - (defvar pop3-md5-program-args nil - "*List of arguments passed to `pop3-md5-program'.") - (defun pop3-md5 (string) - (let ((default-enable-multibyte-characters t) - (coding-system-for-write 'binary)) - (with-temp-buffer - (insert string) - (apply 'call-process-region (point-min) (point-max) - pop3-md5-program t (current-buffer) nil - pop3-md5-program-args) - ;; The meaningful output is the first 32 characters. - ;; Don't return the newline that follows them! - (buffer-substring (point-min) (+ 32 (point-min)))))))) - (defun pop3-user (process user) "Send USER information to POP3 server." (pop3-send-command process (format "USER %s" user)) @@ -409,7 +432,7 @@ (setq pass (read-passwd (format "Password for %s: " pop3-maildrop)))) (if pass - (let ((hash (pop3-md5 (concat pop3-timestamp pass)))) + (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary))) (pop3-send-command process (format "APOP %s %s" user hash)) (let ((response (pop3-read-response process t))) (if (not (and response (string-match "+OK" response))) @@ -520,6 +543,13 @@ ;; -ERR [invalid password] ;; -ERR [unable to lock maildrop] +;; STLS (RFC 2595) +;; Arguments: none +;; Restrictions: Only permitted in AUTHORIZATION state. +;; Possible responses: +;; +OK +;; -ERR + ;;; TRANSACTION STATE ;; STAT diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/qp.el --- a/lisp/gnus/qp.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/qp.el Sun Oct 28 09:18:39 2007 +0000 @@ -70,8 +70,8 @@ (delete-char 2)) ((looking-at "=[0-9A-F][0-9A-F]") (let ((byte (string-to-number (buffer-substring (1+ (point)) - (+ 3 (point))) - 16))) + (+ 3 (point))) + 16))) (mm-insert-byte byte 1) (delete-char 3))) (t diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/rfc2047.el --- a/lisp/gnus/rfc2047.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/rfc2047.el Sun Oct 28 09:18:39 2007 +0000 @@ -31,24 +31,7 @@ (eval-when-compile (require 'cl) - (defvar message-posting-charset) - (unless (fboundp 'with-syntax-table) ; not in Emacs 20 - (defmacro with-syntax-table (table &rest body) - "Evaluate BODY with syntax table of current buffer set to TABLE. -The syntax table of the current buffer is saved, BODY is evaluated, and the -saved table is restored, even in case of an abnormal exit. -Value is what BODY returns." - (let ((old-table (make-symbol "table")) - (old-buffer (make-symbol "buffer"))) - `(let ((,old-table (syntax-table)) - (,old-buffer (current-buffer))) - (unwind-protect - (progn - (set-syntax-table ,table) - ,@body) - (save-current-buffer - (set-buffer ,old-buffer) - (set-syntax-table ,old-table)))))))) + (defvar message-posting-charset)) (require 'qp) (require 'mm-util) @@ -58,18 +41,6 @@ (require 'rfc2045) ;; rfc2045-encode-string (autoload 'mm-body-7-or-8 "mm-bodies") -(eval-and-compile - ;; Avoid gnus-util for mm- code. - (defalias 'rfc2047-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) - - (defalias 'rfc2047-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - (defvar rfc2047-header-encoding-alist '(("Newsgroups" . nil) ("Followup-To" . nil) @@ -159,7 +130,7 @@ (progn (forward-line 1) (if (re-search-forward "^[^ \n\t]" nil t) - (rfc2047-point-at-bol) + (point-at-bol) (point-max)))) (goto-char (point-min))) @@ -175,37 +146,50 @@ encodable-regexp) "Quote special characters with `\\'s in quoted strings. Quoting will not be done in a quoted string if it contains characters -matching ENCODABLE-REGEXP." +matching ENCODABLE-REGEXP or it is within parentheses." (goto-char (point-min)) (let ((tspecials (concat "[" ietf-drums-tspecials "]")) + (start (point)) beg end) (with-syntax-table (standard-syntax-table) - (while (search-forward "\"" nil t) - (setq beg (match-beginning 0)) - (unless (eq (char-before beg) ?\\) - (goto-char beg) - (setq beg (1+ beg)) - (condition-case nil - (progn - (forward-sexp) - (setq end (1- (point))) - (goto-char beg) - (if (and encodable-regexp - (re-search-forward encodable-regexp end t)) - (goto-char (1+ end)) - (save-restriction - (narrow-to-region beg end) - (while (re-search-forward tspecials nil 'move) - (if (eq (char-before) ?\\) - (if (looking-at tspecials) ;; Already quoted. - (forward-char) - (insert "\\")) - (goto-char (match-beginning 0)) - (insert "\\") - (forward-char)))) - (forward-char))) - (error - (goto-char beg)))))))) + (while (not (eobp)) + (if (ignore-errors + (forward-list 1) + (eq (char-before) ?\))) + (forward-list -1) + (goto-char (point-max))) + (save-restriction + (narrow-to-region start (point)) + (goto-char start) + (while (search-forward "\"" nil t) + (setq beg (match-beginning 0)) + (unless (eq (char-before beg) ?\\) + (goto-char beg) + (setq beg (1+ beg)) + (condition-case nil + (progn + (forward-sexp) + (setq end (1- (point))) + (goto-char beg) + (if (and encodable-regexp + (re-search-forward encodable-regexp end t)) + (goto-char (1+ end)) + (save-restriction + (narrow-to-region beg end) + (while (re-search-forward tspecials nil 'move) + (if (eq (char-before) ?\\) + (if (looking-at tspecials) ;; Already quoted. + (forward-char) + (insert "\\")) + (goto-char (match-beginning 0)) + (insert "\\") + (forward-char)))) + (forward-char))) + (error + (goto-char beg))))) + (goto-char (point-max))) + (forward-list 1) + (setq start (point)))))) (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. @@ -290,9 +274,10 @@ ;;; (rfc2047-encode-region (point-min) (point-max)) ;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) - (if (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters)) + (if (or (and (featurep 'mule) + (if (boundp 'default-enable-multibyte-characters) + default-enable-multibyte-characters)) + (featurep 'file-coding)) (mm-encode-coding-region (point) (point-max) method))) ;; Hm. (t))) @@ -656,14 +641,14 @@ (goto-char b) (setq b (point-marker) e (set-marker (make-marker) e)) - (rfc2047-fold-region (rfc2047-point-at-bol) b) + (rfc2047-fold-region (point-at-bol) b) (goto-char b) (skip-chars-backward "^ \t\n") (unless (= 0 (skip-chars-backward " \t")) ;; `crest' may contain whitespace and an open parenthesis. (setq crest (buffer-substring-no-properties (point) b))) (setq eword (rfc2047-encode-1 - (- b (rfc2047-point-at-bol)) + (- b (point-at-bol)) (mm-replace-in-string (buffer-substring-no-properties b e) "\n\\([ \t]?\\)" "\\1") @@ -710,7 +695,7 @@ (first t) (bol (save-restriction (widen) - (rfc2047-point-at-bol)))) + (point-at-bol)))) (while (not (eobp)) (when (and (or break qword-break) (> (- (point) bol) 76)) @@ -782,18 +767,18 @@ (goto-char (point-min)) (let ((bol (save-restriction (widen) - (rfc2047-point-at-bol))) - (eol (rfc2047-point-at-eol))) + (point-at-bol))) + (eol (point-at-eol))) (forward-line 1) (while (not (eobp)) (if (and (looking-at "[ \t]") - (< (- (rfc2047-point-at-eol) bol) 76)) + (< (- (point-at-eol) bol) 76)) (delete-region eol (progn (goto-char eol) (skip-chars-forward "\r\n") (point))) - (setq bol (rfc2047-point-at-bol))) - (setq eol (rfc2047-point-at-eol)) + (setq bol (point-at-bol))) + (setq eol (point-at-eol)) (forward-line 1))))) (defun rfc2047-b-encode-string (string) @@ -842,7 +827,7 @@ (eval-and-compile (defconst rfc2047-encoded-word-regexp - "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(\\*[^?]+\\)?\ + "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\ \\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?=")) (defvar rfc2047-quote-decoded-words-containing-tspecials nil @@ -981,8 +966,8 @@ words nil) (while match (push (list (match-string 2) ;; charset - (char-after (match-beginning 4)) ;; encoding - (match-string 5) ;; encoded-text + (char-after (match-beginning 3)) ;; encoding + (match-string 4) ;; encoded-text (match-string 1)) ;; encoded-word words) ;; Look for the subsequent encoded-words. diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/rfc2231.el --- a/lisp/gnus/rfc2231.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/rfc2231.el Sun Oct 28 09:18:39 2007 +0000 @@ -53,8 +53,7 @@ (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token)) (stoken (ietf-drums-token-to-list ietf-drums-tspecials)) (ntoken (ietf-drums-token-to-list "0-9")) - c type attribute encoded number prev-attribute vals - prev-encoded parameters value) + c type attribute encoded number parameters value) (ietf-drums-init (condition-case nil (mail-header-remove-whitespace @@ -81,8 +80,8 @@ ;; Finally, attempt to extract only type. (if (string-match (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+" - "\\(/[^" ietf-drums-tspecials - "\t\n ]+\\)?\\)\\([\t\n ;]\\|\\'\\)") + "\\(?:/[^" ietf-drums-tspecials + "\t\n ]+\\)?\\)\\(?:[\t\n ;]\\|\\'\\)") string) (match-string 1 string) "")))))) @@ -142,19 +141,6 @@ (setq c (char-after))))) (setq number nil encoded nil)) - ;; See if we have any previous continuations. - (when (and prev-attribute - (not (eq prev-attribute attribute))) - (setq vals - (mapconcat 'cdr (sort vals 'car-less-than-car) "")) - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string vals) - vals)) - parameters) - (setq prev-attribute nil - vals nil - prev-encoded nil)) (unless (eq c ?=) (error "Invalid header: %s" string)) (forward-char 1) @@ -187,33 +173,33 @@ (point))))) (t (error "Invalid header: %s" string))) - (if number - (progn - (push (cons number value) vals) - (setq prev-attribute attribute - prev-encoded encoded)) - (push (cons attribute - (if encoded - (rfc2231-decode-encoded-string value) - value)) - parameters)))) - - ;; Take care of any final continuations. - (when prev-attribute - (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) "")) - (push (cons prev-attribute - (if prev-encoded - (rfc2231-decode-encoded-string vals) - vals)) - parameters))) + (push (list attribute value number encoded) + parameters)))) (error (setq parameters nil) - (if signal-error - (signal (car err) (cdr err)) - ;;(message "%s" (error-message-string err)) - ))) + (when signal-error + (signal (car err) (cdr err))))) - (cons type (nreverse parameters)))))) + ;; Now collect and concatenate continuation parameters. + (let ((cparams nil) + elem) + (loop for (attribute value part encoded) + in (sort parameters (lambda (e1 e2) + (< (or (caddr e1) 0) + (or (caddr e2) 0)))) + do (if (or (not (setq elem (assq attribute cparams))) + (and (numberp part) + (zerop part))) + (push (list attribute value encoded) cparams) + (setcar (cdr elem) (concat (cadr elem) value)))) + ;; Finally decode encoded values. + (cons type (mapcar + (lambda (elem) + (cons (car elem) + (if (nth 2 elem) + (rfc2231-decode-encoded-string (nth 1 elem)) + (nth 1 elem)))) + (nreverse cparams)))))))) (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. @@ -223,10 +209,10 @@ \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or \"This is ***fun***\"." - (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) - (let ((coding-system (mm-charset-to-coding-system (match-string 2 string))) - ;;(language (match-string 3 string)) - (value (match-string 4 string))) + (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) + (let ((coding-system (mm-charset-to-coding-system (match-string 1 string))) + ;;(language (match-string 2 string)) + (value (match-string 3 string))) (mm-with-unibyte-buffer (insert value) (goto-char (point-min)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sasl-cram.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/sasl-cram.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,52 @@ +;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Kenichi OKADA +;; Keywords: SASL, CRAM-MD5 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +(require 'sasl) +(require 'hmac-md5) + +(defconst sasl-cram-md5-steps + '(ignore ;no initial response + sasl-cram-md5-response)) + +(defun sasl-cram-md5-response (client step) + (let ((passphrase + (sasl-read-passphrase + (format "CRAM-MD5 passphrase for %s: " + (sasl-client-name client))))) + (unwind-protect + (concat (sasl-client-name client) " " + (encode-hex-string + (hmac-md5 (sasl-step-data step) passphrase))) + (fillarray passphrase 0)))) + +(put 'sasl-cram 'sasl-mechanism + (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps)) + +(provide 'sasl-cram) + +;;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05 +;;; sasl-cram.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sasl-digest.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/sasl-digest.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,157 @@ +;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Kenichi OKADA +;; Keywords: SASL, DIGEST-MD5 + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;; This program is implemented from draft-leach-digest-sasl-05.txt. +;; +;; It is caller's responsibility to base64-decode challenges and +;; base64-encode responses in IMAP4 AUTHENTICATE command. +;; +;; Passphrase should be longer than 16 bytes. (See RFC 2195) + +;;; Commentary: + +(require 'sasl) +(require 'hmac-md5) + +(defvar sasl-digest-md5-nonce-count 1) +(defvar sasl-digest-md5-unique-id-function + sasl-unique-id-function) + +(defvar sasl-digest-md5-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?, "." table) + table) + "A syntax table for parsing digest-challenge attributes.") + +(defconst sasl-digest-md5-steps + '(ignore ;no initial response + sasl-digest-md5-response + ignore)) ;"" + +(defun sasl-digest-md5-parse-string (string) + "Parse STRING and return a property list. +The value is a cons cell of the form \(realm nonce qop-options stale maxbuf +charset algorithm cipher-opts auth-param)." + (with-temp-buffer + (set-syntax-table sasl-digest-md5-syntax-table) + (save-excursion + (insert string) + (goto-char (point-min)) + (insert "(") + (while (progn (forward-sexp) (not (eobp))) + (delete-char 1) + (insert " ")) + (insert ")") + (read (point-min-marker))))) + +(defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name) + (concat serv-type "/" host + (if (and serv-name + (not (string= host serv-name))) + (concat "/" serv-name)))) + +(defun sasl-digest-md5-cnonce () + (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function)) + (sasl-unique-id))) + +(defun sasl-digest-md5-response-value (username + realm + nonce + cnonce + nonce-count + qop + digest-uri + authzid) + (let ((passphrase + (sasl-read-passphrase + (format "DIGEST-MD5 passphrase for %s: " + username)))) + (unwind-protect + (encode-hex-string + (md5-binary + (concat + (encode-hex-string + (md5-binary (concat (md5-binary + (concat username ":" realm ":" passphrase)) + ":" nonce ":" cnonce + (if authzid + (concat ":" authzid))))) + ":" nonce + ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" + (encode-hex-string + (md5-binary + (concat "AUTHENTICATE:" digest-uri + (if (member qop '("auth-int" "auth-conf")) + ":00000000000000000000000000000000"))))))) + (fillarray passphrase 0)))) + +(defun sasl-digest-md5-response (client step) + (let* ((plist + (sasl-digest-md5-parse-string (sasl-step-data step))) + (realm + (or (sasl-client-property client 'realm) + (plist-get plist 'realm))) ;need to check + (nonce-count + (or (sasl-client-property client 'nonce-count) + sasl-digest-md5-nonce-count)) + (qop + (or (sasl-client-property client 'qop) + "auth")) + (digest-uri + (sasl-digest-md5-digest-uri + (sasl-client-service client)(sasl-client-server client))) + (cnonce + (or (sasl-client-property client 'cnonce) + (sasl-digest-md5-cnonce)))) + (sasl-client-set-property client 'nonce-count (1+ nonce-count)) + (unless (string= qop "auth") + (sasl-error (format "Unsupported \"qop-value\": %s" qop))) + (concat + "username=\"" (sasl-client-name client) "\"," + "realm=\"" realm "\"," + "nonce=\"" (plist-get plist 'nonce) "\"," + "cnonce=\"" cnonce "\"," + (format "nc=%08x," nonce-count) + "digest-uri=\"" digest-uri "\"," + "qop=" qop "," + "response=" + (sasl-digest-md5-response-value + (sasl-client-name client) + realm + (plist-get plist 'nonce) + cnonce + nonce-count + qop + digest-uri + (plist-get plist 'authzid))))) + +(put 'sasl-digest 'sasl-mechanism + (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps)) + +(provide 'sasl-digest) + +;;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d +;;; sasl-digest.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sasl-ntlm.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/sasl-ntlm.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,66 @@ +;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Taro Kawagishi +;; Keywords: SASL, NTLM +;; Version: 1.00 +;; Created: February 2001 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This is a SASL interface layer for NTLM authentication message +;; generation by ntlm.el + +;;; Code: + +(require 'sasl) +(require 'ntlm) + +(defconst sasl-ntlm-steps + '(ignore ;nothing to do before making + sasl-ntlm-request ;authentication request + sasl-ntlm-response) ;response to challenge + "A list of functions to be called in sequnece for the NTLM +authentication steps. Ther are called by 'sasl-next-step.") + +(defun sasl-ntlm-request (client step) + "SASL step function to generate a NTLM authentication request to the server. +Called from 'sasl-next-step. +CLIENT is a vector [mechanism user service server sasl-client-properties] +STEP is a vector [ ]" + (let ((user (sasl-client-name client))) + (ntlm-build-auth-request user))) + +(defun sasl-ntlm-response (client step) + "SASL step function to generate a NTLM response against the server +challenge stored in the 2nd element of STEP. Called from 'sasl-next-step." + (let* ((user (sasl-client-name client)) + (passphrase + (sasl-read-passphrase (format "NTLM passphrase for %s: " user))) + (challenge (sasl-step-data step))) + (ntlm-build-auth-response challenge user + (ntlm-get-password-hashes passphrase)))) + +(put 'sasl-ntlm 'sasl-mechanism + (sasl-make-mechanism "NTLM" sasl-ntlm-steps)) + +(provide 'sasl-ntlm) + +;;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc +;;; sasl-ntlm.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sasl.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/sasl.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,273 @@ +;;; sasl.el --- SASL client framework + +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Keywords: SASL + +;; This file is part of FLIM (Faithful Library about Internet Message). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This module provides common interface functions to share several +;; SASL mechanism drivers. The toplevel is designed to be mostly +;; compatible with [Java-SASL]. +;; +;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)", +;; RFC 2222, October 1997. +;; +;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program +;; Interface", draft-weltman-java-sasl-03.txt, March 2000. + +;;; Code: + +(defvar sasl-mechanisms + '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS" + "NTLM" "SCRAM-MD5")) + +(defvar sasl-mechanism-alist + '(("CRAM-MD5" sasl-cram) + ("DIGEST-MD5" sasl-digest) + ("PLAIN" sasl-plain) + ("LOGIN" sasl-login) + ("ANONYMOUS" sasl-anonymous) + ("NTLM" sasl-ntlm) + ("SCRAM-MD5" sasl-scram))) + +(defvar sasl-unique-id-function #'sasl-unique-id-function) + +(put 'sasl-error 'error-message "SASL error") +(put 'sasl-error 'error-conditions '(sasl-error error)) + +(defun sasl-error (datum) + (signal 'sasl-error (list datum))) + +;;; @ SASL client +;;; + +(defun sasl-make-client (mechanism name service server) + "Return a newly allocated SASL client. +NAME is name of the authorization. SERVICE is name of the service desired. +SERVER is the fully qualified host name of the server to authenticate to." + (vector mechanism name service server (make-symbol "sasl-client-properties"))) + +(defun sasl-client-mechanism (client) + "Return the authentication mechanism driver of CLIENT." + (aref client 0)) + +(defun sasl-client-name (client) + "Return the authorization name of CLIENT, a string." + (aref client 1)) + +(defun sasl-client-service (client) + "Return the service name of CLIENT, a string." + (aref client 2)) + +(defun sasl-client-server (client) + "Return the server name of CLIENT, a string." + (aref client 3)) + +(defun sasl-client-set-properties (client plist) + "Destructively set the properties of CLIENT. +The second argument PLIST is the new property list." + (setplist (aref client 4) plist)) + +(defun sasl-client-set-property (client property value) + "Add the given property/value to CLIENT." + (put (aref client 4) property value)) + +(defun sasl-client-property (client property) + "Return the value of the PROPERTY of CLIENT." + (get (aref client 4) property)) + +(defun sasl-client-properties (client) + "Return the properties of CLIENT." + (symbol-plist (aref client 4))) + +;;; @ SASL mechanism +;;; + +(defun sasl-make-mechanism (name steps) + "Make an authentication mechanism. +NAME is a IANA registered SASL mechanism name. +STEPS is list of continuation function." + (vector name + (mapcar + (lambda (step) + (let ((symbol (make-symbol (symbol-name step)))) + (fset symbol (symbol-function step)) + symbol)) + steps))) + +(defun sasl-mechanism-name (mechanism) + "Return name of MECHANISM, a string." + (aref mechanism 0)) + +(defun sasl-mechanism-steps (mechanism) + "Return the authentication steps of MECHANISM, a list of functions." + (aref mechanism 1)) + +(defun sasl-find-mechanism (mechanisms) + "Retrieve an apropriate mechanism object from MECHANISMS hints." + (let* ((sasl-mechanisms sasl-mechanisms) + (mechanism + (catch 'done + (while sasl-mechanisms + (if (member (car sasl-mechanisms) mechanisms) + (throw 'done (nth 1 (assoc (car sasl-mechanisms) + sasl-mechanism-alist)))) + (setq sasl-mechanisms (cdr sasl-mechanisms)))))) + (if mechanism + (require mechanism)) + (get mechanism 'sasl-mechanism))) + +;;; @ SASL authentication step +;;; + +(defun sasl-step-data (step) + "Return the data which STEP holds, a string." + (aref step 1)) + +(defun sasl-step-set-data (step data) + "Store DATA string to STEP." + (aset step 1 data)) + +(defun sasl-next-step (client step) + "Evaluate the challenge and prepare an appropriate next response. +The data type of the value and optional 2nd argument STEP is nil or +opaque authentication step which holds the reference to the next action +and the current challenge. At the first time STEP should be set to nil." + (let* ((steps + (sasl-mechanism-steps + (sasl-client-mechanism client))) + (function + (if (vectorp step) + (nth 1 (memq (aref step 0) steps)) + (car steps)))) + (if function + (vector function (funcall function client step))))) + +(defvar sasl-read-passphrase nil) +(defun sasl-read-passphrase (prompt) + (if (not sasl-read-passphrase) + (if (functionp 'read-passwd) + (setq sasl-read-passphrase 'read-passwd) + (if (load "passwd" t) + (setq sasl-read-passphrase 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq sasl-read-passphrase 'ange-ftp-read-passwd)))) + (funcall sasl-read-passphrase prompt)) + +(defun sasl-unique-id () + "Compute a data string which must be different each time. +It contain at least 64 bits of entropy." + (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function))) + +(defvar sasl-unique-id-char nil) + +;; stolen (and renamed) from message.el +(defun sasl-unique-id-function () + ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Instead we use this randomly inited counter. + (setq sasl-unique-id-char + (% (1+ (or sasl-unique-id-char (logand (random t) (1- (lsh 1 20))))) + ;; (current-time) returns 16-bit ints, + ;; and 2^16*25 just fits into 4 digits i base 36. + (* 25 25))) + (let ((tm (current-time))) + (concat + (sasl-unique-id-number-base36 + (+ (car tm) + (lsh (% sasl-unique-id-char 25) 16)) 4) + (sasl-unique-id-number-base36 + (+ (nth 1 tm) + (lsh (/ sasl-unique-id-char 25) 16)) 4)))) + +(defun sasl-unique-id-number-base36 (num len) + (if (if (< len 0) + (<= num 0) + (= len 0)) + "" + (concat (sasl-unique-id-number-base36 (/ num 36) (1- len)) + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" + (% num 36)))))) + +;;; PLAIN (RFC2595 Section 6) +(defconst sasl-plain-steps + '(sasl-plain-response)) + +(defun sasl-plain-response (client step) + (let ((passphrase + (sasl-read-passphrase + (format "PLAIN passphrase for %s: " (sasl-client-name client)))) + (authenticator-name + (sasl-client-property + client 'authenticator-name)) + (name (sasl-client-name client))) + (unwind-protect + (if (and authenticator-name + (not (string= authenticator-name name))) + (concat authenticator-name "\0" name "\0" passphrase) + (concat "\0" name "\0" passphrase)) + (fillarray passphrase 0)))) + +(put 'sasl-plain 'sasl-mechanism + (sasl-make-mechanism "PLAIN" sasl-plain-steps)) + +(provide 'sasl-plain) + +;;; LOGIN (No specification exists) +(defconst sasl-login-steps + '(ignore ;no initial response + sasl-login-response-1 + sasl-login-response-2)) + +(defun sasl-login-response-1 (client step) +;;; (unless (string-match "^Username:" (sasl-step-data step)) +;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) + (sasl-client-name client)) + +(defun sasl-login-response-2 (client step) +;;; (unless (string-match "^Password:" (sasl-step-data step)) +;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) + (sasl-read-passphrase + (format "LOGIN passphrase for %s: " (sasl-client-name client)))) + +(put 'sasl-login 'sasl-mechanism + (sasl-make-mechanism "LOGIN" sasl-login-steps)) + +(provide 'sasl-login) + +;;; ANONYMOUS (RFC2245) +(defconst sasl-anonymous-steps + '(ignore ;no initial response + sasl-anonymous-response)) + +(defun sasl-anonymous-response (client step) + (or (sasl-client-property client 'trace) + (sasl-client-name client))) + +(put 'sasl-anonymous 'sasl-mechanism + (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) + +(provide 'sasl-anonymous) + +(provide 'sasl) + +;;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887 +;;; sasl.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/score-mode.el --- a/lisp/gnus/score-mode.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/score-mode.el Sun Oct 28 09:18:39 2007 +0000 @@ -31,6 +31,9 @@ (require 'mm-util) ; for mm-universal-coding-system (require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks +(defvar gnus-score-edit-done-hook nil + "*Hook run at the end of closing the score buffer.") + (defvar gnus-score-mode-hook nil "*Hook run in score mode buffers.") diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sieve-manage.el --- a/lisp/gnus/sieve-manage.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/sieve-manage.el Sun Oct 28 09:18:39 2007 +0000 @@ -27,7 +27,10 @@ ;; This library provides an elisp API for the managesieve network ;; protocol. ;; -;; Currently only the CRAM-MD5 authentication mechanism is supported. +;; It uses the SASL library for authentication, which means it +;; supports DIGEST-MD5, CRAM-MD5, SCRAM-MD5, NTLM, PLAIN and LOGIN +;; methods. STARTTLS is not well tested, but should be easy to get to +;; work if someone wants. ;; ;; The API should be fairly obvious for anyone familiar with the ;; managesieve protocol, interface functions include: @@ -69,15 +72,17 @@ ;; ;; 2001-10-31 Committed to Oort Gnus. ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. +;; 2002-08-03 Use SASL library. ;;; Code: -(require 'rfc2104) -(or (fboundp 'md5) - (require 'md5)) +(require 'password) +(eval-when-compile + (require 'sasl) + (require 'starttls)) (eval-and-compile - (autoload 'starttls-open-stream "starttls") - (autoload 'starttls-negotiate "starttls")) + (autoload 'sasl-find-mechanism "sasl") + (autoload 'starttls-open-stream "starttls")) ;; User customizable variables: @@ -123,13 +128,22 @@ stream." :group 'sieve-manage) -(defcustom sieve-manage-authenticators '(cram-md5 plain) +(defcustom sieve-manage-authenticators '(digest-md5 + cram-md5 + scram-md5 + ntlm + plain + login) "Priority of authenticators to consider when authenticating to server." :group 'sieve-manage) (defcustom sieve-manage-authenticator-alist '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) - (plain sieve-manage-plain-p sieve-manage-plain-auth)) + (digest-md5 sieve-manage-digest-md5-p sieve-manage-digest-md5-auth) + (scram-md5 sieve-manage-scram-md5-p sieve-manage-scram-md5-auth) + (ntlm sieve-manage-ntlm-p sieve-manage-ntlm-auth) + (plain sieve-manage-plain-p sieve-manage-plain-auth) + (login sieve-manage-login-p sieve-manage-login-auth)) "Definition of authenticators. \(NAME CHECK AUTHENTICATE) @@ -188,38 +202,45 @@ (with-current-buffer buffer (make-local-variable 'sieve-manage-username) (make-local-variable 'sieve-manage-password) - (let (user passwd ret reason) - ;; (condition-case () - (while (or (not user) (not passwd)) - (setq user (or sieve-manage-username - (read-from-minibuffer - (concat "Managesieve username for " - sieve-manage-server ": ") - (or user sieve-manage-default-user)))) - (setq passwd (or sieve-manage-password - (read-passwd - (concat "Managesieve password for " user "@" - sieve-manage-server ": ")))) - (when (and user passwd) - (if (funcall loginfunc user passwd) - (progn - (setq ret t - sieve-manage-username user) - (if (and (not sieve-manage-password) - (y-or-n-p "Store password for this session? ")) - (setq sieve-manage-password passwd))) - (if reason - (message "Login failed (reason given: %s)..." reason) - (message "Login failed...")) - (setq reason nil) - (setq passwd nil) - (sit-for 1)))) - ;; (quit (with-current-buffer buffer - ;; (setq user nil - ;; passwd nil))) - ;; (error (with-current-buffer buffer - ;; (setq user nil - ;; passwd nil)))) + (let (user passwd ret reason passwd-key) + (condition-case () + (while (or (not user) (not passwd)) + (setq user (or sieve-manage-username + (read-from-minibuffer + (concat "Managesieve username for " + sieve-manage-server ": ") + (or user sieve-manage-default-user))) + passwd-key (concat "managesieve:" user "@" sieve-manage-server + ":" sieve-manage-port) + passwd (or sieve-manage-password + (password-read (concat "Managesieve password for " + user "@" sieve-manage-server + ": ") + passwd-key))) + (when (y-or-n-p "Store password for this session? ") + (password-cache-add passwd-key (copy-sequence passwd))) + (when (and user passwd) + (if (funcall loginfunc user passwd) + (setq ret t + sieve-manage-username user) + (if reason + (message "Login failed (reason given: %s)..." reason) + (message "Login failed...")) + (password-cache-remove passwd-key) + (setq sieve-manage-password nil) + (setq passwd nil) + (setq reason nil) + (sit-for 1)))) + (quit (with-current-buffer buffer + (password-cache-remove passwd-key) + (setq user nil + passwd nil + sieve-manage-password nil))) + (error (with-current-buffer buffer + (password-cache-remove passwd-key) + (setq user nil + passwd nil + sieve-manage-password nil)))) ret))) (defun sieve-manage-erase (&optional p buffer) @@ -304,60 +325,111 @@ ;; Authenticators -(defun sieve-manage-plain-p (buffer) - (sieve-manage-capability "SASL" "PLAIN" buffer)) - -(defun sieve-manage-plain-auth (buffer) - "Login to managesieve server using the PLAIN SASL method." - (let* ((done (sieve-manage-interactive-login - buffer - (lambda (user passwd) - (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \"" - (base64-encode-string - (concat (char-to-string 0) - user - (char-to-string 0) - passwd)) - "\"")) - (let ((rsp (sieve-manage-parse-okno))) - (if (sieve-manage-ok-p rsp) - t - (setq reason (cdr-safe rsp)) - nil)))))) - (if done - (message "sieve: Authenticating using PLAIN...done") - (message "sieve: Authenticating using PLAIN...failed")))) +(defun sieve-sasl-auth (buffer mech) + "Login to server using the SASL MECH method." + (message "sieve: Authenticating using %s..." mech) + (if (sieve-manage-interactive-login + buffer + (lambda (user passwd) + (let (client step tag data rsp) + (setq client (sasl-make-client (sasl-find-mechanism (list mech)) + user "sieve" sieve-manage-server)) + (setq sasl-read-passphrase (function (lambda (prompt) passwd))) + (setq step (sasl-next-step client nil)) + (setq tag + (sieve-manage-send + (concat + "AUTHENTICATE \"" + mech + "\"" + (and (sasl-step-data step) + (concat + " \"" + (base64-encode-string + (sasl-step-data step) + 'no-line-break) + "\""))))) + (catch 'done + (while t + (setq rsp nil) + (goto-char (point-min)) + (while (null (or (progn + (setq rsp (sieve-manage-is-string)) + (if (not (and rsp (looking-at + sieve-manage-server-eol))) + (setq rsp nil) + (goto-char (match-end 0)) + rsp)) + (setq rsp (sieve-manage-is-okno)))) + (accept-process-output sieve-manage-process 1) + (goto-char (point-min))) + (sieve-manage-erase) + (when (sieve-manage-ok-p rsp) + (when (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp)) + (sasl-step-set-data + step (base64-decode-string (match-string 1 (cadr rsp))))) + (if (and (setq step (sasl-next-step client step)) + (setq data (sasl-step-data step))) + ;; We got data for server but it's finished + (error "Server not ready for SASL data: %s" data) + ;; The authentication process is finished. + (throw 'done t))) + (unless (stringp rsp) + (apply 'error "Server aborted SASL authentication: %s %s %s" + rsp)) + (sasl-step-set-data step (base64-decode-string rsp)) + (setq step (sasl-next-step client step)) + (sieve-manage-send + (if (sasl-step-data step) + (concat "\"" + (base64-encode-string (sasl-step-data step) + 'no-line-break) + "\"") + ""))))))) + (message "sieve: Authenticating using %s...done" mech) + (message "sieve: Authenticating using %s...failed" mech))) (defun sieve-manage-cram-md5-p (buffer) (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) (defun sieve-manage-cram-md5-auth (buffer) "Login to managesieve server using the CRAM-MD5 SASL method." - (message "sieve: Authenticating using CRAM-MD5...") - (let* ((done (sieve-manage-interactive-login - buffer - (lambda (user passwd) - (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\"") - (sieve-manage-send - (concat - "\"" - (base64-encode-string - (concat - user " " - (rfc2104-hash 'md5 64 16 passwd - (base64-decode-string - (prog1 - (sieve-manage-parse-string) - (sieve-manage-erase)))))) - "\"")) - (let ((rsp (sieve-manage-parse-okno))) - (if (sieve-manage-ok-p rsp) - t - (setq reason (cdr-safe rsp)) - nil)))))) - (if done - (message "sieve: Authenticating using CRAM-MD5...done") - (message "sieve: Authenticating using CRAM-MD5...failed")))) + (sieve-sasl-auth buffer "CRAM-MD5")) + +(defun sieve-manage-digest-md5-p (buffer) + (sieve-manage-capability "SASL" "DIGEST-MD5" buffer)) + +(defun sieve-manage-digest-md5-auth (buffer) + "Login to managesieve server using the DIGEST-MD5 SASL method." + (sieve-sasl-auth buffer "DIGEST-MD5")) + +(defun sieve-manage-scram-md5-p (buffer) + (sieve-manage-capability "SASL" "SCRAM-MD5" buffer)) + +(defun sieve-manage-scram-md5-auth (buffer) + "Login to managesieve server using the SCRAM-MD5 SASL method." + (sieve-sasl-auth buffer "SCRAM-MD5")) + +(defun sieve-manage-ntlm-p (buffer) + (sieve-manage-capability "SASL" "NTLM" buffer)) + +(defun sieve-manage-ntlm-auth (buffer) + "Login to managesieve server using the NTLM SASL method." + (sieve-sasl-auth buffer "NTLM")) + +(defun sieve-manage-plain-p (buffer) + (sieve-manage-capability "SASL" "PLAIN" buffer)) + +(defun sieve-manage-plain-auth (buffer) + "Login to managesieve server using the PLAIN SASL method." + (sieve-sasl-auth buffer "PLAIN")) + +(defun sieve-manage-login-p (buffer) + (sieve-manage-capability "SASL" "LOGIN" buffer)) + +(defun sieve-manage-login-auth (buffer) + "Login to managesieve server using the LOGIN SASL method." + (sieve-sasl-auth buffer "LOGIN")) ;; Managesieve API diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sieve-mode.el --- a/lisp/gnus/sieve-mode.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/sieve-mode.el Sun Oct 28 09:18:39 2007 +0000 @@ -51,7 +51,6 @@ (autoload 'sieve-manage "sieve") (autoload 'sieve-upload "sieve") -(autoload 'c-mode "cc-mode") (require 'easymenu) (eval-when-compile (require 'font-lock)) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/sieve.el --- a/lisp/gnus/sieve.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/sieve.el Sun Oct 28 09:18:39 2007 +0000 @@ -145,7 +145,7 @@ (setq mode-name "SIEVE") (buffer-disable-undo (current-buffer)) (setq truncate-lines t) - (easy-menu-add-item nil nil sieve-manage-mode-menu)) + (easy-menu-add sieve-manage-mode-menu sieve-manage-mode-map)) (put 'sieve-manage-mode 'mode-class 'special) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/smiley.el --- a/lisp/gnus/smiley.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/smiley.el Sun Oct 28 09:18:39 2007 +0000 @@ -58,24 +58,65 @@ "Turn :-)'s into real images." :group 'gnus-visual) -;; Maybe this should go. -(defcustom smiley-data-directory - (nnheader-find-etc-directory "images/smilies") - "Location of the smiley faces files." +(defvar smiley-data-directory) + +(defcustom smiley-style + (if (or (and (fboundp 'face-attribute) + (>= (face-attribute 'default :height) 160)) + (and (fboundp 'face-height) + (>= (face-height 'default) 14))) + 'medium + 'low-color) + "Smiley style." + :type '(choice (const :tag "small, 3 colors" low-color) ;; 13x14 + (const :tag "medium, ~10 colors" medium) ;; 16x16 + (const :tag "dull, grayscale" grayscale));; 14x14 + :set (lambda (symbol value) + (set-default symbol value) + (setq smiley-data-directory (smiley-directory)) + (smiley-update-cache)) + :initialize 'custom-initialize-default + :version "23.0" ;; No Gnus + :group 'smiley) + +;; For compatibility, honor the variable `smiley-data-directory' if the user +;; has set it. + +(defun smiley-directory (&optional style) + "Return a the location of the smiley faces files. +STYLE specifies which style to use, see `smiley-style'. If STYLE +is nil, use `smiley-style'." + (unless style (setq style smiley-style)) + (nnheader-find-etc-directory + (concat "images/smilies" + (cond ((eq smiley-style 'low-color) "") + ((eq smiley-style 'medium) "/medium") + ((eq smiley-style 'grayscale) "/grayscale"))))) + +(defcustom smiley-data-directory (smiley-directory) + "*Location of the smiley faces files." + :set (lambda (symbol value) + (set-default symbol value) + (smiley-update-cache)) + :initialize 'custom-initialize-default :type 'directory :group 'smiley) ;; The XEmacs version has a baroque, if not rococo, set of these. (defcustom smiley-regexp-alist - '(("\\(:-?)\\)\\W" 1 "smile") - ("\\(;-?)\\)\\W" 1 "blink") + '(("\\(;-?)\\)\\W" 1 "blink") ("\\(:-]\\)\\W" 1 "forced") ("\\(8-)\\)\\W" 1 "braindamaged") ("\\(:-|\\)\\W" 1 "indifferent") ("\\(:-[/\\]\\)\\W" 1 "wry") ("\\(:-(\\)\\W" 1 "sad") ("\\(X-)\\)\\W" 1 "dead") - ("\\(:-{\\)\\W" 1 "frown")) + ("\\(:-{\\)\\W" 1 "frown") + ("\\(>:-)\\)\\W" 1 "evil") + ("\\(;-(\\)\\W" 1 "cry") + ("\\(:-D\\)\\W" 1 "grin") + ;; "smile" must be come after "evil" + ("\\(\\^?:-?)\\)\\W" 1 "smile")) "*A list of regexps to map smilies to images. The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in regexp to replace with IMAGE. IMAGE is the name of an image file in diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/smime-ldap.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/smime-ldap.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,206 @@ +;;; smime-ldap.el --- client interface to LDAP for Emacs + +;; Copyright (C) 1998, 1999, 2000, 2005 Free Software Foundation, Inc. + +;; Author: Oscar Figueiredo +;; Maintainer: Arne J,Ax(Brgensen +;; Created: February 2005 +;; Keywords: comm + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file has a slightly changed implementation of Emacs 21.3's +;; ldap-search and ldap-search-internal from ldap.el. The changes are +;; made to achieve compatibility with OpenLDAP v2 and to make it +;; possible to retrieve LDAP attributes that are tagged ie ";binary". + +;; The file also adds a compatibility layer for Emacs and XEmacs. + +;;; Code: + +(require 'ldap) + +(defun smime-ldap-search (filter &optional host attributes attrsonly withdn) + "Perform an LDAP search. +FILTER is the search filter in RFC1558 syntax. +HOST is the LDAP host on which to perform the search. +ATTRIBUTES are the specific attributes to retrieve, nil means +retrieve all. +ATTRSONLY, if non-nil, retrieves the attributes only, without +the associated values. +If WITHDN is non-nil, each entry in the result will be prepended with +its distinguished name WITHDN. +Additional search parameters can be specified through +`ldap-host-parameters-alist', which see." + (interactive "sFilter:") + ;; for XEmacs + (if (fboundp 'ldap-search-entries) + (ldap-search-entries filter host attributes attrsonly) + ;; for Emacs 22 + (if (>= emacs-major-version 22) + (cdr (ldap-search filter host attributes attrsonly)) + ;; for Emacs 21.x + (or host + (setq host ldap-default-host) + (error "No LDAP host specified")) + (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) + result) + (setq result (smime-ldap-search-internal + (append host-plist + (list 'host host + 'filter filter + 'attributes attributes + 'attrsonly attrsonly + 'withdn withdn)))) + (cdr (if ldap-ignore-attribute-codings + result + (mapcar (function + (lambda (record) + (mapcar 'ldap-decode-attribute record))) + result))))))) + +(defun smime-ldap-search-internal (search-plist) + "Perform a search on a LDAP server. +SEARCH-PLIST is a property list describing the search request. +Valid keys in that list are: +`host' is a string naming one or more (blank-separated) LDAP servers to +to try to connect to. Each host name may optionally be of the form HOST:PORT. +`filter' is a filter string for the search as described in RFC 1558. +`attributes' is a list of strings indicating which attributes to retrieve +for each matching entry. If nil, return all available attributes. +`attrsonly', if non-nil, indicates that only attributes are retrieved, +not their associated values. +`base' is the base for the search as described in RFC 1779. +`scope' is one of the three symbols `sub', `base' or `one'. +`binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). +`passwd' is the password to use for simple authentication. +`deref' is one of the symbols `never', `always', `search' or `find'. +`timelimit' is the timeout limit for the connection in seconds. +`sizelimit' is the maximum number of matches to return. +`withdn' if non-nil each entry in the result will be prepended with +its distinguished name DN. +The function returns a list of matching entries. Each entry is itself +an alist of attribute/value pairs." + (let ((buf (get-buffer-create " *ldap-search*")) + (bufval (get-buffer-create " *ldap-value*")) + (host (or (plist-get search-plist 'host) + ldap-default-host)) + (filter (plist-get search-plist 'filter)) + (attributes (plist-get search-plist 'attributes)) + (attrsonly (plist-get search-plist 'attrsonly)) + (base (or (plist-get search-plist 'base) + ldap-default-base)) + (scope (plist-get search-plist 'scope)) + (binddn (plist-get search-plist 'binddn)) + (passwd (plist-get search-plist 'passwd)) + (deref (plist-get search-plist 'deref)) + (timelimit (plist-get search-plist 'timelimit)) + (sizelimit (plist-get search-plist 'sizelimit)) + (withdn (plist-get search-plist 'withdn)) + (numres 0) + arglist dn name value record result) + (if (or (null filter) + (equal "" filter)) + (error "No search filter")) + (setq filter (cons filter attributes)) + (save-excursion + (set-buffer buf) + (erase-buffer) + (if (and host + (not (equal "" host))) + (setq arglist (nconc arglist (list (format "-h%s" host))))) + (if (and attrsonly + (not (equal "" attrsonly))) + (setq arglist (nconc arglist (list "-A")))) + (if (and base + (not (equal "" base))) + (setq arglist (nconc arglist (list (format "-b%s" base))))) + (if (and scope + (not (equal "" scope))) + (setq arglist (nconc arglist (list (format "-s%s" scope))))) + (if (and binddn + (not (equal "" binddn))) + (setq arglist (nconc arglist (list (format "-D%s" binddn))))) + (if (and passwd + (not (equal "" passwd))) + (setq arglist (nconc arglist (list (format "-w%s" passwd))))) + (if (and deref + (not (equal "" deref))) + (setq arglist (nconc arglist (list (format "-a%s" deref))))) + (if (and timelimit + (not (equal "" timelimit))) + (setq arglist (nconc arglist (list (format "-l%s" timelimit))))) + (if (and sizelimit + (not (equal "" sizelimit))) + (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) + (eval `(call-process ldap-ldapsearch-prog + nil + buf + nil + ,@arglist + "-tt" ; Write values to temp files + "-x" + "-LL" + ; ,@ldap-ldapsearch-args + ,@filter)) + (insert "\n") + (goto-char (point-min)) + + (while (re-search-forward "[\t\n\f]+ " nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + + (if (looking-at "usage") + (error "Incorrect ldapsearch invocation") + (message "Parsing results... ") + (while (progn + (skip-chars-forward " \t\n") + (not (eobp))) + (setq dn (buffer-substring (point) (save-excursion + (end-of-line) + (point)))) + (forward-line 1) + (while (looking-at (concat "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+" + "\\(<[\t ]*file://\\)?\\(.*\\)$")) + (setq name (match-string 1) + value (match-string 4)) + (save-excursion + (set-buffer bufval) + (erase-buffer) + (insert-file-contents-literally value) + (delete-file value) + (setq value (buffer-substring (point-min) (point-max)))) + (setq record (cons (list name value) + record)) + (forward-line 1)) + (setq result (cons (if withdn + (cons dn (nreverse record)) + (nreverse record)) result)) + (setq record nil) + (skip-chars-forward " \t\n") + (message "Parsing results... %d" numres) + (1+ numres)) + (message "Parsing results... done") + (nreverse result))))) + +(provide 'smime-ldap) + +;; arch-tag: 87e6bc44-21fc-4e9b-a89b-f55f031f78f8 +;;; smime-ldap.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/smime.el --- a/lisp/gnus/smime.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/smime.el Sun Oct 28 09:18:39 2007 +0000 @@ -28,7 +28,7 @@ ;; This library perform S/MIME operations from within Emacs. ;; ;; Functions for fetching certificates from public repositories are -;; provided, currently only from DNS. LDAP support (via EUDC) is planned. +;; provided, currently from DNS and LDAP. ;; ;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing, ;; encryption and decryption. @@ -117,12 +117,28 @@ ;; 2000-06-05 initial version, committed to Gnus CVS contrib/ ;; 2000-10-28 retrieve certificates via DNS CERT RRs ;; 2001-10-14 posted to gnu.emacs.sources +;; 2005-02-13 retrieve certificates via LDAP ;;; Code: (require 'dig) +(require 'smime-ldap) +(require 'password) (eval-when-compile (require 'cl)) +(eval-and-compile + (cond + ((fboundp 'replace-in-string) + (defalias 'smime-replace-in-string 'replace-in-string)) + ((fboundp 'replace-regexp-in-string) + (defun smime-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." + (replace-regexp-in-string regexp newtext string nil literal))))) + (defgroup smime nil "S/MIME configuration." :group 'mime) @@ -218,6 +234,14 @@ string) :group 'smime) +(defcustom smime-ldap-host-list nil + "A list of LDAP hosts with S/MIME user certificates. +If needed search base, binddn, passwd, etc. for the LDAP host +must be set in `ldap-host-parameters-alist'." + :type '(repeat (string :tag "Host name")) + :version "23.0" ;; No Gnus + :group 'smime) + (defvar smime-details-buffer "*OpenSSL output*") ;; Use mm-util? @@ -234,11 +258,13 @@ ;; Password dialog function -(defun smime-ask-passphrase () - "Asks the passphrase to unlock the secret key." +(defun smime-ask-passphrase (&optional cache-key) + "Asks the passphrase to unlock the secret key. +If `cache-key' and `password-cache' is non-nil then cache the +password under `cache-key'." (let ((passphrase - (read-passwd - "Passphrase for secret key (RET for no passphrase): "))) + (password-read-and-add + "Passphrase for secret key (RET for no passphrase): " cache-key))) (if (string= passphrase "") nil passphrase))) @@ -270,11 +296,11 @@ included, KEYFILE may be the file containing the PEM encoded private key and certificate itself." (smime-new-details-buffer) - (let ((keyfile (or (car-safe keyfile) keyfile)) - (certfiles (and (cdr-safe keyfile) (cadr keyfile))) - (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) - (passphrase (smime-ask-passphrase)) - (tmpfile (smime-make-temp-file "smime"))) + (let* ((certfiles (and (cdr-safe keyfile) (cadr keyfile))) + (keyfile (or (car-safe keyfile) keyfile)) + (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) + (passphrase (smime-ask-passphrase (expand-file-name keyfile))) + (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (prog1 @@ -408,7 +434,7 @@ in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) - CAs (passphrase (smime-ask-passphrase)) + CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) @@ -521,20 +547,13 @@ (caddr curkey) (smime-get-certfiles keyfile otherkeys))))) -;; Use mm-util? -(eval-and-compile - (defalias 'smime-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - (defun smime-buffer-as-string-region (b e) "Return each line in region between B and E as a list of strings." (save-excursion (goto-char b) (let (res) (while (< (point) e) - (let ((str (buffer-substring (point) (smime-point-at-eol)))) + (let ((str (buffer-substring (point) (point-at-eol)))) (unless (string= "" str) (push str res))) (forward-line)) @@ -548,6 +567,7 @@ mailaddr)) (defun smime-cert-by-dns (mail) + "Find certificate via DNS for address MAIL." (let* ((dig-dns-server smime-dns-server) (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc")) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) @@ -568,6 +588,50 @@ (kill-buffer digbuf) retbuf)) +(defun smime-cert-by-ldap-1 (mail host) + "Get cetificate for MAIL from the ldap server at HOST." + (let ((ldapresult (smime-ldap-search (concat "mail=" mail) + host '("userCertificate") nil)) + (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) + cert) + (if (and (>= (length ldapresult) 1) + (> (length (cadaar ldapresult)) 0)) + (with-current-buffer retbuf + ;; Certificates on LDAP servers _should_ be in DER format, + ;; but there are some servers out there that distributes the + ;; certificates in PEM format (with or without + ;; header/footer) so we try to handle them anyway. + (if (or (string= (substring (cadaar ldapresult) 0 27) + "-----BEGIN CERTIFICATE-----") + (string= (substring (cadaar ldapresult) 0 3) + "MII")) + (setq cert + (smime-replace-in-string + (cadaar ldapresult) + (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" + "-----END CERTIFICATE-----\\)") + "" t)) + (setq cert (base64-encode-string (cadaar ldapresult) t))) + (insert "-----BEGIN CERTIFICATE-----\n") + (let ((i 0) (len (length cert))) + (while (> (- len 64) i) + (insert (substring cert i (+ i 64)) "\n") + (setq i (+ i 64))) + (insert (substring cert i len) "\n")) + (insert "-----END CERTIFICATE-----\n")) + (kill-buffer retbuf) + (setq retbuf nil)) + retbuf)) + +(defun smime-cert-by-ldap (mail) + "Find certificate via LDAP for address MAIL." + (if smime-ldap-host-list + (catch 'certbuf + (dolist (host smime-ldap-host-list) + (let ((retbuf (smime-cert-by-ldap-1 mail host))) + (when retbuf + (throw 'certbuf retbuf))))))) + ;; User interface. (defvar smime-buffer "*SMIME*") diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/spam-report.el --- a/lisp/gnus/spam-report.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/spam-report.el Sun Oct 28 09:18:39 2007 +0000 @@ -2,8 +2,8 @@ ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. -;; Author: Teodor Zlatanov -;; Keywords: network +;; Author: Ted Zlatanov +;; Keywords: network, spam, mail, gmane, report ;; This file is part of GNU Emacs. @@ -80,26 +80,92 @@ :type 'file :group 'spam-report) +(defcustom spam-report-resend-to nil + "Email address that spam articles are resent to when reporting. +If not set, the user will be prompted to enter a value which will be +saved for future use." + :type 'string + :group 'spam-report) + (defvar spam-report-url-ping-temp-agent-function nil "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. This variable will store the value of `spam-report-url-ping-function' from before `spam-report-agentize' was run, so that `spam-report-deagentize' can undo that change.") -(defun spam-report-gmane (&rest articles) - "Report an article as spam through Gmane" +(defun spam-report-resend (articles &optional ham) + "Report an article as spam by resending via email. +Reports is as ham when HAM is set." + (dolist (article articles) + (gnus-message 6 + "Reporting %s article %d to <%s>..." + (if ham "ham" "spam") + article spam-report-resend-to) + (unless spam-report-resend-to + (customize-set-variable + spam-report-resend-to + (read-from-minibuffer "email address to resend SPAM/HAM to? "))) + ;; This is ganked from the `gnus-summary-resend-message' function. + ;; It involves rendering the SPAM, which is undesirable, but there does + ;; not seem to be a nicer way to achieve this. + ;; select this particular article + (gnus-summary-select-article nil nil nil article) + ;; resend it to the destination address + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-resend spam-report-resend-to)))) + +(defun spam-report-resend-ham (articles) + "Report an article as ham by resending via email." + (spam-report-resend articles t)) + +(defun spam-report-gmane-ham (&rest articles) + "Report ARTICLES as ham (unregister) through Gmane." + (interactive (gnus-summary-work-articles current-prefix-arg)) + (dolist (article articles) + (spam-report-gmane-internal t article))) + +(defun spam-report-gmane-spam (&rest articles) + "Report ARTICLES as spam through Gmane." + (interactive (gnus-summary-work-articles current-prefix-arg)) (dolist (article articles) - (when (and gnus-newsgroup-name - (or (null spam-report-gmane-regex) - (string-match spam-report-gmane-regex gnus-newsgroup-name))) - (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article) - (if spam-report-gmane-use-article-number - (spam-report-url-ping - "spam.gmane.org" - (format "/%s:%d" - (gnus-group-real-name gnus-newsgroup-name) - article)) + (spam-report-gmane-internal nil article))) + +;; `spam-report-gmane' was an interactive entry point, so we should provide an +;; alias. +(defalias 'spam-report-gmane 'spam-report-gmane-spam) + +(defun spam-report-gmane-internal (unspam article) + "Report ARTICLE as spam or not-spam through Gmane, depending on UNSPAM." + (when (and gnus-newsgroup-name + (or (null spam-report-gmane-regex) + (string-match spam-report-gmane-regex gnus-newsgroup-name))) + (let ((rpt-host (if unspam "unspam.gmane.org" "spam.gmane.org"))) + (gnus-message 6 "Reporting article %d to %s..." article rpt-host) + (cond + ;; Special-case nnweb groups -- these have the URL to use in + ;; the Xref headers. + ((eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnweb) + (spam-report-url-ping + rpt-host + (concat + "/" + (gnus-replace-in-string + (gnus-replace-in-string + (gnus-replace-in-string + (mail-header-xref (gnus-summary-article-header article)) + "/raw" ":silent") + "^.*article.gmane.org/" "") + "/" ":")))) + (spam-report-gmane-use-article-number + (spam-report-url-ping + rpt-host + (format "/%s:%d" + (gnus-group-real-name gnus-newsgroup-name) + article))) + (t (with-current-buffer nntp-server-buffer + (erase-buffer) (gnus-request-head article gnus-newsgroup-name) (let ((case-fold-search t) field host report url) @@ -111,25 +177,33 @@ ;; There might be more than one Archived-At header so we need to ;; find (and transform) the one related to Gmane. (setq field (or (gnus-fetch-field "X-Report-Spam") + (gnus-fetch-field "X-Report-Unspam") (gnus-fetch-field "Archived-At"))) - (setq host (progn - (string-match - (concat "http://\\([a-z]+\\.gmane\\.org\\)" - "\\(/[^:/]+[:/][0-9]+\\)") - field) - (match-string 1 field))) - (setq report (match-string 2 field)) - (when (string-equal "permalink.gmane.org" host) - (setq host "spam.gmane.org") - (setq report (gnus-replace-in-string - report "/\\([0-9]+\\)$" ":\\1"))) - (setq url (format "http://%s%s" host report)) + (if (not (stringp field)) + (if (and (setq field (gnus-fetch-field "Xref")) + (string-match "[^ ]+ +\\([^ ]+\\)" field)) + (setq report (concat "/" (match-string 1 field)) + host rpt-host)) + (setq host + (progn + (string-match + (concat "http://\\([a-z]+\\.gmane\\.org\\)" + "\\(/[^:/]+[:/][0-9]+\\)") + field) + (match-string 1 field))) + (setq report (match-string 2 field))) + (when host + (when (string-equal "permalink.gmane.org" host) + (setq host rpt-host) + (setq report (gnus-replace-in-string + report "/\\([0-9]+\\)$" ":\\1"))) + (setq url (format "http://%s%s" host report))) (if (not (and host report url)) (gnus-message 3 "Could not find a spam report header in article %d..." article) - (gnus-message 7 "Reporting spam through URL %s..." url) - (spam-report-url-ping host report)))))))) + (gnus-message 7 "Reporting article through URL %s..." url) + (spam-report-url-ping host report))))))))) (defun spam-report-url-ping (host report) "Ping a host through HTTP, addressing a specific GET resource using @@ -139,6 +213,24 @@ ;; report: "/gmane.some.group:123456" (funcall spam-report-url-ping-function host report)) +(defcustom spam-report-user-mail-address + (and (stringp user-mail-address) + (gnus-replace-in-string user-mail-address "@" "")) + "Mail address of this user used for spam reports to Gmane. +This is initialized based on `user-mail-address'." + :type '(choice string + (const :tag "Don't expose address" nil)) + :version "23.0" ;; No Gnus + :group 'spam-report) + +(defvar spam-report-user-agent + (if spam-report-user-mail-address + (format "%s (%s) %s" "spam-report.el" + spam-report-user-mail-address + (gnus-extended-version)) + (format "%s %s" "spam-report.el" + (gnus-extended-version)))) + (defun spam-report-url-ping-plain (host report) "Ping a host through HTTP, addressing a specific GET resource." (let ((tcp-connection)) @@ -153,8 +245,12 @@ (set-marker (process-mark tcp-connection) (point-min)) (process-send-string tcp-connection - (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n" - report (gnus-extended-version) host))))) + (format "GET %s HTTP/1.1\nUser-Agent: %s\nHost: %s\n\n" + report spam-report-user-agent host)) + ;; Wait until we get something so we don't DOS the host. + (while (and (memq (process-status tcp-connection) '(open run)) + (zerop (buffer-size))) + (accept-process-output tcp-connection))))) ;;;###autoload (defun spam-report-process-queue (&optional file keep) @@ -183,7 +279,7 @@ (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward - "http://\\([^/]+\\)\\(/.*\\) *$" (gnus-point-at-eol) t)) + "http://\\([^/]+\\)\\(/.*\\) *$" (point-at-eol) t)) (funcall spam-report-url-ping-function (match-string 1) (match-string 2)) (forward-line 1)) (if (or (eq keep nil) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/spam-stat.el --- a/lisp/gnus/spam-stat.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/spam-stat.el Sun Oct 28 09:18:39 2007 +0000 @@ -122,6 +122,7 @@ ;;; Code: +(require 'mail-parse) (defvar gnus-original-article-buffer) @@ -163,17 +164,53 @@ :group 'spam-stat) (defcustom spam-stat-split-fancy-spam-group "mail.spam" - "Name of the group where spam should be stored, if -`spam-stat-split-fancy' is used in fancy splitting rules. Has no -effect when spam-stat is invoked through spam.el." + "Name of the group where spam should be stored. +If `spam-stat-split-fancy' is used in fancy splitting rules. Has +no effect when spam-stat is invoked through spam.el." :type 'string :group 'spam-stat) -(defcustom spam-stat-split-fancy-spam-threshhold 0.9 - "Spam score threshhold in spam-stat-split-fancy." +(defcustom spam-stat-split-fancy-spam-threshold 0.9 + "Spam score threshold in spam-stat-split-fancy." :type 'number :group 'spam-stat) +(defcustom spam-stat-washing-hook nil + "Hook applied to each message before analysis." + :type 'hook + :group 'spam-stat) + +(defcustom spam-stat-score-buffer-user-functions nil + "List of additional scoring functions. +Called one by one on the buffer. + +If all of these functions return non-nil answers, these numerical +answers are added to the computed spam stat score on the buffer. If +you defun such functions, make sure they don't return the buffer in a +narrowed state or such: use, for example, `save-excursion'. Each of +your functions is also passed the initial spam-stat score which might +aid in your scoring. + +Also be careful when defining such functions. If they take a long +time, they will slow down your mail splitting. Thus, if the buffer is +large, don't forget to use smaller regions, by wrapping your work in, +say, `with-spam-stat-max-buffer-size'." + :type '(repeat sexp) + :group 'spam-stat) + +(defcustom spam-stat-process-directory-age 90 + "Max. age of files to be processed in directory, in days. +When using `spam-stat-process-spam-directory' or +`spam-stat-process-non-spam-directory', only files that have +been touched in this many days will be considered. Without +this filter, re-training spam-stat with several thousand messages +will start to take a very long time." + :type 'number + :group 'spam-stat) + +(defvar spam-stat-last-saved-at nil + "Time stamp of last change of spam-stat-file on this run") + (defvar spam-stat-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?- "w" table) @@ -196,52 +233,24 @@ (defvar spam-stat-buffer-name " *spam stat buffer*" "Name of the `spam-stat-buffer'.") -;; Functions missing in Emacs 20 - -(when (memq nil (mapcar 'fboundp - '(gethash hash-table-count make-hash-table - mapc puthash))) - (require 'cl) - (unless (fboundp 'puthash) - ;; alias puthash is missing from Emacs 20 cl-extra.el - (defalias 'puthash 'cl-puthash))) - -(eval-when-compile - (unless (fboundp 'with-syntax-table) - ;; Imported from Emacs 21.2 - (defmacro with-syntax-table (table &rest body) "\ -Evaluate BODY with syntax table of current buffer set to a copy of TABLE. -The syntax table of the current buffer is saved, BODY is evaluated, and the -saved table is restored, even in case of an abnormal exit. -Value is what BODY returns." - (let ((old-table (make-symbol "table")) - (old-buffer (make-symbol "buffer"))) - `(let ((,old-table (syntax-table)) - (,old-buffer (current-buffer))) - (unwind-protect - (progn - (set-syntax-table (copy-syntax-table ,table)) - ,@body) - (save-current-buffer - (set-buffer ,old-buffer) - (set-syntax-table ,old-table)))))))) +(defvar spam-stat-coding-system + (if (mm-coding-system-p 'emacs-mule) 'emacs-mule 'raw-text) + "Coding system used for `spam-stat-file'.") ;; Hooking into Gnus (defun spam-stat-store-current-buffer () "Store a copy of the current buffer in `spam-stat-buffer'." - (save-excursion - (let ((str (buffer-string))) - (set-buffer (get-buffer-create spam-stat-buffer-name)) + (let ((buf (current-buffer))) + (with-current-buffer (get-buffer-create spam-stat-buffer-name) (erase-buffer) - (insert str) + (insert-buffer-substring buf) (setq spam-stat-buffer (current-buffer))))) (defun spam-stat-store-gnus-article-buffer () "Store a copy of the current article in `spam-stat-buffer'. This uses `gnus-article-buffer'." - (save-excursion - (set-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer (spam-stat-store-current-buffer))) ;; Data -- not using defstruct in order to save space and time @@ -259,6 +268,9 @@ (defvar spam-stat-nbad 0 "The number of bad mails in the dictionary.") +(defvar spam-stat-error-holder nil + "A holder for condition-case errors while scoring buffers.") + (defsubst spam-stat-good (entry) "Return the number of times this word belongs to good mails." (aref entry 0)) @@ -313,7 +325,7 @@ ;; Parsing (defmacro with-spam-stat-max-buffer-size (&rest body) - "Narrows the buffer down to the first 4k characters, then evaluates BODY." + "Narrow the buffer down to the first 4k characters, then evaluate BODY." `(save-restriction (when (> (- (point-max) (point-min)) @@ -324,6 +336,7 @@ (defun spam-stat-buffer-words () "Return a hash table of words and number of occurrences in the buffer." + (run-hooks 'spam-stat-washing-hook) (with-spam-stat-max-buffer-size (with-syntax-table spam-stat-syntax-table (goto-char (point-min)) @@ -372,7 +385,7 @@ (lambda (word count) (let ((entry (gethash word spam-stat))) (if (not entry) - (error "This buffer has unknown words in it") + (gnus-message 8 "This buffer has unknown words in it") (spam-stat-set-good entry (- (spam-stat-good entry) count)) (spam-stat-set-bad entry (+ (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry)) @@ -388,7 +401,7 @@ (lambda (word count) (let ((entry (gethash word spam-stat))) (if (not entry) - (error "This buffer has unknown words in it") + (gnus-message 8 "This buffer has unknown words in it") (spam-stat-set-good entry (+ (spam-stat-good entry) count)) (spam-stat-set-bad entry (- (spam-stat-bad entry) count)) (spam-stat-set-score entry (spam-stat-compute-score entry)) @@ -403,28 +416,38 @@ With a prefix argument save unconditionally." (interactive "P") (when (or force spam-stat-dirty) - (with-temp-buffer - (let ((standard-output (current-buffer)) - (font-lock-maximum-size 0)) - (insert "(setq spam-stat-ngood " - (number-to-string spam-stat-ngood) - " spam-stat-nbad " - (number-to-string spam-stat-nbad) - " spam-stat (spam-stat-to-hash-table '(") - (maphash (lambda (word entry) - (prin1 (list word - (spam-stat-good entry) - (spam-stat-bad entry)))) - spam-stat) - (insert ")))") - (write-file spam-stat-file))) - (setq spam-stat-dirty nil))) + (let ((coding-system-for-write spam-stat-coding-system)) + (with-temp-file spam-stat-file + (let ((standard-output (current-buffer)) + (font-lock-maximum-size 0)) + (insert (format ";-*- coding: %s; -*-\n" spam-stat-coding-system)) + (insert (format "(setq spam-stat-ngood %d spam-stat-nbad %d +spam-stat (spam-stat-to-hash-table '(" spam-stat-ngood spam-stat-nbad)) + (maphash (lambda (word entry) + (prin1 (list word + (spam-stat-good entry) + (spam-stat-bad entry)))) + spam-stat) + (insert ")))")))) + (message "Saved %s." spam-stat-file) + (setq spam-stat-dirty nil + spam-stat-last-saved-at (nth 5 (file-attributes spam-stat-file))))) (defun spam-stat-load () "Read the `spam-stat' hash table from disk." ;; TODO: maybe we should warn the user if spam-stat-dirty is t? - (load-file spam-stat-file) - (setq spam-stat-dirty nil)) + (let ((coding-system-for-read spam-stat-coding-system)) + (cond (spam-stat-dirty (message "Spam stat not loaded: spam-stat-dirty t")) + ((or (not (boundp 'spam-stat-last-saved-at)) + (null spam-stat-last-saved-at) + (not (equal spam-stat-last-saved-at + (nth 5 (file-attributes spam-stat-file))))) + (progn + (load-file spam-stat-file) + (setq spam-stat-dirty nil + spam-stat-last-saved-at + (nth 5 (file-attributes spam-stat-file))))) + (t (message "Spam stat file not loaded: no change in disk.."))))) (defun spam-stat-to-hash-table (entries) "Turn list ENTRIES into a hash table and store as `spam-stat'. @@ -433,7 +456,8 @@ NBAD is the number of bad mails it has appeared in, GOOD is the number of times it appeared in good mails, and BAD is the number of times it has appeared in bad mails." - (let ((table (make-hash-table :test 'equal))) + (let ((table (make-hash-table :size (length entries) + :test 'equal))) (mapc (lambda (l) (puthash (car l) (spam-stat-make-entry (nth 1 l) (nth 2 l)) @@ -466,46 +490,73 @@ These are the words whose spam-stat differs the most from 0.5. The list returned contains elements of the form \(WORD SCORE DIFF), where DIFF is the difference between SCORE and 0.5." - (with-spam-stat-max-buffer-size - (with-syntax-table spam-stat-syntax-table - (let (result word score) - (maphash (lambda (word ignore) - (setq score (spam-stat-score-word word) - result (cons (list word score (abs (- score 0.5))) - result))) - (spam-stat-buffer-words)) - (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a))))) - (setcdr (nthcdr 14 result) nil) - result)))) + (let (result word score) + (maphash (lambda (word ignore) + (setq score (spam-stat-score-word word) + result (cons (list word score (abs (- score 0.5))) + result))) + (spam-stat-buffer-words)) + (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a))))) + (setcdr (nthcdr 14 result) nil) + result)) (defun spam-stat-score-buffer () - "Return a score describing the spam-probability for this buffer." + "Return a score describing the spam-probability for this buffer. +Add user supplied modifications if supplied." + (interactive) ; helps in debugging. (setq spam-stat-score-data (spam-stat-buffer-words-with-scores)) - (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data)) - (prod (apply #'* probs))) - (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) - probs)))))) + (let* ((probs (mapcar 'cadr spam-stat-score-data)) + (prod (apply #'* probs)) + (score0 + (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) + probs))))) + (score1s + (condition-case + spam-stat-error-holder + (spam-stat-score-buffer-user score0) + (error nil))) + (ans + (if score1s (+ score0 score1s) score0))) + (when (interactive-p) + (message "%S" ans)) + ans)) + +(defun spam-stat-score-buffer-user (&rest args) + (let* ((scores + (mapcar + (lambda (fn) + (apply fn args)) + spam-stat-score-buffer-user-functions))) + (if (memq nil scores) nil + (apply #'+ scores)))) (defun spam-stat-split-fancy () "Return the name of the spam group if the current mail is spam. Use this function on `nnmail-split-fancy'. If you are interested in the raw data used for the last run of `spam-stat-score-buffer', check the variable `spam-stat-score-data'." - (condition-case var + (condition-case spam-stat-error-holder (progn (set-buffer spam-stat-buffer) (goto-char (point-min)) - (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshhold) + (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshold) (when (boundp 'nnmail-split-trace) (mapc (lambda (entry) (push entry nnmail-split-trace)) spam-stat-score-data)) spam-stat-split-fancy-spam-group)) - (error (message "Error in spam-stat-split-fancy: %S" var) + (error (message "Error in spam-stat-split-fancy: %S" spam-stat-error-holder) nil))) ;; Testing +(defun spam-stat-strip-xref () + "Strip the the Xref header." + (save-restriction + (mail-narrow-to-head) + (when (re-search-forward "^Xref:.*\n" nil t) + (delete-region (match-beginning 0) (match-end 0))))) + (defun spam-stat-process-directory (dir func) "Process all the regular files in directory DIR using function FUNC." (let* ((files (directory-files dir t "^[^.]")) @@ -515,10 +566,13 @@ (dolist (f files) (when (and (file-readable-p f) (file-regular-p f) - (> (nth 7 (file-attributes f)) 0)) + (> (nth 7 (file-attributes f)) 0) + (< (time-to-number-of-days (time-since (nth 5 (file-attributes f)))) + spam-stat-process-directory-age)) (setq count (1+ count)) (message "Reading %s: %.2f%%" dir (/ count max)) - (insert-file-contents f) + (insert-file-contents-literally f) + (spam-stat-strip-xref) (funcall func) (erase-buffer)))))) @@ -537,13 +591,19 @@ (interactive) (hash-table-count spam-stat)) -(defun spam-stat-test-directory (dir) +(defun spam-stat-test-directory (dir &optional verbose) "Test all the regular files in directory DIR for spam. If the result is 1.0, then all files are considered spam. If the result is 0.0, non of the files is considered spam. -You can use this to determine error rates." - (interactive "D") +You can use this to determine error rates. + +If VERBOSE is non-nil display names of files detected as spam or +non-spam in a temporary buffer. If it is the symbol `ham', +display non-spam files; otherwise display spam files." + (interactive "DDirectory: ") (let* ((files (directory-files dir t "^[^.]")) + display-files + buffer-score (total (length files)) (score 0.0); float (max (/ total 100.0)); float @@ -554,12 +614,22 @@ (file-regular-p f) (> (nth 7 (file-attributes f)) 0)) (setq count (1+ count)) - (message "Reading %.2f%%, score %.2f%%" - (/ count max) (/ score count)) - (insert-file-contents f) - (when (> (spam-stat-score-buffer) 0.9) + (message "Reading %.2f%%, score %.2f" + (/ count max) (/ score count)) + (insert-file-contents-literally f) + (setq buffer-score (spam-stat-score-buffer)) + (when (> buffer-score 0.9) (setq score (1+ score))) + (when verbose + (if (> buffer-score 0.9) + (unless (eq verbose 'ham) (push f display-files)) + (when (eq verbose 'ham) (push f display-files)))) (erase-buffer)))) + (when display-files + (with-output-to-temp-buffer "*spam-stat results*" + (dolist (file display-files) + (princ file) + (terpri)))) (message "Final score: %d / %d = %f" score total (/ score total)))) ;; Shrinking the dictionary @@ -579,7 +649,7 @@ (setq spam-stat-dirty t)) (defun spam-stat-install-hooks-function () - "Install the spam-stat function hooks" + "Install the spam-stat function hooks." (interactive) (add-hook 'nnmail-prepare-incoming-message-hook 'spam-stat-store-current-buffer) @@ -590,7 +660,7 @@ (spam-stat-install-hooks-function)) (defun spam-stat-unload-hook () - "Uninstall the spam-stat function hooks" + "Uninstall the spam-stat function hooks." (interactive) (remove-hook 'nnmail-prepare-incoming-message-hook 'spam-stat-store-current-buffer) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/spam-wash.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/spam-wash.el Sun Oct 28 09:18:39 2007 +0000 @@ -0,0 +1,75 @@ +;;; spam-wash.el --- wash spam before analysis + +;; Copyright (C) 2004 Free Software Foundation, Inc. + +;; Author: Andrew Cohen +;; Keywords: mail + +;; This file is part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This library decodes MIME encodings such as base64 and +;; quoted-printable to allow for better spam analysis. +;; +;; `spam-wash' should be called in a buffer containing the message. + +;;; Code: + +(require 'gnus-art) + +(defun spam-wash () + "Treat the current buffer prior to spam analysis." + (interactive) + (run-hooks 'gnus-article-decode-hook) + (save-excursion + (save-restriction + (let* ((buffer-read-only nil) + (gnus-inhibit-treatment t) + (gnus-article-buffer (current-buffer)) + (handles (or (mm-dissect-buffer nil gnus-article-loose-mime) + (and gnus-article-emulate-mime + (mm-uu-dissect)))) + handle) + (when gnus-article-mime-handles + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handle-alist nil)) + (setq gnus-article-mime-handles handles) + (when (and handles + (or (not (stringp (car handles))) + (cdr handles))) + (article-goto-body) + (delete-region (point) (point-max)) + (spam-treat-parts handles)))))) + +(defun spam-treat-parts (handle) + (if (stringp (car handle)) + (mapcar 'spam-treat-parts (cdr handle)) + (if (bufferp (car handle)) + (save-restriction + (narrow-to-region (point) (point)) + (when (let ((case-fold-search t)) + (string-match "text" (car (mm-handle-type handle)))) + (mm-insert-part handle)) + (goto-char (point-max))) + (mapcar 'spam-treat-parts handle)))) + +(provide 'spam-wash) + +;;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f +;;; spam-wash.el ends here diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/spam.el --- a/lisp/gnus/spam.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/spam.el Sun Oct 28 09:18:39 2007 +0000 @@ -3,7 +3,8 @@ ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: network +;; Maintainer: Ted Zlatanov +;; Keywords: network, spam, mail, bogofilter, BBDB, dspam, dig, whitelist, blacklist, gmane, hashcash, spamassassin, bsfilter, ifile, stat, crm114, spamoracle ;; This file is part of GNU Emacs. @@ -33,12 +34,15 @@ ;;; Several TODO items are marked as such -;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, -;; remote processing, training through files +;; TODO: cross-server splitting, remote processing, training through files ;;; Code: +;;{{{ compilation directives and autoloads/requires + (eval-when-compile (require 'cl)) +(eval-when-compile (require 'spam-report)) +(eval-when-compile (require 'hashcash)) (require 'gnus-sum) @@ -50,18 +54,16 @@ ;; for nnimap-split-download-body-default (eval-when-compile (require 'nnimap)) -;; autoload executable-find -(eval-and-compile - ;; executable-find is not autoloaded in Emacs 20 - (autoload 'executable-find "executable")) - ;; autoload query-dig (eval-and-compile (autoload 'query-dig "dig")) ;; autoload spam-report (eval-and-compile - (autoload 'spam-report-gmane "spam-report")) + (autoload 'spam-report-gmane "spam-report") + (autoload 'spam-report-gmane-spam "spam-report") + (autoload 'spam-report-gmane-ham "spam-report") + (autoload 'spam-report-resend "spam-report")) ;; autoload gnus-registry (eval-and-compile @@ -74,7 +76,12 @@ (eval-and-compile (autoload 'query-dns "dns")) -;;; Main parameters. +;;}}} + +;;{{{ Main parameters. +(defvar spam-backends nil + "List of spam.el backends with all the pertinent data. +Populated by spam-install-backend-super.") (defgroup spam nil "Spam configuration." @@ -82,24 +89,23 @@ :group 'mail :group 'news) +(defcustom spam-summary-exit-behavior 'default + "Exit behavior at the time of summary exit. +Note that setting the spam-use-move or spam-use-copy backends on +a group through group/topic parameters overrides this mechanism." + :type '(choice (const 'default :tag + "Move spam out of all groups. Move ham out of spam groups.") + (const 'move-all :tag + "Move spam out of all groups. Move ham out of all groups.") + (const 'move-none :tag + "Never move spam or ham out of any groups.")) + :group 'spam) + (defcustom spam-directory (nnheader-concat gnus-directory "spam/") "Directory for spam whitelists and blacklists." :type 'directory :group 'spam) -(defcustom spam-move-spam-nonspam-groups-only t - "Whether spam should be moved in non-spam groups only. -When t, only ham and unclassified groups will have their spam moved -to the spam-process-destination. When nil, spam will also be moved from -spam groups." - :type 'boolean - :group 'spam) - -(defcustom spam-process-ham-in-nonham-groups nil - "Whether ham should be processed in non-ham groups." - :type 'boolean - :group 'spam) - (defcustom spam-mark-new-messages-in-spam-group-as-spam t "Whether new messages in a spam group should get the spam-mark." :type 'boolean @@ -123,11 +129,6 @@ :type 'boolean :group 'spam) -(defcustom spam-process-ham-in-spam-groups nil - "Whether ham should be processed in spam groups." - :type 'boolean - :group 'spam) - (defcustom spam-mark-only-unseen-as-spam t "Whether only unseen articles should be marked as spam in spam groups. When nil, all unread articles in a spam group are marked as @@ -145,9 +146,9 @@ :group 'spam) (defcustom spam-disable-spam-split-during-ham-respool nil - "Whether `spam-split' should be ignored while resplitting ham in a process -destination. This is useful to prevent ham from ending up in the same spam -group after the resplit. Don't set this to t if you have spam-split as the + "Whether `spam-split' should be ignored while resplitting ham. +This is useful to prevent ham from ending up in the same spam +group after the resplit. Don't set this to t if you have `spam-split' as the last rule in your split configuration." :type 'boolean :group 'spam) @@ -177,6 +178,11 @@ :type 'boolean :group 'spam) +(defcustom spam-use-gmane-xref nil + "Whether the Gmane spam xref should be used by `spam-split'." + :type 'boolean + :group 'spam) + (defcustom spam-use-blacklist nil "Whether the blacklist should be used by `spam-split'." :type 'boolean @@ -233,6 +239,18 @@ :type 'boolean :group 'spam) +(defcustom spam-use-bsfilter-headers nil + "Whether bsfilter headers should be used by `spam-split'. +Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bsfilter nil + "Whether bsfilter should be invoked by `spam-split'. +Enable this if you want Gnus to invoke Bsfilter on new messages." + :type 'boolean + :group 'spam) + (defcustom spam-use-BBDB nil "Whether BBDB should be used by `spam-split'." :type 'boolean @@ -260,8 +278,27 @@ :type 'boolean :group 'spam) +(defcustom spam-use-spamassassin nil + "Whether spamassassin should be invoked by `spam-split'. +Enable this if you want Gnus to invoke SpamAssassin on new messages." + :type 'boolean + :group 'spam) + +(defcustom spam-use-spamassassin-headers nil + "Whether spamassassin headers should be checked by `spam-split'. +Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees +them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-crm114 nil + "Whether the CRM114 Mailfilter should be used by `spam-split'." + :type 'boolean + :group 'spam) + (defcustom spam-install-hooks (or spam-use-dig + spam-use-gmane-xref spam-use-blacklist spam-use-whitelist spam-use-whitelist-exclusive @@ -269,13 +306,18 @@ spam-use-hashcash spam-use-regex-headers spam-use-regex-body + spam-use-bogofilter spam-use-bogofilter-headers - spam-use-bogofilter + spam-use-spamassassin + spam-use-spamassassin-headers + spam-use-bsfilter + spam-use-bsfilter-headers spam-use-BBDB spam-use-BBDB-exclusive spam-use-ifile spam-use-stat - spam-use-spamoracle) + spam-use-spamoracle + spam-use-crm114) "Whether the spam hooks should be installed. Default to t if one of the spam-use-* variables is set." :group 'spam @@ -296,14 +338,23 @@ :type '(repeat (string :tag "Group")) :group 'spam) + +(defcustom spam-gmane-xref-spam-group "gmane.spam.detected" + "The group where spam xrefs can be found on Gmane. +Only meaningful if you enable `spam-use-gmane-xref'." + :type 'string + :group 'spam) + (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" "relays.visi.com") - "List of blackhole servers." + "List of blackhole servers. +Only meaningful if you enable `spam-use-blackholes'." :type '(repeat (string :tag "Server")) :group 'spam) (defcustom spam-blackhole-good-server-regex nil - "String matching IP addresses that should not be checked in the blackholes." + "String matching IP addresses that should not be checked in the blackholes. +Only meaningful if you enable `spam-use-blackholes'." :type '(radio (const nil) regexp) :group 'spam) @@ -328,25 +379,37 @@ :group 'spam) (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") - "Regular expression for positive header spam matches." + "Regular expression for positive header spam matches. +Only meaningful if you enable `spam-use-regex-headers'." :type '(repeat (regexp :tag "Regular expression to match spam header")) :group 'spam) (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") - "Regular expression for positive header ham matches." + "Regular expression for positive header ham matches. +Only meaningful if you enable `spam-use-regex-headers'." :type '(repeat (regexp :tag "Regular expression to match ham header")) :group 'spam) (defcustom spam-regex-body-spam '() - "Regular expression for positive body spam matches." + "Regular expression for positive body spam matches. +Only meaningful if you enable `spam-use-regex-body'." :type '(repeat (regexp :tag "Regular expression to match spam body")) :group 'spam) (defcustom spam-regex-body-ham '() - "Regular expression for positive body ham matches." + "Regular expression for positive body ham matches. +Only meaningful if you enable `spam-use-regex-body'." :type '(repeat (regexp :tag "Regular expression to match ham body")) :group 'spam) +(defcustom spam-summary-score-preferred-header nil + "Preferred header to use for spam-summary-score." + :type '(choice :tag "Header name" + (symbol :tag "SpamAssassin etc" X-Spam-Status) + (symbol :tag "Bogofilter" X-Bogosity) + (const :tag "No preference, take best guess." nil)) + :group 'spam) + (defgroup spam-ifile nil "Spam ifile configuration." :group 'spam) @@ -398,6 +461,8 @@ (const :tag "Bogofilter is not installed")) :group 'spam-bogofilter) +(defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?") + (defcustom spam-bogofilter-header "X-Bogosity" "The header that Bogofilter inserts in messages." :type 'string @@ -436,6 +501,55 @@ (const :tag "Use the default")) :group 'spam-bogofilter) +(defgroup spam-bsfilter nil + "Spam bsfilter configuration." + :group 'spam) + +(make-obsolete-variable 'spam-bsfilter-path 'spam-bsfilter-program) +;; "22.1" ;; Gnus 5.10.9 +(defcustom spam-bsfilter-program (executable-find "bsfilter") + "Name of the Bsfilter program." + :type '(choice (file :tag "Location of bsfilter") + (const :tag "Bsfilter is not installed")) + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-header "X-Spam-Flag" + "The header inserted by Bsfilter to flag spam." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-probability-header "X-Spam-Probability" + "The header that Bsfilter inserts in messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-switch "--add-spam" + "The switch that Bsfilter uses to register spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-switch "--add-clean" + "The switch that Bsfilter uses to register ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-strong-switch "--sub-spam" + "The switch that Bsfilter uses to unregister ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-strong-switch "--sub-clean" + "The switch that Bsfilter uses to unregister spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-database-directory nil + "Directory path of the Bsfilter databases." + :type '(choice (directory + :tag "Location of the Bsfilter database directory") + (const :tag "Use the default")) + :group 'spam-bsfilter) + (defgroup spam-spamoracle nil "Spam spamoracle configuration." :group 'spam) @@ -453,34 +567,184 @@ (const :tag "Use the default")) :group 'spam-spamoracle) +(defgroup spam-spamassassin nil + "Spam SpamAssassin configuration." + :group 'spam) + +(make-obsolete-variable 'spam-spamassassin-path + 'spam-spamassassin-program) ;; "22.1" ;; Gnus 5.10.9 +(defcustom spam-assassin-program (executable-find "spamassassin") + "Name of the spamassassin program. +Hint: set this to \"spamc\" if you have spamd running. See the spamc and +spamd man pages for more information on these programs." + :type '(choice (file :tag "Location of spamc") + (const :tag "spamassassin is not installed")) + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-arguments () + "Arguments to pass to the spamassassin executable. +This must be a list. For example, `(\"-C\" \"configfile\")'." + :type '(restricted-sexp :match-alternatives (listp)) + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag" + "The header inserted by SpamAssassin to flag spam." + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-positive-spam-flag-header "YES" + "The regex on `spam-spamassassin-spam-flag-header' for positive spam +identification" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-spam-status-header "X-Spam-Status" + "The header inserted by SpamAssassin, giving extended scoring information" + :type 'string + :group 'spam-spamassassin) + +(make-obsolete-variable 'spam-sa-learn-path 'spam-sa-learn-program) +;; "22.1" ;; Gnus 5.10.9 +(defcustom spam-sa-learn-program (executable-find "sa-learn") + "Name of the sa-learn program." + :type '(choice (file :tag "Location of spamassassin") + (const :tag "spamassassin is not installed")) + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-rebuild t + "Whether sa-learn should rebuild the database every time it is called +Enable this if you want sa-learn to rebuild the database automatically. Doing +this will slightly increase the running time of the spam registration process. +If you choose not to do this, you will have to run \"sa-learn --rebuild\" in +order for SpamAssassin to recognize the new registered spam." + :type 'boolean + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-spam-switch "--spam" + "The switch that sa-learn uses to register spam messages" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-ham-switch "--ham" + "The switch that sa-learn uses to register ham messages" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-unregister-switch "--forget" + "The switch that sa-learn uses to unregister messages messages" + :type 'string + :group 'spam-spamassassin) + +(defgroup spam-crm114 nil + "Spam CRM114 Mailfilter configuration." + :group 'spam) + +(defcustom spam-crm114-program (executable-find "mailfilter.crm") + "File path of the CRM114 Mailfilter executable program." + :type '(choice (file :tag "Location of CRM114 Mailfilter") + (const :tag "CRM114 Mailfilter is not installed")) + :group 'spam-crm114) + +(defcustom spam-crm114-header "X-CRM114-Status" + "The header that CRM114 Mailfilter inserts in messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-switch "--learnspam" + "The switch that CRM114 Mailfilter uses to register spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-switch "--learnnonspam" + "The switch that CRM114 Mailfilter uses to register ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-positive-spam-header "^SPAM" + "The regex on `spam-crm114-header' for positive spam identification." + :type 'regexp + :group 'spam-crm114) + +(defcustom spam-crm114-database-directory nil + "Directory path of the CRM114 Mailfilter databases." + :type '(choice (directory + :tag "Location of the CRM114 Mailfilter database directory") + (const :tag "Use the default")) + :group 'spam-crm114) + ;;; Key bindings for spam control. (gnus-define-keys gnus-summary-mode-map - "St" spam-bogofilter-score + "St" spam-generic-score "Sx" gnus-summary-mark-as-spam - "Mst" spam-bogofilter-score + "Mst" spam-generic-score "Msx" gnus-summary-mark-as-spam "\M-d" gnus-summary-mark-as-spam) -(defvar spam-old-ham-articles nil - "List of old ham articles, generated when a group is entered.") - -(defvar spam-old-spam-articles nil - "List of old spam articles, generated when a group is entered.") +(defvar spam-cache-lookups t + "Whether spam.el will try to cache lookups using `spam-caches'.") + +(defvar spam-caches (make-hash-table + :size 10 + :test 'equal) + "Cache of spam detection entries.") + +(defvar spam-old-articles nil + "List of old ham and spam articles, generated when a group is entered.") (defvar spam-split-disabled nil "If non-nil, `spam-split' is disabled, and always returns nil.") (defvar spam-split-last-successful-check nil - "`spam-split' will set this to nil or a spam-use-XYZ check if it - finds ham or spam.") - -;; convenience functions + "Internal variable. +`spam-split' will set this to nil or a spam-use-XYZ check if it +finds ham or spam.") + +;; internal variables for backends +;; TODO: find a way to create these on the fly in spam-install-backend-super +(defvar spam-use-copy nil) +(defvar spam-use-move nil) +(defvar spam-use-gmane nil) +(defvar spam-use-resend nil) + +;;}}} + +;;{{{ convenience functions + +(defun spam-clear-cache (symbol) + "Clear the spam-caches entry for a check." + (remhash symbol spam-caches)) + (defun spam-xor (a b) - "Logical exclusive `or'." + "Logical A xor B." (and (or a b) (not (and a b)))) +(defun spam-set-difference (list1 list2) + "Return a set difference of LIST1 and LIST2. +When either list is nil, the other is returned." + (if (and list1 list2) + ;; we have two non-nil lists + (progn + (dolist (item (append list1 list2)) + (when (and (memq item list1) (memq item list2)) + (setq list1 (delq item list1)) + (setq list2 (delq item list2)))) + (append list1 list2)) + ;; if either of the lists was nil, return the other one + (if list1 list1 list2))) + (defun spam-group-ham-mark-p (group mark &optional spam) + "Checks if MARK is considered a ham mark in GROUP." (when (stringp group) (let* ((marks (spam-group-ham-marks group spam)) (marks (if (symbolp mark) @@ -489,9 +753,11 @@ (memq mark marks)))) (defun spam-group-spam-mark-p (group mark) + "Checks if MARK is considered a spam mark in GROUP." (spam-group-ham-mark-p group mark t)) (defun spam-group-ham-marks (group &optional spam) + "In GROUP, get all the ham marks." (when (stringp group) (let* ((marks (if spam (gnus-parameter-spam-marks group) @@ -501,189 +767,573 @@ marks))) (defun spam-group-spam-marks (group) + "In GROUP, get all the spam marks." (spam-group-ham-marks group t)) (defun spam-group-spam-contents-p (group) - (if (stringp group) + "Is GROUP a spam group?" + (if (and (stringp group) (< 0 (length group))) (or (member group spam-junk-mailgroups) (memq 'gnus-group-spam-classification-spam (gnus-parameter-spam-contents group))) nil)) (defun spam-group-ham-contents-p (group) + "Is GROUP a ham group?" (if (stringp group) (memq 'gnus-group-spam-classification-ham (gnus-parameter-spam-contents group)) nil)) +(defun spam-classifications () + "Return list of valid classifications" + '(spam ham)) + +(defun spam-classification-valid-p (classification) + "Is CLASSIFICATION a valid spam/ham classification?" + (memq classification (spam-classifications))) + +(defun spam-backend-properties () + "Return list of valid classifications." + '(statistical mover check hrf srf huf suf)) + +(defun spam-backend-property-valid-p (property) + "Is PROPERTY a valid backend property?" + (memq property (spam-backend-properties))) + +(defun spam-backend-function-type-valid-p (type) + (or (eq type 'registration) + (eq type 'unregistration))) + +(defun spam-process-type-valid-p (process-type) + (or (eq process-type 'incoming) + (eq process-type 'process))) + +(defun spam-list-articles (articles classification) + (let ((mark-check (if (eq classification 'spam) + 'spam-group-spam-mark-p + 'spam-group-ham-mark-p)) + alist mark-cache-yes mark-cache-no) + (dolist (article articles) + (let ((mark (gnus-summary-article-mark article))) + (unless (or (memq mark mark-cache-yes) + (memq mark mark-cache-no)) + (if (funcall mark-check + gnus-newsgroup-name + mark) + (push mark mark-cache-yes) + (push mark mark-cache-no))) + (when (memq mark mark-cache-yes) + (push article alist)))) + alist)) + +;;}}} + +;;{{{ backend installation functions and procedures + +(defun spam-install-backend-super (backend &rest properties) + "Install BACKEND for spam.el. +Accepts incoming CHECK, ham registration function HRF, spam +registration function SRF, ham unregistration function HUF, spam +unregistration function SUF, and an indication whether the +backend is STATISTICAL." + + (setq spam-backends (add-to-list 'spam-backends backend)) + (while properties + (let ((property (pop properties)) + (value (pop properties))) + (if (spam-backend-property-valid-p property) + (put backend property value) + (gnus-error + 5 + "spam-install-backend-super got an invalid property %s" + property))))) + +(defun spam-backend-list (&optional type) + "Return a list of all the backend symbols, constrained by TYPE. +When TYPE is 'non-mover, only non-mover backends are returned. +When TYPE is 'mover, only mover backends are returned." + (let (list) + (dolist (backend spam-backends) + (when (or + (null type) ;either no type was requested + ;; or the type is 'mover and the backend is a mover + (and + (eq type 'mover) + (spam-backend-mover-p backend)) + ;; or the type is 'non-mover and the backend is not a mover + (and + (eq type 'non-mover) + (not (spam-backend-mover-p backend)))) + (push backend list))) + list)) + +(defun spam-backend-check (backend) + "Get the check function for BACKEND. +Each individual check may return nil, t, or a mailgroup name. +The value nil means that the check does not yield a decision, and +so, that further checks are needed. The value t means that the +message is definitely not spam, and that further spam checks +should be inhibited. Otherwise, a mailgroup name or the symbol +'spam (depending on spam-split-symbolic-return) is returned where +the mail should go, and further checks are also inhibited. The +usual mailgroup name is the value of `spam-split-group', meaning +that the message is definitely a spam." + (get backend 'check)) + +(defun spam-backend-valid-p (backend) + "Is BACKEND valid?" + (member backend (spam-backend-list))) + +(defun spam-backend-info (backend) + "Return information about BACKEND." + (if (spam-backend-valid-p backend) + (let (info) + (setq info (format "Backend %s has the following properties:\n" + backend)) + (dolist (property (spam-backend-properties)) + (setq info (format "%s%s=%s\n" + info + property + (get backend property)))) + info) + (gnus-error 5 "spam-backend-info was asked about an invalid backend %s" + backend))) + +(defun spam-backend-function (backend classification type) + "Get the BACKEND function for CLASSIFICATION and TYPE. +TYPE is 'registration or 'unregistration. +CLASSIFICATION is 'ham or 'spam." + (if (and + (spam-classification-valid-p classification) + (spam-backend-function-type-valid-p type)) + (let ((retrieval + (intern + (format "spam-backend-%s-%s-function" + classification + type)))) + (funcall retrieval backend)) + (gnus-error + 5 + "%s was passed invalid backend %s, classification %s, or type %s" + "spam-backend-function" + backend + classification + type))) + +(defun spam-backend-article-list-property (classification + &optional unregister) + "Property name of article list with CLASSIFICATION and UNREGISTER." + (let* ((r (if unregister "unregister" "register")) + (prop (format "%s-%s" classification r))) + prop)) + +(defun spam-backend-get-article-todo-list (backend + classification + &optional unregister) + "Get the articles to be processed for BACKEND and CLASSIFICATION. +With UNREGISTER, get articles to be unregistered. +This is a temporary storage function - nothing here persists." + (get + backend + (intern (spam-backend-article-list-property classification unregister)))) + +(defun spam-backend-put-article-todo-list (backend classification list &optional unregister) + "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION. +With UNREGISTER, set articles to be unregistered. +This is a temporary storage function - nothing here persists." + (put + backend + (intern (spam-backend-article-list-property classification unregister)) + list)) + +(defun spam-backend-ham-registration-function (backend) + "Get the ham registration function for BACKEND." + (get backend 'hrf)) + +(defun spam-backend-spam-registration-function (backend) + "Get the spam registration function for BACKEND." + (get backend 'srf)) + +(defun spam-backend-ham-unregistration-function (backend) + "Get the ham unregistration function for BACKEND." + (get backend 'huf)) + +(defun spam-backend-spam-unregistration-function (backend) + "Get the spam unregistration function for BACKEND." + (get backend 'suf)) + +(defun spam-backend-statistical-p (backend) + "Is BACKEND statistical?" + (get backend 'statistical)) + +(defun spam-backend-mover-p (backend) + "Is BACKEND a mover?" + (get backend 'mover)) + +(defun spam-install-backend-alias (backend alias) + "Add ALIAS to an existing BACKEND. +The previous backend settings for ALIAS are erased." + + ;; install alias with no properties at first + (spam-install-backend-super alias) + + (dolist (property (spam-backend-properties)) + (put alias property (get backend property)))) + +(defun spam-install-checkonly-backend (backend check) + "Install a BACKEND than can only CHECK for spam." + (spam-install-backend-super backend 'check check)) + +(defun spam-install-mover-backend (backend hrf srf huf suf) + "Install a BACKEND than can move articles at summary exit. +Accepts ham registration function HRF, spam registration function +SRF, ham unregistration function HUF, spam unregistration +function SUF. The backend has no incoming check and can't be +statistical." + (spam-install-backend-super + backend + 'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t)) + +(defun spam-install-nocheck-backend (backend hrf srf huf suf) + "Install a BACKEND than has no check. +Accepts ham registration function HRF, spam registration function +SRF, ham unregistration function HUF, spam unregistration +function SUF. The backend has no incoming check and can't be +statistical (it could be, but in practice that doesn't happen)." + (spam-install-backend-super + backend + 'hrf hrf 'srf srf 'huf huf 'suf suf)) + +(defun spam-install-backend (backend check hrf srf huf suf) + "Install a BACKEND. +Accepts incoming CHECK, ham registration function HRF, spam +registration function SRF, ham unregistration function HUF, spam +unregistration function SUF. The backend won't be +statistical (use spam-install-statistical-backend for that)." + (spam-install-backend-super + backend + 'check check 'hrf hrf 'srf srf 'huf huf 'suf suf)) + +(defun spam-install-statistical-backend (backend check hrf srf huf suf) + "Install a BACKEND. +Accepts incoming CHECK, ham registration function HRF, spam +registration function SRF, ham unregistration function HUF, spam +unregistration function SUF. The backend will be +statistical (use spam-install-backend for non-statistical +backends)." + (spam-install-backend-super + backend + 'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf)) + +(defun spam-install-statistical-checkonly-backend (backend check) + "Install a statistical BACKEND than can only CHECK for spam." + (spam-install-backend-super + backend + 'check check 'statistical t)) + +;;}}} + +;;{{{ backend installations +(spam-install-checkonly-backend 'spam-use-blackholes + 'spam-check-blackholes) + +(spam-install-checkonly-backend 'spam-use-hashcash + 'spam-check-hashcash) + +(spam-install-checkonly-backend 'spam-use-spamassassin-headers + 'spam-check-spamassassin-headers) + +(spam-install-checkonly-backend 'spam-use-bogofilter-headers + 'spam-check-bogofilter-headers) + +(spam-install-checkonly-backend 'spam-use-bsfilter-headers + 'spam-check-bsfilter-headers) + +(spam-install-checkonly-backend 'spam-use-gmane-xref + 'spam-check-gmane-xref) + +(spam-install-checkonly-backend 'spam-use-regex-headers + 'spam-check-regex-headers) + +(spam-install-statistical-checkonly-backend 'spam-use-regex-body + 'spam-check-regex-body) + +;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead +(spam-install-mover-backend 'spam-use-move + 'spam-move-ham-routine + 'spam-move-spam-routine + nil + nil) + +(spam-install-nocheck-backend 'spam-use-copy + 'spam-copy-ham-routine + 'spam-copy-spam-routine + nil + nil) + +(spam-install-nocheck-backend 'spam-use-gmane + 'spam-report-gmane-unregister-routine + 'spam-report-gmane-register-routine + 'spam-report-gmane-register-routine + 'spam-report-gmane-unregister-routine) + +(spam-install-nocheck-backend 'spam-use-resend + 'spam-report-resend-register-ham-routine + 'spam-report-resend-register-routine + nil + nil) + +(spam-install-backend 'spam-use-BBDB + 'spam-check-BBDB + 'spam-BBDB-register-routine + nil + 'spam-BBDB-unregister-routine + nil) + +(spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive) + +(spam-install-backend 'spam-use-blacklist + 'spam-check-blacklist + nil + 'spam-blacklist-register-routine + nil + 'spam-blacklist-unregister-routine) + +(spam-install-backend 'spam-use-whitelist + 'spam-check-whitelist + 'spam-whitelist-register-routine + nil + 'spam-whitelist-unregister-routine + nil) + +(spam-install-statistical-backend 'spam-use-ifile + 'spam-check-ifile + 'spam-ifile-register-ham-routine + 'spam-ifile-register-spam-routine + 'spam-ifile-unregister-ham-routine + 'spam-ifile-unregister-spam-routine) + +(spam-install-statistical-backend 'spam-use-spamoracle + 'spam-check-spamoracle + 'spam-spamoracle-learn-ham + 'spam-spamoracle-learn-spam + 'spam-spamoracle-unlearn-ham + 'spam-spamoracle-unlearn-spam) + +(spam-install-statistical-backend 'spam-use-stat + 'spam-check-stat + 'spam-stat-register-ham-routine + 'spam-stat-register-spam-routine + 'spam-stat-unregister-ham-routine + 'spam-stat-unregister-spam-routine) + +(spam-install-statistical-backend 'spam-use-spamassassin + 'spam-check-spamassassin + 'spam-spamassassin-register-ham-routine + 'spam-spamassassin-register-spam-routine + 'spam-spamassassin-unregister-ham-routine + 'spam-spamassassin-unregister-spam-routine) + +(spam-install-statistical-backend 'spam-use-bogofilter + 'spam-check-bogofilter + 'spam-bogofilter-register-ham-routine + 'spam-bogofilter-register-spam-routine + 'spam-bogofilter-unregister-ham-routine + 'spam-bogofilter-unregister-spam-routine) + +(spam-install-statistical-backend 'spam-use-bsfilter + 'spam-check-bsfilter + 'spam-bsfilter-register-ham-routine + 'spam-bsfilter-register-spam-routine + 'spam-bsfilter-unregister-ham-routine + 'spam-bsfilter-unregister-spam-routine) + +(spam-install-statistical-backend 'spam-use-crm114 + 'spam-check-crm114 + 'spam-crm114-register-ham-routine + 'spam-crm114-register-spam-routine + ;; does CRM114 Mailfilter support unregistration? + nil + nil) + +;;}}} + +;;{{{ scoring and summary formatting +(defun spam-necessary-extra-headers () + "Return the extra headers spam.el thinks are necessary." + (let (list) + (when (or spam-use-spamassassin + spam-use-spamassassin-headers + spam-use-regex-headers) + (push 'X-Spam-Status list)) + (when (or spam-use-bogofilter + spam-use-regex-headers) + (push 'X-Bogosity list)) + (when (or spam-use-crm114 + spam-use-regex-headers) + (push 'X-CRM114-Status list)) + list)) + +(defun spam-user-format-function-S (headers) + (when headers + (format "%3.2f" + (spam-summary-score headers spam-summary-score-preferred-header)))) + +(defun spam-article-sort-by-spam-status (h1 h2) + "Sort articles by score." + (let (result) + (dolist (header (spam-necessary-extra-headers)) + (let ((s1 (spam-summary-score h1 header)) + (s2 (spam-summary-score h2 header))) + (unless (= s1 s2) + (setq result (< s1 s2)) + (return)))) + result)) + +(defvar spam-spamassassin-score-regexp + ".*\\b\\(?:score\\|hits\\)=\\(-?[0-9.]+\\)" + "Regexp matching SpamAssassin score header. +The first group must match the number.") + +(defun spam-extra-header-to-number (header headers) + "Transform an extra HEADER to a number, using list of HEADERS. +Note this has to be fast." + (let ((header-content (gnus-extra-header header headers))) + (if header-content + (cond + ((eq header 'X-Spam-Status) + (string-to-number (gnus-replace-in-string + header-content + spam-spamassassin-score-regexp + "\\1"))) + ;; for CRM checking, it's probably faster to just do the string match + ((string-match "( pR: \\([0-9.-]+\\)" header-content) + (- (string-to-number (match-string 1 header-content)))) + ((eq header 'X-Bogosity) + (string-to-number (gnus-replace-in-string + (gnus-replace-in-string + header-content + ".*spamicity=" "") + ",.*" ""))) + (t nil)) + nil))) + +(defun spam-summary-score (headers &optional specific-header) + "Score an article for the summary buffer, as fast as possible. +With SPECIFIC-HEADER, returns only that header's score. +Will not return a nil score." + (let (score) + (dolist (header + (if specific-header + (list specific-header) + (spam-necessary-extra-headers))) + (setq score + (spam-extra-header-to-number header headers)) + (when score + (return))) + (or score 0))) + +(defun spam-generic-score (&optional recheck) + "Invoke whatever scoring method we can." + (interactive "P") + (cond + ((or spam-use-spamassassin spam-use-spamassassin-headers) + (spam-spamassassin-score recheck)) + ((or spam-use-bsfilter spam-use-bsfilter-headers) + (spam-bsfilter-score recheck)) + (spam-use-crm114 + (spam-crm114-score)) + (t (spam-bogofilter-score recheck)))) +;;}}} + +;;{{{ set up widening, processor checks + +;;; set up IMAP widening if it's necessary +(defun spam-setup-widening () + (when (spam-widening-needed-p) + (setq nnimap-split-download-body-default t))) + +(defun spam-widening-needed-p (&optional force-symbols) + (let (found) + (dolist (backend (spam-backend-list)) + (when (and (spam-backend-statistical-p backend) + (or (symbol-value backend) + (memq backend force-symbols))) + (setq found backend))) + found)) + (defvar spam-list-of-processors - '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) - (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) + ;; note the nil processors are not defined in gnus.el + '((gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) + (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter) (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) (gnus-group-spam-exit-processor-stat spam spam-use-stat) (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) + (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) + (gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) ;; Buggy? (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) + (gnus-group-ham-exit-processor-bsfilter ham spam-use-bsfilter) (gnus-group-ham-exit-processor-stat ham spam-use-stat) (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) + (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin) (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) - "The spam-list-of-processors list contains pairs associating a -ham/spam exit processor variable with a classification and a -spam-use-* variable.") - -(defun spam-group-processor-p (group processor) + "The OBSOLETE `spam-list-of-processors' list. +This list contains pairs associating the obsolete ham/spam exit +processor variables with a classification and a spam-use-* +variable. When the processor variable is nil, just the +classification and spam-use-* check variable are used. This is +superceded by the new spam backend code, so it's only consulted +for backwards compatibility.") + +(defun spam-group-processor-p (group backend &optional classification) + "Checks if GROUP has a BACKEND with CLASSIFICATION registered. +Also accepts the obsolete processors, which can be found in +gnus.el and in spam-list-of-processors. In the case of mover +backends, checks the setting of spam-summary-exit-behavior in +addition to the set values for the group." (if (and (stringp group) - (symbolp processor)) - (or (member processor (nth 0 (gnus-parameter-spam-process group))) - (spam-group-processor-multiple-p - group - (cdr-safe (assoc processor spam-list-of-processors)))) + (symbolp backend)) + (let ((old-style (assq backend spam-list-of-processors)) + (parameters (nth 0 (gnus-parameter-spam-process group))) + found) + (if old-style ; old-style processor + (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style)) + ;; now search for the parameter + (dolist (parameter parameters) + (when (and (null found) + (listp parameter) + (eq classification (nth 0 parameter)) + (eq backend (nth 1 parameter))) + (setq found t))) + + ;; now, if the parameter was not found, do the + ;; spam-summary-exit-behavior-logic for mover backends + (unless found + (when (spam-backend-mover-p backend) + (setq + found + (cond + ((eq spam-summary-exit-behavior 'move-all) t) + ((eq spam-summary-exit-behavior 'move-none) nil) + ((eq spam-summary-exit-behavior 'default) + (or (eq classification 'spam) ;move spam out of all groups + ;; move ham out of spam groups + (and (eq classification 'ham) + (spam-group-spam-contents-p group)))) + (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" + spam-summary-exit-behavior)))))) + + found)) nil)) -(defun spam-group-processor-multiple-p (group processor-info) - (let* ((classification (nth 0 processor-info)) - (check (nth 1 processor-info)) - (parameters (nth 0 (gnus-parameter-spam-process group))) - found) - (dolist (parameter parameters) - (when (and (null found) - (listp parameter) - (eq classification (nth 0 parameter)) - (eq check (nth 1 parameter))) - (setq found t))) - found)) - -(defun spam-group-spam-processor-report-gmane-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane)) - -(defun spam-group-spam-processor-bogofilter-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter)) - -(defun spam-group-spam-processor-blacklist-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist)) - -(defun spam-group-spam-processor-ifile-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile)) - -(defun spam-group-ham-processor-ifile-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile)) - -(defun spam-group-spam-processor-spamoracle-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle)) - -(defun spam-group-ham-processor-bogofilter-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) - -(defun spam-group-spam-processor-stat-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat)) - -(defun spam-group-ham-processor-stat-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat)) - -(defun spam-group-ham-processor-whitelist-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist)) - -(defun spam-group-ham-processor-BBDB-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) - -(defun spam-group-ham-processor-copy-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) - -(defun spam-group-ham-processor-spamoracle-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle)) - -;;; Summary entry and exit processing. - -(defun spam-summary-prepare () - (setq spam-old-ham-articles - (spam-list-articles gnus-newsgroup-articles 'ham)) - (setq spam-old-spam-articles - (spam-list-articles gnus-newsgroup-articles 'spam)) - (spam-mark-junk-as-spam-routine)) - -;; The spam processors are invoked for any group, spam or ham or neither -(defun spam-summary-prepare-exit () - (unless gnus-group-is-exiting-without-update-p - (gnus-message 6 "Exiting summary buffer and applying spam rules") - - ;; first of all, unregister any articles that are no longer ham or spam - ;; we have to iterate over the processors, or else we'll be too slow - (dolist (classification '(spam ham)) - (let* ((old-articles (if (eq classification 'spam) - spam-old-spam-articles - spam-old-ham-articles)) - (new-articles (spam-list-articles - gnus-newsgroup-articles - classification)) - (changed-articles (gnus-set-difference old-articles new-articles))) - ;; now that we have the changed articles, we go through the processors - (dolist (processor-param spam-list-of-processors) - (let ((processor (nth 0 processor-param)) - (processor-classification (nth 1 processor-param)) - (check (nth 2 processor-param)) - unregister-list) - (dolist (article changed-articles) - (let ((id (spam-fetch-field-message-id-fast article))) - (when (spam-log-unregistration-needed-p - id 'process classification check) - (push article unregister-list)))) - ;; call spam-register-routine with specific articles to unregister, - ;; when there are articles to unregister and the check is enabled - (when (and unregister-list (symbol-value check)) - (spam-register-routine classification check t unregister-list)))))) - - ;; find all the spam processors applicable to this group - (dolist (processor-param spam-list-of-processors) - (let ((processor (nth 0 processor-param)) - (classification (nth 1 processor-param)) - (check (nth 2 processor-param))) - (when (and (eq 'spam classification) - (spam-group-processor-p gnus-newsgroup-name processor)) - (spam-register-routine classification check)))) - - (if spam-move-spam-nonspam-groups-only - (when (not (spam-group-spam-contents-p gnus-newsgroup-name)) - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) - (gnus-message 5 "Marking spam as expired and moving it to %s" - gnus-newsgroup-name) - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) - - ;; now we redo spam-mark-spam-as-expired-and-move-routine to only - ;; expire spam, in case the above did not expire them - (gnus-message 5 "Marking spam as expired without moving it") - (spam-mark-spam-as-expired-and-move-routine nil) - - (when (or (spam-group-ham-contents-p gnus-newsgroup-name) - (and (spam-group-spam-contents-p gnus-newsgroup-name) - spam-process-ham-in-spam-groups) - spam-process-ham-in-nonham-groups) - ;; find all the ham processors applicable to this group - (dolist (processor-param spam-list-of-processors) - (let ((processor (nth 0 processor-param)) - (classification (nth 1 processor-param)) - (check (nth 2 processor-param))) - (when (and (eq 'ham classification) - (spam-group-processor-p gnus-newsgroup-name processor)) - (spam-register-routine classification check))))) - - (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) - (gnus-message 5 "Copying ham") - (spam-ham-copy-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name))) - - ;; now move all ham articles out of spam groups - (when (spam-group-spam-contents-p gnus-newsgroup-name) - (gnus-message 5 "Moving ham messages from spam group") - (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) - - (setq spam-old-ham-articles nil) - (setq spam-old-spam-articles nil)) +;;}}} + +;;{{{ Summary entry and exit processing. (defun spam-mark-junk-as-spam-routine () ;; check the global list of group names spam-junk-mailgroups and the @@ -701,49 +1351,85 @@ (gnus-summary-mark-article article gnus-spam-mark)) (gnus-message 9 "Did not mark new messages as spam."))))) -(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) - (if (and (car-safe groups) (listp (car-safe groups))) - (apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) - (gnus-summary-kill-process-mark) - (let ((articles gnus-newsgroup-articles) - (backend-supports-deletions - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)) - article tomove deletep) - (dolist (article articles) - (when (eq (gnus-summary-article-mark article) gnus-spam-mark) - (gnus-summary-mark-article article gnus-expirable-mark) - (push article tomove))) - - ;; now do the actual copies - (dolist (group groups) - (when (and tomove - (stringp group)) - (dolist (article tomove) - (gnus-summary-set-process-mark article)) - (when tomove - (if (or (not backend-supports-deletions) - (> (length groups) 1)) - (progn - (gnus-summary-copy-article nil group) - (setq deletep t)) - (gnus-summary-move-article nil group))))) - - ;; now delete the articles, if there was a copy done, and the - ;; backend allows it - (when (and deletep backend-supports-deletions) - (dolist (article tomove) - (gnus-summary-set-process-mark article)) - (when tomove - (let ((gnus-novice-user nil)) ; don't ask me if I'm sure - (gnus-summary-delete-article nil)))) - - (gnus-summary-yank-process-mark)))) - -(defun spam-ham-copy-or-move-routine (copy groups) +(defun spam-summary-prepare () + (setq spam-old-articles + (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham)) + (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam)))) + (spam-mark-junk-as-spam-routine)) + +;; The spam processors are invoked for any group, spam or ham or neither +(defun spam-summary-prepare-exit () + (unless gnus-group-is-exiting-without-update-p + (gnus-message 6 "Exiting summary buffer and applying spam rules") + + ;; before we begin, remove any article limits +; (ignore-errors +; (gnus-summary-pop-limit t)) + + ;; first of all, unregister any articles that are no longer ham or spam + ;; we have to iterate over the processors, or else we'll be too slow + (dolist (classification (spam-classifications)) + (let* ((old-articles (cdr-safe (assq classification spam-old-articles))) + (new-articles (spam-list-articles + gnus-newsgroup-articles + classification)) + (changed-articles (spam-set-difference new-articles old-articles))) + ;; now that we have the changed articles, we go through the processors + (dolist (backend (spam-backend-list)) + (let (unregister-list) + (dolist (article changed-articles) + (let ((id (spam-fetch-field-message-id-fast article))) + (when (spam-log-unregistration-needed-p + id 'process classification backend) + (push article unregister-list)))) + ;; call spam-register-routine with specific articles to unregister, + ;; when there are articles to unregister and the check is enabled + (when (and unregister-list (symbol-value backend)) + (spam-backend-put-article-todo-list backend + classification + unregister-list + t)))))) + + ;; do the non-moving backends first, then the moving ones + (dolist (backend-type '(non-mover mover)) + (dolist (classification (spam-classifications)) + (dolist (backend (spam-backend-list backend-type)) + (when (spam-group-processor-p + gnus-newsgroup-name + backend + classification) + (spam-backend-put-article-todo-list backend + classification + (spam-list-articles + gnus-newsgroup-articles + classification)))))) + + (spam-resolve-registrations-routine) ; do the registrations now + + ;; we mark all the leftover spam articles as expired at the end + (dolist (article (spam-list-articles + gnus-newsgroup-articles + 'spam)) + (gnus-summary-mark-article article gnus-expirable-mark))) + + (setq spam-old-articles nil)) + +;;}}} + +;;{{{ spam-use-move and spam-use-copy backend support functions + +(defun spam-copy-or-move-routine (copy groups articles classification) + + (when (and (car-safe groups) (listp (car-safe groups))) + (setq groups (pop groups))) + + (unless (listp groups) + (setq groups (list groups))) + + ;; remove the current process mark (gnus-summary-kill-process-mark) - (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham)) - (backend-supports-deletions + + (let ((backend-supports-deletions (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)) (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) @@ -755,69 +1441,95 @@ ;; now do the actual move (dolist (group groups) - (when (and todo (stringp group)) - (dolist (article todo) - (when spam-mark-ham-unread-before-move-from-spam-group + (when (and articles (stringp group)) + + ;; first, mark the article with the process mark and, if needed, + ;; the unread or expired mark (for ham and spam respectively) + (dolist (article articles) + (when (and (eq classification 'ham) + spam-mark-ham-unread-before-move-from-spam-group) + (gnus-message 9 "Marking ham article %d unread before move" + article) (gnus-summary-mark-article article gnus-unread-mark)) - (gnus-summary-set-process-mark article)) - - (if respool ; respooling is with a "fake" group - (let ((spam-split-disabled - (or spam-split-disabled - spam-disable-spam-split-during-ham-respool))) - (gnus-summary-respool-article nil respool-method)) - (if (or (not backend-supports-deletions) ; else, we are not respooling - (> (length groups) 1)) - (progn ; if copying, copy and set deletep - (gnus-summary-copy-article nil group) - (setq deletep t)) - (gnus-summary-move-article nil group))))) ; else move articles - - ;; now delete the articles, unless a) copy is t, and there was a copy done - ;; b) a move was done to a single group - ;; c) backend-supports-deletions is nil - (unless copy - (when (and deletep backend-supports-deletions) - (dolist (article todo) - (gnus-summary-set-process-mark article)) - (when todo - (let ((gnus-novice-user nil)) ; don't ask me if I'm sure - (gnus-summary-delete-article nil)))))) - - (gnus-summary-yank-process-mark)) - -(defun spam-ham-copy-routine (&rest groups) - (if (and (car-safe groups) (listp (car-safe groups))) - (apply 'spam-ham-copy-routine (car groups)) - (spam-ham-copy-or-move-routine t groups))) - -(defun spam-ham-move-routine (&rest groups) - (if (and (car-safe groups) (listp (car-safe groups))) - (apply 'spam-ham-move-routine (car groups)) - (spam-ham-copy-or-move-routine nil groups))) - -(eval-and-compile - (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) - + (when (and (eq classification 'spam) + (not copy)) + (gnus-message 9 "Marking spam article %d expirable before move" + article) + (gnus-summary-mark-article article gnus-expirable-mark)) + (gnus-summary-set-process-mark article) + + (if respool ; respooling is with a "fake" group + (let ((spam-split-disabled + (or spam-split-disabled + (and (eq classification 'ham) + spam-disable-spam-split-during-ham-respool)))) + (gnus-message 9 "Respooling article %d with method %s" + article respool-method) + (gnus-summary-respool-article nil respool-method)) + (if (or (not backend-supports-deletions) ; else, we are not respooling + (> (length groups) 1)) + (progn ; if copying, copy and set deletep + (gnus-message 9 "Copying article %d to group %s" + article group) + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-message 9 "Moving article %d to group %s" + article group) + (gnus-summary-move-article nil group))))) ; else move articles + + ;; now delete the articles, unless a) copy is t, and there was a copy done + ;; b) a move was done to a single group + ;; c) backend-supports-deletions is nil + (unless copy + (when (and deletep backend-supports-deletions) + (dolist (article articles) + (gnus-summary-set-process-mark article) + (gnus-message 9 "Deleting article %d" article)) + (when articles + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil))))) + + (gnus-summary-yank-process-mark) + (length articles)))) + +(defun spam-copy-spam-routine (articles) + (spam-copy-or-move-routine + t + (gnus-parameter-spam-process-destination gnus-newsgroup-name) + articles + 'spam)) + +(defun spam-move-spam-routine (articles) + (spam-copy-or-move-routine + nil + (gnus-parameter-spam-process-destination gnus-newsgroup-name) + articles + 'spam)) + +(defun spam-copy-ham-routine (articles) + (spam-copy-or-move-routine + t + (gnus-parameter-ham-process-destination gnus-newsgroup-name) + articles + 'ham)) + +(defun spam-move-ham-routine (articles) + (spam-copy-or-move-routine + nil + (gnus-parameter-ham-process-destination gnus-newsgroup-name) + articles + 'ham)) + +;;}}} + +;;{{{ article and field retrieval code (defun spam-get-article-as-string (article) - (let ((article-buffer (spam-get-article-as-buffer article)) - article-string) - (when article-buffer - (save-window-excursion - (set-buffer article-buffer) - (setq article-string (buffer-string)))) - article-string)) - -(defun spam-get-article-as-buffer (article) - (let ((article-buffer)) - (when (numberp article) - (save-window-excursion - (gnus-summary-goto-subject article) - (gnus-summary-show-article t) - (setq article-buffer (get-buffer gnus-article-buffer)))) - article-buffer)) + (when (numberp article) + (with-temp-buffer + (gnus-request-article-this-buffer + article + gnus-newsgroup-name) + (buffer-string)))) ;; disabled for now ;; (defun spam-get-article-as-filename (article) @@ -831,72 +1543,79 @@ ;; article-filename ;; nil))) -(defun spam-fetch-field-from-fast (article) - "Fetch the `from' field quickly, using the internal gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (mail-header-from - (gnus-data-header (assoc article (gnus-data-list nil)))) - nil)) - -(defun spam-fetch-field-subject-fast (article) - "Fetch the `subject' field quickly, using the internal - gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (mail-header-subject - (gnus-data-header (assoc article (gnus-data-list nil)))) - nil)) - -(defun spam-fetch-field-message-id-fast (article) - "Fetch the `Message-ID' field quickly, using the internal - gnus-data-list function" - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (mail-header-message-id - (gnus-data-header (assoc article (gnus-data-list nil)))) - nil)) - - -;;;; Spam determination. - -(defvar spam-list-of-checks - '((spam-use-blacklist . spam-check-blacklist) - (spam-use-regex-headers . spam-check-regex-headers) - (spam-use-regex-body . spam-check-regex-body) - (spam-use-whitelist . spam-check-whitelist) - (spam-use-BBDB . spam-check-BBDB) - (spam-use-ifile . spam-check-ifile) - (spam-use-spamoracle . spam-check-spamoracle) - (spam-use-stat . spam-check-stat) - (spam-use-blackholes . spam-check-blackholes) - (spam-use-hashcash . spam-check-hashcash) - (spam-use-bogofilter-headers . spam-check-bogofilter-headers) - (spam-use-bogofilter . spam-check-bogofilter)) - "The spam-list-of-checks list contains pairs associating a -parameter variable with a spam checking function. If the -parameter variable is true, then the checking function is called, -and its value decides what happens. Each individual check may -return nil, t, or a mailgroup name. The value nil means that the -check does not yield a decision, and so, that further checks are -needed. The value t means that the message is definitely not -spam, and that further spam checks should be inhibited. -Otherwise, a mailgroup name or the symbol 'spam (depending on -spam-split-symbolic-return) is returned where the mail should go, -and further checks are also inhibited. The usual mailgroup name -is the value of `spam-split-group', meaning that the message is -definitely a spam.") - -(defvar spam-list-of-statistical-checks - '(spam-use-ifile - spam-use-regex-body - spam-use-stat - spam-use-bogofilter - spam-use-spamoracle) - "The spam-list-of-statistical-checks list contains all the mail -splitters that need to have the full message body available.") - -;;;TODO: modify to invoke self with each check if invoked without specifics +(defun spam-fetch-field-fast (article field &optional prepared-data-header) + "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function. +When PREPARED-DATA-HEADER is given, don't look in the Gnus data. +When FIELD is 'number, ARTICLE can be any number (since we want +to find it out)." + (when (numberp article) + (let* ((data-header (or prepared-data-header + (spam-fetch-article-header article)))) + (if (arrayp data-header) + (cond + ((equal field 'number) + (mail-header-number data-header)) + ((equal field 'from) + (mail-header-from data-header)) + ((equal field 'message-id) + (mail-header-message-id data-header)) + ((equal field 'subject) + (mail-header-subject data-header)) + ((equal field 'references) + (mail-header-references data-header)) + ((equal field 'date) + (mail-header-date data-header)) + ((equal field 'xref) + (mail-header-xref data-header)) + ((equal field 'extra) + (mail-header-extra data-header)) + (t + (gnus-error + 5 + "spam-fetch-field-fast: unknown field %s requested" + field) + nil)) + (gnus-message 6 "Article %d has a nil data header" article))))) + +(defun spam-fetch-field-from-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'from prepared-data-header)) + +(defun spam-fetch-field-subject-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'subject prepared-data-header)) + +(defun spam-fetch-field-message-id-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'message-id prepared-data-header)) + +(defun spam-generate-fake-headers (article) + (let ((dh (spam-fetch-article-header article))) + (if dh + (concat + (format + ;; 80-character limit makes for strange constructs + (concat "From: %s\nSubject: %s\nMessage-ID: %s\n" + "Date: %s\nReferences: %s\nXref: %s\n") + (spam-fetch-field-fast article 'from dh) + (spam-fetch-field-fast article 'subject dh) + (spam-fetch-field-fast article 'message-id dh) + (spam-fetch-field-fast article 'date dh) + (spam-fetch-field-fast article 'references dh) + (spam-fetch-field-fast article 'xref dh)) + (when (spam-fetch-field-fast article 'extra dh) + (format "%s\n" (spam-fetch-field-fast article 'extra dh)))) + (gnus-message + 5 + "spam-generate-fake-headers: article %d didn't have a valid header" + article)))) + +(defun spam-fetch-article-header (article) + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-read-header article) + (nth 3 (assq article gnus-newsgroup-data)))) +;;}}} + +;;{{{ Spam determination. + (defun spam-split (&rest specific-checks) "Split this message into the `spam' group if it is spam. This function can be used as an entry in the variable `nnmail-split-fancy', @@ -914,38 +1633,41 @@ (setq spam-split-group-choice check) (setq specific-checks (delq check specific-checks)))) - (let ((spam-split-group spam-split-group-choice)) + (let ((spam-split-group spam-split-group-choice) + (widening-needed-check (spam-widening-needed-p specific-checks))) (save-excursion (save-restriction - (dolist (check spam-list-of-statistical-checks) - (when (and (symbolp check) (symbol-value check)) - (widen) - (gnus-message 8 "spam-split: widening the buffer (%s requires it)" - (symbol-name check)) - (return))) - ;; (progn (widen) (debug (buffer-string))) - (let ((list-of-checks spam-list-of-checks) + (when widening-needed-check + (widen) + (gnus-message 8 "spam-split: widening the buffer (%s requires it)" + widening-needed-check)) + (let ((backends (spam-backend-list)) decision) - (while (and list-of-checks (not decision)) - (let ((pair (pop list-of-checks))) - (when (and (symbol-value (car pair)) - (or (null specific-checks) - (memq (car pair) specific-checks))) - (gnus-message 5 "spam-split: calling the %s function" - (symbol-name (cdr pair))) - (setq decision (funcall (cdr pair))) + (while (and backends (not decision)) + (let* ((backend (pop backends)) + (check-function (spam-backend-check backend)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when (or + ;; either, given specific checks, this is one of them + (memq backend specific-checks) + ;; or, given no specific checks, spam-use-CHECK is set + (and (null specific-checks) (symbol-value backend))) + (gnus-message 6 "spam-split: calling the %s function" + check-function) + (setq decision (funcall check-function)) ;; if we got a decision at all, save the current check (when decision - (setq spam-split-last-successful-check (car pair))) + (setq spam-split-last-successful-check backend)) (when (eq decision 'spam) - (if spam-split-symbolic-return - (setq decision spam-split-group) + (unless spam-split-symbolic-return (gnus-error 5 (format "spam-split got %s but %s is nil" - (symbol-name decision) - (symbol-name spam-split-symbolic-return)))))))) + decision + spam-split-symbolic-return))))))) (if (eq decision t) (if spam-split-symbolic-return-positive 'ham nil) decision)))))))) @@ -957,143 +1679,149 @@ (let* ((group gnus-newsgroup-name) (autodetect (gnus-parameter-spam-autodetect group)) (methods (gnus-parameter-spam-autodetect-methods group)) - (first-method (nth 0 methods))) - (when (and autodetect - (not (equal first-method 'none))) - (mapcar - (lambda (article) - (let ((id (spam-fetch-field-message-id-fast article)) - (subject (spam-fetch-field-subject-fast article)) - (sender (spam-fetch-field-from-fast article))) - (unless (and spam-log-to-registry - (spam-log-registered-p id 'incoming)) + (first-method (nth 0 methods)) + (articles (if spam-autodetect-recheck-messages + gnus-newsgroup-articles + gnus-newsgroup-unseen)) + article-cannot-be-faked) + + + (dolist (backend methods) + (when (spam-backend-statistical-p backend) + (setq article-cannot-be-faked t) + (return))) + + (when (memq 'default methods) + (setq article-cannot-be-faked t)) + + (when (and autodetect + (not (equal first-method 'none))) + (mapcar + (lambda (article) + (let ((id (spam-fetch-field-message-id-fast article)) + (subject (spam-fetch-field-subject-fast article)) + (sender (spam-fetch-field-from-fast article)) + registry-lookup) + + (unless id + (gnus-message 6 "Article %d has no message ID!" article)) + + (when (and id spam-log-to-registry) + (setq registry-lookup (spam-log-registration-type id 'incoming)) + (when registry-lookup + (gnus-message + 9 + "spam-find-spam: message %s was already registered incoming" + id))) + (let* ((spam-split-symbolic-return t) (spam-split-symbolic-return-positive t) + (fake-headers (spam-generate-fake-headers article)) (split-return - (with-temp-buffer - (gnus-request-article-this-buffer - article - group) - (if (or (null first-method) - (equal first-method 'default)) - (spam-split) - (apply 'spam-split methods))))) + (or registry-lookup + (with-temp-buffer + (if article-cannot-be-faked + (gnus-request-article-this-buffer + article + group) + ;; else, we fake the article + (when fake-headers (insert fake-headers))) + (if (or (null first-method) + (equal first-method 'default)) + (spam-split) + (apply 'spam-split methods)))))) (if (equal split-return 'spam) (gnus-summary-mark-article article gnus-spam-mark)) - - (when (and split-return spam-log-to-registry) + + (when (and id split-return spam-log-to-registry) (when (zerop (gnus-registry-group-count id)) (gnus-registry-add-group id group subject sender)) - - (spam-log-processing-to-registry - id - 'incoming - split-return - spam-split-last-successful-check - group)))))) - (if spam-autodetect-recheck-messages - gnus-newsgroup-articles - gnus-newsgroup-unseen))))) - -(defvar spam-registration-functions - ;; first the ham register, second the spam register function - ;; third the ham unregister, fourth the spam unregister function - '((spam-use-blacklist nil - spam-blacklist-register-routine - nil - spam-blacklist-unregister-routine) - (spam-use-whitelist spam-whitelist-register-routine - nil - spam-whitelist-unregister-routine - nil) - (spam-use-BBDB spam-BBDB-register-routine - nil - spam-BBDB-unregister-routine - nil) - (spam-use-ifile spam-ifile-register-ham-routine - spam-ifile-register-spam-routine - spam-ifile-unregister-ham-routine - spam-ifile-unregister-spam-routine) - (spam-use-spamoracle spam-spamoracle-learn-ham - spam-spamoracle-learn-spam - spam-spamoracle-unlearn-ham - spam-spamoracle-unlearn-spam) - (spam-use-stat spam-stat-register-ham-routine - spam-stat-register-spam-routine - spam-stat-unregister-ham-routine - spam-stat-unregister-spam-routine) - ;; note that spam-use-gmane is not a legitimate check - (spam-use-gmane nil - spam-report-gmane-register-routine - ;; does Gmane support unregistration? - nil - nil) - (spam-use-bogofilter spam-bogofilter-register-ham-routine - spam-bogofilter-register-spam-routine - spam-bogofilter-unregister-ham-routine - spam-bogofilter-unregister-spam-routine)) - "The spam-registration-functions list contains pairs -associating a parameter variable with the ham and spam -registration functions, and the ham and spam unregistration -functions") - -(defun spam-classification-valid-p (classification) - (or (eq classification 'spam) - (eq classification 'ham))) - -(defun spam-process-type-valid-p (process-type) - (or (eq process-type 'incoming) - (eq process-type 'process))) - -(defun spam-registration-check-valid-p (check) - (assoc check spam-registration-functions)) - -(defun spam-unregistration-check-valid-p (check) - (assoc check spam-registration-functions)) - -(defun spam-registration-function (classification check) - (let ((flist (cdr-safe (assoc check spam-registration-functions)))) - (if (eq classification 'spam) - (nth 1 flist) - (nth 0 flist)))) - -(defun spam-unregistration-function (classification check) - (let ((flist (cdr-safe (assoc check spam-registration-functions)))) - (if (eq classification 'spam) - (nth 3 flist) - (nth 2 flist)))) - -(defun spam-list-articles (articles classification) - (let ((mark-check (if (eq classification 'spam) - 'spam-group-spam-mark-p - 'spam-group-ham-mark-p)) - list mark-cache-yes mark-cache-no) - (dolist (article articles) - (let ((mark (gnus-summary-article-mark article))) - (unless (memq mark mark-cache-no) - (if (memq mark mark-cache-yes) - (push article list) - ;; else, we have to actually check the mark - (if (funcall mark-check - gnus-newsgroup-name - mark) - (progn - (push article list) - (push mark mark-cache-yes)) - (push mark mark-cache-no)))))) - list)) + + (unless registry-lookup + (spam-log-processing-to-registry + id + 'incoming + split-return + spam-split-last-successful-check + group)))))) + articles)))) + +;;}}} + +;;{{{ registration/unregistration functions + +(defun spam-resolve-registrations-routine () + "Go through the backends and register or unregister articles as needed." + (dolist (backend-type '(non-mover mover)) + (dolist (classification (spam-classifications)) + (dolist (backend (spam-backend-list backend-type)) + (let ((rlist (spam-backend-get-article-todo-list + backend classification)) + (ulist (spam-backend-get-article-todo-list + backend classification t)) + (delcount 0)) + + ;; clear the old lists right away + (spam-backend-put-article-todo-list backend + classification + nil + nil) + (spam-backend-put-article-todo-list backend + classification + nil + t) + + ;; eliminate duplicates + (dolist (article (copy-sequence ulist)) + (when (memq article rlist) + (incf delcount) + (setq rlist (delq article rlist)) + (setq ulist (delq article ulist)))) + + (unless (zerop delcount) + (gnus-message + 9 + "%d messages were saved the trouble of unregistering and then registering" + delcount)) + + ;; unregister articles + (unless (zerop (length ulist)) + (let ((num (spam-unregister-routine classification backend ulist))) + (when (> num 0) + (gnus-message + 6 + "%d %s messages were unregistered by backend %s." + num + classification + backend)))) + + ;; register articles + (unless (zerop (length rlist)) + (let ((num (spam-register-routine classification backend rlist))) + (when (> num 0) + (gnus-message + 6 + "%d %s messages were registered by backend %s." + num + classification + backend))))))))) + +(defun spam-unregister-routine (classification + backend + specific-articles) + (spam-register-routine classification backend specific-articles t)) (defun spam-register-routine (classification - check - &optional unregister - specific-articles) + backend + specific-articles + &optional unregister) (when (and (spam-classification-valid-p classification) - (spam-registration-check-valid-p check)) + (spam-backend-valid-p backend)) (let* ((register-function - (spam-registration-function classification check)) + (spam-backend-function backend classification 'registration)) (unregister-function - (spam-unregistration-function classification check)) + (spam-backend-function backend classification 'unregistration)) (run-function (if unregister unregister-function register-function)) @@ -1109,40 +1837,46 @@ gnus-newsgroup-articles classification))) ;; process them - (gnus-message 5 "%s %d %s articles with classification %s, check %s" - (if unregister "Unregistering" "Registering") - (length articles) - (if specific-articles "specific" "") - (symbol-name classification) - (symbol-name check)) - (funcall run-function articles) - ;; now log all the registrations (or undo them, depending on unregister) - (dolist (article articles) - (funcall log-function - (spam-fetch-field-message-id-fast article) - 'process - classification - check - gnus-newsgroup-name)))))) + (when (> (length articles) 0) + (gnus-message 5 "%s %d %s articles as %s using backend %s" + (if unregister "Unregistering" "Registering") + (length articles) + (if specific-articles "specific" "") + classification + backend) + (funcall run-function articles) + ;; now log all the registrations (or undo them, depending on + ;; unregister) + (dolist (article articles) + (funcall log-function + (spam-fetch-field-message-id-fast article) + 'process + classification + backend + gnus-newsgroup-name)))) + ;; return the number of articles processed + (length articles)))) ;;; log a ham- or spam-processor invocation to the registry -(defun spam-log-processing-to-registry (id type classification check group) +(defun spam-log-processing-to-registry (id type classification backend group) (when spam-log-to-registry (if (and (stringp id) (stringp group) (spam-process-type-valid-p type) (spam-classification-valid-p classification) - (spam-registration-check-valid-p check)) + (spam-backend-valid-p backend)) (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) - (cell (list classification check group))) + (cell (list classification backend group))) (push cell cell-list) (gnus-registry-store-extra-entry id type cell-list)) - (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group" - "spam-log-processing-to-registry"))))) + (gnus-error + 7 + (format "%s call with bad ID, type, classification, spam-backend, or group" + "spam-log-processing-to-registry"))))) ;;; check if a ham- or spam-processor registration has been done (defun spam-log-registered-p (id type) @@ -1151,76 +1885,104 @@ (spam-process-type-valid-p type)) (cdr-safe (gnus-registry-fetch-extra id type)) (progn - (gnus-message 5 (format "%s called with bad ID, type, classification, or check" - "spam-log-registered-p")) + (gnus-error + 7 + (format "%s called with bad ID, type, classification, or spam-backend" + "spam-log-registered-p")) nil)))) +;;; check what a ham- or spam-processor registration says +;;; returns nil if conflicting registrations are found +(defun spam-log-registration-type (id type) + (let ((count 0) + decision) + (dolist (reg (spam-log-registered-p id type)) + (let ((classification (nth 0 reg))) + (when (spam-classification-valid-p classification) + (when (and decision + (not (eq classification decision))) + (setq count (+ 1 count))) + (setq decision classification)))) + (if (< 0 count) + nil + decision))) + + ;;; check if a ham- or spam-processor registration needs to be undone -(defun spam-log-unregistration-needed-p (id type classification check) +(defun spam-log-unregistration-needed-p (id type classification backend) (when spam-log-to-registry (if (and (stringp id) (spam-process-type-valid-p type) (spam-classification-valid-p classification) - (spam-registration-check-valid-p check)) + (spam-backend-valid-p backend)) (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) found) (dolist (cell cell-list) (unless found (when (and (eq classification (nth 0 cell)) - (eq check (nth 1 cell))) + (eq backend (nth 1 cell))) (setq found t)))) found) (progn - (gnus-message 5 (format "%s called with bad ID, type, classification, or check" - "spam-log-unregistration-needed-p")) + (gnus-error + 7 + (format "%s called with bad ID, type, classification, or spam-backend" + "spam-log-unregistration-needed-p")) nil)))) ;;; undo a ham- or spam-processor registration (the group is not used) -(defun spam-log-undo-registration (id type classification check &optional group) +(defun spam-log-undo-registration (id type classification backend &optional group) (when (and spam-log-to-registry - (spam-log-unregistration-needed-p id type classification check)) + (spam-log-unregistration-needed-p id type classification backend)) (if (and (stringp id) (spam-process-type-valid-p type) (spam-classification-valid-p classification) - (spam-registration-check-valid-p check)) + (spam-backend-valid-p backend)) (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) new-cell-list found) (dolist (cell cell-list) (unless (and (eq classification (nth 0 cell)) - (eq check (nth 1 cell))) + (eq backend (nth 1 cell))) (push cell new-cell-list))) (gnus-registry-store-extra-entry id type new-cell-list)) (progn - (gnus-message 5 (format "%s called with bad ID, type, check, or group" - "spam-log-undo-registration")) + (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group" + "spam-log-undo-registration")) nil)))) -;;; set up IMAP widening if it's necessary -(defun spam-setup-widening () - (dolist (check spam-list-of-statistical-checks) - (when (symbol-value check) - (setq nnimap-split-download-body-default t)))) - - -;;;; Regex body +;;}}} + +;;{{{ backend functions + +;;{{{ Gmane xrefs +(defun spam-check-gmane-xref () + (let ((header (or + (message-fetch-field "Xref") + (message-fetch-field "Newsgroups")))) + (when header ; return nil when no header + (when (string-match spam-gmane-xref-spam-group + header) + spam-split-group)))) + +;;}}} + +;;{{{ Regex body (defun spam-check-regex-body () (let ((spam-regex-headers-ham spam-regex-body-ham) (spam-regex-headers-spam spam-regex-body-spam)) (spam-check-regex-headers t))) - -;;;; Regex headers +;;}}} + +;;{{{ Regex headers (defun spam-check-regex-headers (&optional body) (let ((type (if body "body" "header")) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group)) ret found) (dolist (h-regex spam-regex-headers-ham) (unless found @@ -1237,8 +1999,9 @@ (setq ret spam-split-group)))) ret)) - -;;;; Blackholes. +;;}}} + +;;{{{ Blackholes. (defun spam-reverse-ip-string (ip) (when (stringp ip) @@ -1248,16 +2011,13 @@ (defun spam-check-blackholes () "Check the Received headers for blackholed relays." - (let ((headers (nnmail-fetch-field "received")) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group)) + (let ((headers (message-fetch-field "received")) ips matches) (when headers (with-temp-buffer (insert headers) (goto-char (point-min)) - (gnus-message 5 "Checking headers for relay addresses") + (gnus-message 6 "Checking headers for relay addresses") (while (re-search-forward "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) @@ -1275,34 +2035,28 @@ (if spam-use-dig (let ((query-result (query-dig query-string))) (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" + (gnus-message 6 "(DIG): positive blackhole check '%s'" query-result) (push (list ip server query-result) matches))) ;; else, if not using dig.el (when (query-dns query-string) - (gnus-message 5 "positive blackhole check") + (gnus-message 6 "positive blackhole check") (push (list ip server (query-dns query-string 'TXT)) matches))))))))) (when matches spam-split-group))) - -;;;; Hashcash. - -(eval-when-compile - (autoload 'mail-check-payment "hashcash")) - -(condition-case nil - (progn - (require 'hashcash) - - (defun spam-check-hashcash () - "Check the headers for hashcash payments." - (mail-check-payment))) ;mail-check-payment returns a boolean - - (file-error)) - -;;;; BBDB +;;}}} + +;;{{{ Hashcash. + +(defun spam-check-hashcash () + "Check the headers for hashcash payments." + (ignore-errors (mail-check-payment))) ;mail-check-payment returns a boolean + +;;}}} + +;;{{{ BBDB ;;; original idea for spam-check-BBDB from Alexander Kotelnikov ;;; @@ -1320,10 +2074,19 @@ (require 'bbdb) (require 'bbdb-com)) (file-error + ;; `bbdb-records' should not be bound as an autoload function + ;; before loading bbdb because of `bbdb-hashtable-size'. + (defalias 'bbdb-records 'ignore) (defalias 'spam-BBDB-register-routine 'ignore) (defalias 'spam-enter-ham-BBDB 'ignore) nil)) + ;; when the BBDB changes, we want to clear out our cache + (defun spam-clear-cache-BBDB (&rest immaterial) + (spam-clear-cache 'spam-use-BBDB)) + + (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) + (defun spam-enter-ham-BBDB (addresses &optional remove) "Enter an address into the BBDB; implies ham (non-spam) sender" (dolist (from addresses) @@ -1337,7 +2100,7 @@ (record (and net-address (bbdb-search-simple nil net-address)))) (when net-address - (gnus-message 5 "%s address %s %s BBDB" + (gnus-message 6 "%s address %s %s BBDB" (if remove "Deleting" "Adding") from (if remove "from" "to")) @@ -1359,20 +2122,37 @@ (defun spam-check-BBDB () "Mail from people in the BBDB is classified as ham or non-spam" - (let ((who (nnmail-fetch-field "from")) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) + (let ((who (message-fetch-field "from")) + bbdb-cache bbdb-hashtable) + (when spam-cache-lookups + (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) + (unless bbdb-cache + (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value + ;; this is based on the expanded (bbdb-hashtable) macro + ;; without the debugging support + (with-current-buffer (bbdb-buffer) + (save-excursion + (save-window-excursion + (bbdb-records nil t) + (mapatoms + (lambda (symbol) + (intern (downcase (symbol-name symbol)) bbdb-cache)) + bbdb-hashtable)))) + (puthash 'spam-use-BBDB bbdb-cache spam-caches))) (when who (setq who (nth 1 (gnus-extract-address-components who))) - (if (bbdb-search-simple nil who) + (if + (if spam-cache-lookups + (intern-soft (downcase who) bbdb-cache) + (bbdb-search-simple nil who)) t (if spam-use-BBDB-exclusive spam-split-group nil))))))) - -;;;; ifile +;;}}} + +;;{{{ ifile ;;; check the ifile backend; return nil if the mail was NOT classified ;;; as spam @@ -1388,9 +2168,6 @@ (defun spam-check-ifile () "Check the ifile backend for the classification of this message." (let ((article-buffer-name (buffer-name)) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group)) category return) (with-temp-buffer (let ((temp-buffer-name (buffer-name)) @@ -1404,7 +2181,7 @@ ;; check the return now (we're back in the temp buffer) (goto-char (point-min)) (if (not (eobp)) - (setq category (buffer-substring (point) (spam-point-at-eol)))) + (setq category (buffer-substring (point) (point-at-eol)))) (when (not (zerop (length category))) ; we need a category here (if spam-ifile-all-categories (setq return category) @@ -1443,8 +2220,9 @@ (defun spam-ifile-unregister-ham-routine (articles) (spam-ifile-register-ham-routine articles t)) - -;;;; spam-stat +;;}}} + +;;{{{ spam-stat (eval-when-compile (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat") @@ -1466,10 +2244,7 @@ (defun spam-check-stat () "Check the spam-stat backend for the classification of this message" - (let ((spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group)) - (spam-stat-split-fancy-spam-group spam-split-group) ; override + (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override (spam-stat-buffer (buffer-name)) ; stat the current buffer category return) (spam-stat-split-fancy))) @@ -1504,9 +2279,9 @@ (defun spam-maybe-spam-stat-save () (when spam-use-stat (spam-stat-save))))) - - -;;;; Blacklists and whitelists. +;;}}} + +;;{{{ Blacklists and whitelists. (defvar spam-whitelist-cache nil) (defvar spam-blacklist-cache nil) @@ -1522,7 +2297,8 @@ With a non-nil REMOVE, remove them." (interactive "sAddress: ") (spam-enter-list address spam-whitelist remove) - (setq spam-whitelist-cache nil)) + (setq spam-whitelist-cache nil) + (spam-clear-cache 'spam-use-whitelist)) ;;; address can be a list, too (defun spam-enter-blacklist (address &optional remove) @@ -1530,7 +2306,8 @@ With a non-nil REMOVE, remove them." (interactive "sAddress: ") (spam-enter-list address spam-blacklist remove) - (setq spam-blacklist-cache nil)) + (setq spam-blacklist-cache nil) + (spam-clear-cache 'spam-use-whitelist)) (defun spam-enter-list (addresses file &optional remove) "Enter ADDRESSES into the given FILE. @@ -1559,29 +2336,50 @@ (insert a "\n"))))) (save-buffer)))) +(defun spam-filelist-build-cache (type) + (let ((cache (if (eq type 'spam-use-blacklist) + spam-blacklist-cache + spam-whitelist-cache)) + parsed-cache) + (unless (gethash type spam-caches) + (while cache + (let ((address (pop cache))) + (unless (zerop (length address)) ; 0 for a nil address too + (setq address (regexp-quote address)) + ;; fix regexp-quote's treatment of user-intended regexes + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address)))) + (push address parsed-cache))) + (puthash type parsed-cache spam-caches)))) + +(defun spam-filelist-check-cache (type from) + (when (stringp from) + (spam-filelist-build-cache type) + (let (found) + (dolist (address (gethash type spam-caches)) + (when (and address (string-match address from)) + (setq found t) + (return))) + found))) + ;;; returns t if the sender is in the whitelist, nil or ;;; spam-split-group otherwise (defun spam-check-whitelist () ;; FIXME! Should it detect when file timestamps change? - (let ((spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) - (unless spam-whitelist-cache - (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) - (if (spam-from-listed-p spam-whitelist-cache) - t - (if spam-use-whitelist-exclusive - spam-split-group - nil)))) + (unless spam-whitelist-cache + (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) + (if (spam-from-listed-p 'spam-use-whitelist) + t + (if spam-use-whitelist-exclusive + spam-split-group + nil))) (defun spam-check-blacklist () ;; FIXME! Should it detect when file timestamps change? - (let ((spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) - (unless spam-blacklist-cache - (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) - (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))) + (unless spam-blacklist-cache + (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) + (and (spam-from-listed-p 'spam-use-blacklist) + spam-split-group)) (defun spam-parse-list (file) (when (file-readable-p file) @@ -1589,7 +2387,7 @@ (with-temp-buffer (insert-file-contents file) (while (not (eobp)) - (setq address (buffer-substring (point) (spam-point-at-eol))) + (setq address (buffer-substring (point) (point-at-eol))) (forward-line 1) ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) @@ -1597,20 +2395,10 @@ (push (or pure-address address) contents))))) (nreverse contents)))) -(defun spam-from-listed-p (cache) - (let ((from (nnmail-fetch-field "from")) +(defun spam-from-listed-p (type) + (let ((from (message-fetch-field "from")) found) - (while cache - (let ((address (pop cache))) - (unless (zerop (length address)) ; 0 for a nil address too - (setq address (regexp-quote address)) - ;; fix regexp-quote's treatment of user-intended regexes - (while (string-match "\\\\\\*" address) - (setq address (replace-match ".*" t t address)))) - (when (and address (string-match address from)) - (setq found t - cache nil)))) - found)) + (spam-filelist-check-cache type from))) (defun spam-filelist-register-routine (articles blacklist &optional unregister) (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) @@ -1619,7 +2407,7 @@ (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) (remove-function (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) - from addresses unregister-list) + from addresses unregister-list article-unregister-list) (dolist (article articles) (let ((from (spam-fetch-field-from-fast article)) (id (spam-fetch-field-message-id-fast article)) @@ -1635,6 +2423,7 @@ (null unregister) (spam-log-unregistration-needed-p id 'process declassification de-symbol)) + (push article article-unregister-list) (push from unregister-list)) (unless sender-ignored (push from addresses))))) @@ -1643,7 +2432,7 @@ (funcall enter-function addresses t) ; unregister all these addresses ;; else, register normally and unregister what we need to (funcall remove-function unregister-list t) - (dolist (article unregister-list) + (dolist (article article-unregister-list) (spam-log-undo-registration (spam-fetch-field-message-id-fast article) 'process @@ -1663,19 +2452,34 @@ (defun spam-whitelist-register-routine (articles &optional unregister) (spam-filelist-register-routine articles nil unregister)) - -;;;; Spam-report glue +;;}}} + +;;{{{ Spam-report glue (gmane and resend reporting) (defun spam-report-gmane-register-routine (articles) (when articles - (apply 'spam-report-gmane articles))) - - -;;;; Bogofilter + (apply 'spam-report-gmane-spam articles))) + +(defun spam-report-gmane-unregister-routine (articles) + (when articles + (apply 'spam-report-gmane-ham articles))) + +(defun spam-report-resend-register-ham-routine (articles) + (spam-report-resend-register-routine articles t)) + +(defun spam-report-resend-register-routine (articles &optional ham) + (let* ((resend-to-gp + (if ham + (gnus-parameter-ham-resend-to gnus-newsgroup-name) + (gnus-parameter-spam-resend-to gnus-newsgroup-name))) + (spam-report-resend-to (or (car-safe resend-to-gp) + spam-report-resend-to))) + (spam-report-resend articles ham))) + +;;}}} + +;;{{{ Bogofilter (defun spam-check-bogofilter-headers (&optional score) - (let ((header (nnmail-fetch-field spam-bogofilter-header)) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) + (let ((header (message-fetch-field spam-bogofilter-header))) (when header ; return nil when no header (if score ; scoring mode (if (string-match "spamicity=\\([0-9.]+\\)" header) @@ -1687,58 +2491,72 @@ spam-split-group))))) ;; return something sensible if the score can't be determined -(defun spam-bogofilter-score () +(defun spam-bogofilter-score (&optional recheck) "Get the Bogofilter spamicity score" - (interactive) + (interactive "P") (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) - (let ((score (or (spam-check-bogofilter-headers t) + (let ((score (or (unless recheck + (spam-check-bogofilter-headers t)) (spam-check-bogofilter t)))) + (gnus-summary-show-article) (message "Spamicity score %s" score) - (or score "0")) - (gnus-summary-show-article))) - + (or score "0")))) + +(defun spam-verify-bogofilter () + "Verify the Bogofilter version is sufficient." + (when (eq spam-bogofilter-valid 'unknown) + (setq spam-bogofilter-valid + (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\." + (shell-command-to-string + (format "%s -V" spam-bogofilter-program)))))) + spam-bogofilter-valid) + (defun spam-check-bogofilter (&optional score) - "Check the Bogofilter backend for the classification of this message" - (let ((article-buffer-name (buffer-name)) - (db spam-bogofilter-database-directory) + "Check the Bogofilter backend for the classification of this message." + (if (spam-verify-bogofilter) + (let ((article-buffer-name (buffer-name)) + (db spam-bogofilter-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-program + nil temp-buffer-name nil + (if db `("-d" ,db "-v") `("-v")))) + (setq return (spam-check-bogofilter-headers score)))) return) - (with-temp-buffer - (let ((temp-buffer-name (buffer-name))) - (save-excursion - (set-buffer article-buffer-name) - (apply 'call-process-region - (point-min) (point-max) - spam-bogofilter-program - nil temp-buffer-name nil - (if db `("-d" ,db "-v") `("-v")))) - (setq return (spam-check-bogofilter-headers score)))) - return)) + (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) (defun spam-bogofilter-register-with-bogofilter (articles spam &optional unregister) "Register an article, given as a string, as spam or non-spam." - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article)) - (db spam-bogofilter-database-directory) - (switch (if unregister - (if spam - spam-bogofilter-spam-strong-switch - spam-bogofilter-ham-strong-switch) - (if spam - spam-bogofilter-spam-switch - spam-bogofilter-ham-switch)))) - (when (stringp article-string) - (with-temp-buffer - (insert article-string) - - (apply 'call-process-region - (point-min) (point-max) - spam-bogofilter-program - nil nil nil switch - (if db `("-d" ,db "-v") `("-v")))))))) + (if (spam-verify-bogofilter) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-bogofilter-database-directory) + (switch (if unregister + (if spam + spam-bogofilter-spam-strong-switch + spam-bogofilter-ham-strong-switch) + (if spam + spam-bogofilter-spam-switch + spam-bogofilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-program + nil nil nil switch + (if db `("-d" ,db "-v") `("-v"))))))) + (gnus-error 5 "`spam.el' doesn't support obsolete bogofilter versions"))) (defun spam-bogofilter-register-spam-routine (articles &optional unregister) (spam-bogofilter-register-with-bogofilter articles t unregister)) @@ -1753,14 +2571,12 @@ (spam-bogofilter-register-ham-routine articles t)) - -;;;; spamoracle +;;}}} + +;;{{{ spamoracle (defun spam-check-spamoracle () "Run spamoracle on an article to determine whether it's spam." - (let ((article-buffer-name (buffer-name)) - (spam-split-group (if spam-split-symbolic-return - 'spam - spam-split-group))) + (let ((article-buffer-name (buffer-name))) (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (save-excursion @@ -1816,13 +2632,283 @@ (defun spam-spamoracle-unlearn-spam (articles &optional unregister) (spam-spamoracle-learn-spam articles t)) - -;;;; Hooks +;;}}} + +;;{{{ SpamAssassin +;;; based mostly on the bogofilter code +(defun spam-check-spamassassin-headers (&optional score) + "Check the SpamAssassin headers for the classification of this message." + (if score ; scoring mode + (let ((header (message-fetch-field spam-spamassassin-spam-status-header))) + (when header + (if (string-match spam-spamassassin-score-regexp header) + (match-string 1 header) + "0"))) + ;; spam detection mode + (let ((header (message-fetch-field spam-spamassassin-spam-flag-header))) + (when header ; return nil when no header + (when (string-match spam-spamassassin-positive-spam-flag-header + header) + spam-split-group))))) + +(defun spam-check-spamassassin (&optional score) + "Check the SpamAssassin backend for the classification of this message." + (let ((article-buffer-name (buffer-name))) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) spam-assassin-program + nil temp-buffer-name nil spam-spamassassin-arguments)) + ;; check the return now (we're back in the temp buffer) + (goto-char (point-min)) + (spam-check-spamassassin-headers score))))) + +;; return something sensible if the score can't be determined +(defun spam-spamassassin-score (&optional recheck) + "Get the SpamAssassin score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-spamassassin-headers t)) + (spam-check-spamassassin t)))) + (gnus-summary-show-article) + (message "SpamAssassin score %s" score) + (or score "0")))) + +(defun spam-spamassassin-register-with-sa-learn (articles spam + &optional unregister) + "Register articles with spamassassin's sa-learn as spam or non-spam." + (if articles + (let ((action (if unregister spam-sa-learn-unregister-switch + (if spam spam-sa-learn-spam-switch + spam-sa-learn-ham-switch))) + (summary-buffer-name (buffer-name))) + (with-temp-buffer + ;; group the articles into mbox format + (dolist (article articles) + (let (article-string) + (save-excursion + (set-buffer summary-buffer-name) + (setq article-string (spam-get-article-as-string article))) + (when (stringp article-string) + (insert "From \n") ; mbox separator (sa-learn only checks the + ; first five chars, so we can get away with + ; a bogus line)) + (insert article-string) + (insert "\n")))) + ;; call sa-learn on all messages at the same time + (apply 'call-process-region + (point-min) (point-max) + spam-sa-learn-program + nil nil nil "--mbox" + (if spam-sa-learn-rebuild + (list action) + `("--no-rebuild" ,action))))))) + +(defun spam-spamassassin-register-spam-routine (articles &optional unregister) + (spam-spamassassin-register-with-sa-learn articles t unregister)) + +(defun spam-spamassassin-register-ham-routine (articles &optional unregister) + (spam-spamassassin-register-with-sa-learn articles nil unregister)) + +(defun spam-spamassassin-unregister-spam-routine (articles) + (spam-spamassassin-register-with-sa-learn articles t t)) + +(defun spam-spamassassin-unregister-ham-routine (articles) + (spam-spamassassin-register-with-sa-learn articles nil t)) + +;;}}} + +;;{{{ Bsfilter +;;; based mostly on the bogofilter code +(defun spam-check-bsfilter-headers (&optional score) + (if score + (or (nnmail-fetch-field spam-bsfilter-probability-header) + "0") + (let ((header (nnmail-fetch-field spam-bsfilter-header))) + (when header ; return nil when no header + (when (string-match "YES" header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-bsfilter-score (&optional recheck) + "Get the Bsfilter spamicity score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-bsfilter-headers t)) + (spam-check-bsfilter t)))) + (gnus-summary-show-article) + (message "Spamicity score %s" score) + (or score "0")))) + +(defun spam-check-bsfilter (&optional score) + "Check the Bsfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (dir spam-bsfilter-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-program + nil temp-buffer-name nil + "--pipe" + "--insert-flag" + "--insert-probability" + (when dir + (list "--homedir" dir)))) + (setq return (spam-check-bsfilter-headers score)))) + return)) + +(defun spam-bsfilter-register-with-bsfilter (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (switch (if unregister + (if spam + spam-bsfilter-spam-strong-switch + spam-bsfilter-ham-strong-switch) + (if spam + spam-bsfilter-spam-switch + spam-bsfilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-program + nil nil nil switch + "--update" + (when spam-bsfilter-database-directory + (list "--homedir" + spam-bsfilter-database-directory)))))))) + +(defun spam-bsfilter-register-spam-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles t unregister)) + +(defun spam-bsfilter-unregister-spam-routine (articles) + (spam-bsfilter-register-spam-routine articles t)) + +(defun spam-bsfilter-register-ham-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles nil unregister)) + +(defun spam-bsfilter-unregister-ham-routine (articles) + (spam-bsfilter-register-ham-routine articles t)) + +;;}}} + +;;{{{ CRM114 Mailfilter +(defun spam-check-crm114-headers (&optional score) + (let ((header (message-fetch-field spam-crm114-header))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "( pR: \\([0-9.-]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-crm114-positive-spam-header + header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-crm114-score () + "Get the CRM114 Mailfilter pR" + (interactive) + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (spam-check-crm114-headers t) + (spam-check-crm114 t)))) + (gnus-summary-show-article) + (message "pR: %s" score) + (or score "0")))) + +(defun spam-check-crm114 (&optional score) + "Check the CRM114 Mailfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (db spam-crm114-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil temp-buffer-name nil + (when db (list (concat "--fileprefix=" db))))) + (setq return (spam-check-crm114-headers score)))) + return)) + +(defun spam-crm114-register-with-crm114 (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-crm114-database-directory) + (switch (if unregister + (if spam + spam-crm114-spam-strong-switch + spam-crm114-ham-strong-switch) + (if spam + spam-crm114-spam-switch + spam-crm114-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil nil nil + (when db (list switch (concat "--fileprefix=" db))))))))) + +(defun spam-crm114-register-spam-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles t unregister)) + +(defun spam-crm114-unregister-spam-routine (articles) + (spam-crm114-register-spam-routine articles t)) + +(defun spam-crm114-register-ham-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles nil unregister)) + +(defun spam-crm114-unregister-ham-routine (articles) + (spam-crm114-register-ham-routine articles t)) + +;;}}} + +;;}}} + +;;{{{ Hooks ;;;###autoload -(defun spam-initialize () - "Install the spam.el hooks and do other initialization" +(defun spam-initialize (&rest symbols) + "Install the spam.el hooks and do other initialization. +When SYMBOLS is given, set those variables to t. This is so you +can call spam-initialize before you set spam-use-* variables on +explicitly, and matters only if you need the extra headers +installed through spam-necessary-extra-headers." (interactive) + + (dolist (var symbols) + (set var t)) + + (dolist (header (spam-necessary-extra-headers)) + (add-to-list 'nnmail-extra-headers header) + (add-to-list 'gnus-extra-headers header)) + (setq spam-install-hooks t) ;; TODO: How do we redo this every time the `spam' face is customized? (push '((eq mark gnus-spam-mark) . spam) @@ -1834,7 +2920,7 @@ (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) - (add-hook 'gnus-summary-prepare-hook 'spam-find-spam)) + (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)) (defun spam-unload-hook () "Uninstall the spam.el hooks" @@ -1851,6 +2937,7 @@ (when spam-install-hooks (spam-initialize)) +;;}}} (provide 'spam) diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/uudecode.el --- a/lisp/gnus/uudecode.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/uudecode.el Sun Oct 28 09:18:39 2007 +0000 @@ -27,8 +27,6 @@ ;;; Code: -(autoload 'executable-find "executable") - (eval-when-compile (require 'cl)) (eval-and-compile diff -r b6f5dc84b2e1 -r a3c27999decb lisp/gnus/webmail.el --- a/lisp/gnus/webmail.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/gnus/webmail.el Sun Oct 28 09:18:39 2007 +0000 @@ -196,10 +196,9 @@ (defun webmail-debug (str) (with-temp-buffer (insert "\n---------------- A bug at " str " ------------------\n") - (mapcar #'(lambda (sym) - (if (boundp sym) - (gnus-pp `(setq ,sym ',(eval sym))))) - '(webmail-type user)) + (dolist (sym '(webmail-type user)) + (if (boundp sym) + (gnus-pp `(setq ,sym ',(eval sym))))) (insert "---------------- webmail buffer ------------------\n\n") (insert-buffer-substring webmail-buffer) (insert "\n---------------- end of buffer ------------------\n\n") diff -r b6f5dc84b2e1 -r a3c27999decb lisp/net/netrc.el --- a/lisp/net/netrc.el Sun Oct 28 04:58:17 2007 +0000 +++ b/lisp/net/netrc.el Sun Oct 28 09:18:39 2007 +0000 @@ -32,27 +32,45 @@ ;;; Code: ;;; -;;; .netrc and .authinforc parsing +;;; .netrc and .authinfo rc parsing ;;; (defalias 'netrc-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position)) +;; autoload encrypt + +(eval-and-compile + (autoload 'encrypt-find-model "encrypt") + (autoload 'encrypt-insert-file-contents "encrypt")) + +(defgroup netrc nil + "Netrc configuration." + :group 'comm) + +(defvar netrc-services-file "/etc/services" + "The name of the services file.") (defun netrc-parse (file) - "Parse FILE and return a list of all entries in the file." + (interactive "fFile to Parse: ") + "Parse FILE and return an list of all entries in the file." (when (file-exists-p file) (with-temp-buffer (let ((tokens '("machine" "default" "login" "password" "account" "macdef" "force" "port")) + (encryption-model (encrypt-find-model file)) alist elem result pair) - (insert-file-contents file) + + (if encryption-model + (encrypt-insert-file-contents file encryption-model) + (insert-file-contents file)) + (goto-char (point-min)) ;; Go through the file, line by line. (while (not (eobp)) - (narrow-to-region (point) (netrc-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) ;; For each line, get the tokens and values. (while (not (eobp)) (skip-chars-forward "\t ") @@ -113,16 +131,79 @@ (when result (setq result (nreverse result)) (while (and result - (not (equal (or port defaultport "nntp") - (or (netrc-get (car result) "port") - defaultport "nntp")))) + (not (netrc-port-equal + (or port defaultport "nntp") + (or (netrc-get (car result) "port") + defaultport "nntp")))) (pop result)) (car result)))) +(defun netrc-machine-user-or-password (mode authinfo-file-or-list machines ports defaults) + "Get the user name or password according to MODE from AUTHINFO-FILE-OR-LIST. +Matches a machine from MACHINES and a port from PORTS, giving +default ports DEFAULTS to `netrc-machine'. + +MODE can be \"login\" or \"password\", suitable for passing to +`netrc-get'." + (let ((authinfo-list (if (stringp authinfo-file-or-list) + (netrc-parse authinfo-file-or-list) + authinfo-file-or-list)) + (ports (or ports '(nil))) + (defaults (or defaults '(nil))) + info) + (dolist (machine machines) + (dolist (default defaults) + (dolist (port ports) + (let ((alist (netrc-machine authinfo-list machine port default))) + (setq info (or (netrc-get alist mode) info)))))) + info)) + (defun netrc-get (alist type) "Return the value of token TYPE from ALIST." (cdr (assoc type alist))) +(defun netrc-port-equal (port1 port2) + (when (numberp port1) + (setq port1 (or (netrc-find-service-name port1) port1))) + (when (numberp port2) + (setq port2 (or (netrc-find-service-name port2) port2))) + (equal port1 port2)) + +(defun netrc-parse-services () + (when (file-exists-p netrc-services-file) + (let ((services nil)) + (with-temp-buffer + (insert-file-contents netrc-services-file) + (while (search-forward "#" nil t) + (delete-region (1- (point)) (point-at-eol))) + (goto-char (point-min)) + (while (re-search-forward + "^ *\\([^ \n\t]+\\)[ \t]+\\([0-9]+\\)/\\([^ \t\n]+\\)" nil t) + (push (list (match-string 1) (string-to-number (match-string 2)) + (intern (downcase (match-string 3)))) + services)) + (nreverse services))))) + +(defun netrc-find-service-name (number &optional type) + (let ((services (netrc-parse-services)) + service) + (setq type (or type 'tcp)) + (while (and (setq service (pop services)) + (not (and (= number (cadr service)) + (eq type (caddr service))))) + ) + (car service))) + +(defun netrc-find-service-number (name &optional type) + (let ((services (netrc-parse-services)) + service) + (setq type (or type 'tcp)) + (while (and (setq service (pop services)) + (not (and (string= name (car service)) + (eq type (caddr service))))) + ) + (cadr service))) + (provide 'netrc) ;;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55