From 9b3ebcb696524f3711c46a4386e54e9ab5388b74 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Sat, 29 Mar 2008 19:54:11 +0000 Subject: [PATCH] Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1104 --- doc/misc/ChangeLog | 46 +++++++++++++- doc/misc/gnus-faq.texi | 21 ++++--- doc/misc/gnus-news.texi | 22 +++++++ doc/misc/gnus.texi | 134 ++++++++++++++++++++++++++++++++++------ lisp/gnus/ChangeLog | 143 +++++++++++++++++++++++++++++++++++++++++- lisp/gnus/auth-source.el | 150 +++++++++++++++++++++++++++++++++------------ lisp/gnus/gnus-art.el | 72 ++++++++++++++++------ lisp/gnus/gnus-group.el | 61 +++++++++++++++--- lisp/gnus/gnus-registry.el | 8 ++- lisp/gnus/gnus-score.el | 12 ++-- lisp/gnus/gnus-sum.el | 23 +++++++ lisp/gnus/mail-source.el | 3 +- lisp/gnus/message.el | 142 ++++++++++++++++++++++++++++++++++++------ lisp/gnus/mml.el | 51 ++++++++++----- lisp/gnus/mml2015.el | 14 +++-- lisp/gnus/nnimap.el | 2 +- lisp/gnus/nnmh.el | 7 ++- lisp/gnus/nntp.el | 20 ++++-- 18 files changed, 771 insertions(+), 160 deletions(-) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 5d13dbf0c11..26a5b116c21 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,45 @@ +2008-03-22 Reiner Steib + + * gnus.texi (Foreign Groups): Add gnus-read-ephemeral-gmane-group, + gnus-read-ephemeral-gmane-group-url, + gnus-read-ephemeral-emacs-bug-group, + gnus-read-ephemeral-debian-bug-group. + +2008-03-21 Reiner Steib + + * gnus.texi (MIME Commands): Add gnus-article-browse-html-article. + + * gnus-news.texi: Add EasyPG. Add gnus-article-browse-html-article. + Add FIXMEs for Bookmarks and gnus-registry-marks. + +2008-03-16 Reiner Steib + + * gnus.texi (Smileys): Document `smiley-style'. + +2008-03-21 Reiner Steib + + * gnus.texi (Gnus Development): Clarify difference between ding and + gnu.emacs.gnus. + (MIME Commands, Using MIME, RSS): Fix markup. + + * gnus-faq.texi ([8.4]): Ditto. + +2008-03-20 Reiner Steib + + * gnus.texi (Emacsen): Remove obsolete stuff. + +2008-03-19 Reiner Steib + + * gnus.texi (Oort Gnus): Add version info WRT + `mail-source-delete-incoming'. + +2008-03-16 Reiner Steib + + * gnus.texi (Top): Add "Other related manuals" and version info in + `iftex' output. + (Formatting Fonts): Add index entries for gnus-mouse-face, gnus-face-0, + gnus-balloon-face-0 and the corresponding format specifiers. + 2008-03-26 Michael Albinus * tramp.texi (Filename completion): Remove footnote about let-bind @@ -24,8 +66,8 @@ 2008-03-14 Stefan Monnier * gnus.texi (Example Methods, Direct Functions, Indirect Functions) - (Common Variables): Give precedence to the netcat methods over the telnet - methods, and mention that they are more reliable. + (Common Variables): Give precedence to the netcat methods over the + telnet methods, and mention that they are more reliable. 2008-03-13 Carsten Dominik diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index a626c20b541..8d482d5b487 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -2131,22 +2131,23 @@ Which mailing lists and newsgroups are there? @subsubheading Answer -There's the newsgroup gnu.emacs.gnus -(also available as -@uref{http://dir.gmane.org/gmane.emacs.gnus.user, -gmane.emacs.gnus.user}) -which deals with general Gnus questions. -The ding mailing list (ding@@gnus.org) deals with development of -Gnus. You can read the ding list via NNTP, too under the name -@uref{http://dir.gmane.org/gmane.emacs.gnus.general, -gmane.emacs.gnus.general} from news.gmane.org. +There's the newsgroup gnu.emacs.gnus (also available as +@uref{http://dir.gmane.org/gmane.emacs.gnus.user, +gmane.emacs.gnus.user}) which deals with general Gnus questions. If you +have questions about development versions of Gnus, you should better ask +on the ding mailing list, see below. If you want to stay in the big8, news.software.newssreaders is also read by some Gnus users (but chances for qualified help are much better in -the above groups) and if you speak German, there's +the above groups). If you speak German, there's de.comm.software.gnus. +The ding mailing list (ding@@gnus.org) deals with development of +Gnus. You can read the ding list via NNTP, too under the name +@uref{http://dir.gmane.org/gmane.emacs.gnus.general, +gmane.emacs.gnus.general} from news.gmane.org. + @node [8.5] @subsubheading Question 8.5 diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 3e0a47dd7d8..f611bee067e 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -75,6 +75,12 @@ timeout of 16 seconds (see @code{password-cache-expiry}). If passphrase is managed by this mechanism. Passwords for ManageSieve connections are managed by this mechanism, after querying the user about whether to do so. + +@item Using EasyPG with Gnus +When EasyPG, is available, Gnus will use it instead of @acronym{PGG}. +EasyPG is an Emacs user interface to GNU Privacy Guard. @xref{Top, +,EasyPG Assistant user's manual, epa, EasyPG Assistant user's manual}. +EasyPG is included in Emacs 23 and available separately as well. @end itemize @item Changes in group mode @@ -98,6 +104,15 @@ Customization}. that are not reused when you select another article. @xref{Sticky Articles}. +@c @item Bookmarks +@c FIXME: To be added + +@item Gnus can selectively display @samp{text/html} articles +with a WWW browser with @kbd{K H}. @xref{MIME Commands}. + +@c gnus-registry-marks +@c FIXME: To be added + @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 @@ -254,6 +269,13 @@ This feature, accessible via the functions 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). + +@c @item nnmairix.el +@c FIXME + +@c @item nnir.el +@c FIXME + @end itemize @item Appearance diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 3a9945c10b6..e1dda4eadf4 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -391,6 +391,17 @@ like they want it to behave. A program should not control people; people should be empowered to do what they want by using (or abusing) the program. +@c Adjust ../Makefile.in if you change the following line: +This manual corresponds to Gnus v5.10.9. + +@heading Other related manuals +@itemize +@item Message manual: Composing messages +@item Emacs-MIME: Composing messages; @acronym{MIME}-specific parts. +@item Sieve: Managing Sieve scripts in Emacs. +@item PGG: @acronym{PGP/MIME} with Gnus. +@end itemize + @end iftex @menu @@ -2736,6 +2747,55 @@ groups from different @acronym{NNTP} servers. Also @pxref{Group Levels}; newsgroups. +The following commands create ephemeral groups. They can be called not +only from the Group buffer, but in any Gnus buffer. + +@table @code +@item gnus-read-ephemeral-gmane-group +@findex gnus-read-ephemeral-gmane-group +@vindex gnus-gmane-group-download-format +Read an ephemeral group on Gmane.org. The articles are downloaded via +HTTP using the URL specified by @code{gnus-gmane-group-download-format}. +Gnus will prompt you for a group name, the start article number and an +the article range. + +@item gnus-read-ephemeral-gmane-group-url +@findex gnus-read-ephemeral-gmane-group-url +This command is similar to @code{gnus-read-ephemeral-gmane-group}, but +the group name and the article number and range are constructed from a +given @acronym{URL}. Supported @acronym{URL} formats include e.g. +@url{http://thread.gmane.org/gmane.foo.bar/12300/focus=12399}, +@url{http://thread.gmane.org/gmane.foo.bar/12345/}, +@url{http://article.gmane.org/gmane.foo.bar/12345/}, +@url{http://permalink.gmane.org/gmane.foo.bar/12345/}, and +@url{http://news.gmane.org/group/gmane.foo.bar/thread=12345}. + +@item gnus-read-ephemeral-emacs-bug-group +@findex gnus-read-ephemeral-emacs-bug-group +Read an Emacs bug report in an ephemeral group. Gnus will prompt for a +bug number. The default is the number at point. The @acronym{URL} is +specified in @code{gnus-bug-group-download-format-alist}. + +@item gnus-read-ephemeral-debian-bug-group +@findex gnus-read-ephemeral-debian-bug-group +Read a Debian bug report in an ephemeral group. Analog to +@code{gnus-read-ephemeral-emacs-bug-group}. +@end table + +Some of these command are also useful for article buttons, @xref{Article +Buttons}. + +Here is an example: +@lisp +(require 'gnus-art) +(add-to-list + 'gnus-button-alist + '("#\\([0-9]+\\)\\>" 1 + (string-match "\\" (or gnus-newsgroup-name "")) + gnus-read-ephemeral-emacs-bug-group 1)) +@end lisp + + @node Group Parameters @section Group Parameters @cindex group parameters @@ -9679,6 +9739,21 @@ The rest of these @acronym{MIME} commands do not use the numerical prefix in the same manner: @table @kbd +@item K H +@kindex K H (Summary) +@findex gnus-article-browse-html-article +View @samp{text/html} parts of the current article with a WWW browser. +The message header is added to the beginning of every html part unless +the prefix argument is given. + +Warning: Spammers use links to images in HTML articles to verify whether +you have read the message. As this command passes the @acronym{HTML} +content to the browser without eliminating these ``web bugs'' you should +only use it for mails from trusted senders. + +If you always want to display @acronym{HTML} parts in the browser, set +@code{mm-text-html-renderer} to @code{nil}. + @item K b @kindex K b (Summary) Make all the @acronym{MIME} parts have buttons in front of them. This is @@ -9834,7 +9909,7 @@ Display "multipart/alternative" parts as "multipart/mixed". @item gnus-mime-display-multipart-related-as-mixed Display "multipart/related" parts as "multipart/mixed". -If displaying "text/html" is discouraged, see +If displaying @samp{text/html} is discouraged, see @code{mm-discouraged-alternatives}, images or other material inside a "multipart/related" part might be overlooked when this variable is @code{nil}. @ref{Display Customization, Display Customization, , @@ -11539,7 +11614,7 @@ command respects the @samp{print=} specifications in the @item i (Article) @kindex i (Article) Insert the contents of the @acronym{MIME} object into the buffer -(@code{gnus-mime-inline-part}) as text/plain. If given a prefix, insert +(@code{gnus-mime-inline-part}) as @samp{text/plain}. If given a prefix, insert 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 @@ -16883,7 +16958,7 @@ summary buffer. (add-to-list 'nnmail-extra-headers nnrss-url-field) @end lisp -Even if you have added @code{"text/html"} to the +Even if you have added @samp{text/html} to the @code{mm-discouraged-alternatives} variable (@pxref{Display Customization, ,Display Customization, emacs-mime, The Emacs MIME Manual}) since you don't want to see @acronym{HTML} parts, it might be @@ -22243,12 +22318,16 @@ inserted. @node Formatting Fonts @subsection Formatting Fonts +@cindex %(, %) +@vindex gnus-mouse-face There are specs for highlighting, and these are shared by all the format variables. Text inside the @samp{%(} and @samp{%)} specifiers will get the special @code{mouse-face} property set, which means that it will be highlighted (with @code{gnus-mouse-face}) when you put the mouse pointer over it. +@cindex %@{, %@} +@vindex gnus-face-0 Text inside the @samp{%@{} and @samp{%@}} specifiers will have their normal faces set using @code{gnus-face-0}, which is @code{bold} by default. If you say @samp{%1@{}, you'll get @code{gnus-face-1} instead, @@ -22256,6 +22335,9 @@ and so on. Create as many faces as you wish. The same goes for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. +@cindex %<<, %>>, guillemets +@c @cindex %<<, %>>, %«, %», guillemets +@vindex gnus-balloon-face-0 Text inside the @samp{%<<} and @samp{%>>} specifiers will get the special @code{balloon-help} property set to @code{gnus-balloon-face-0}. If you say @samp{%1<<}, you'll get @@ -23445,14 +23527,22 @@ the second element is the regexp match group that is to be replaced by the picture; and the third element is the name of the file to be displayed. -The following variables customize where Smiley will look for these -files: +The following variables customize the appearance of the smileys: @table @code +@item smiley-style +@vindex smiley-style +Specifies the smiley style. Predefined smiley styles include +@code{low-color} (small 13x14 pixel, three-color images), @code{medium} +(more colorful images, 16x16 pixel), and @code{grayscale} (grayscale +images, 14x14 pixel). The default depends on the height of the default +face. + @item smiley-data-directory @vindex smiley-data-directory -Where Smiley will look for smiley faces files. +Where Smiley will look for smiley faces files. You shouldn't set this +variable anymore. Customize @code{smiley-style} instead. @item gnus-smiley-file-types @vindex gnus-smiley-file-types @@ -26190,29 +26280,27 @@ that. Not reliably, at least. Older versions of Gnus may work on older Emacs versions. Particularly, Gnus 5.10.8 should also work on Emacs 20.7 and XEmacs 21.1. -There are some vague differences between Gnus on the various -platforms---XEmacs features more graphics (a logo and a toolbar)---but -other than that, things should look pretty much the same under all -Emacsen. - @node Gnus Development @subsection Gnus Development Gnus is developed in a two-phased cycle. The first phase involves much -discussion on the @samp{ding@@gnus.org} mailing list, where people +discussion on the development mailing list @samp{ding@@gnus.org}, where people propose changes and new features, post patches and new back ends. This phase is called the @dfn{alpha} phase, since the Gnusae released in this phase are @dfn{alpha releases}, or (perhaps more commonly in other circles) @dfn{snapshots}. During this phase, Gnus is assumed to be unstable and should not be used by casual users. Gnus alpha releases -have names like ``Red Gnus'' and ``Quassia Gnus''. +have names like ``Oort Gnus'' and ``No Gnus''. @xref{Gnus Versions}. -After futzing around for 50-100 alpha releases, Gnus is declared +After futzing around for 10-100 alpha releases, Gnus is declared @dfn{frozen}, and only bug fixes are applied. Gnus loses the prefix, -and is called things like ``Gnus 5.6.32'' instead. Normal people are +and is called things like ``Gnus 5.10.1'' instead. Normal people are supposed to be able to use these, and these are mostly discussed on the -@samp{gnu.emacs.gnus} newsgroup. +@samp{gnu.emacs.gnus} newsgroup. This newgroup is mirrored to the +mailing list @samp{info-gnus-english@@gnu.org} which is carried on Gmane +as @samp{gmane.emacs.gnus.user}. These releases are finally integrated +in Emacs. @cindex Incoming* @vindex mail-source-delete-incoming @@ -26232,10 +26320,16 @@ either discarded or totally rewritten. People reading the mailing list usually keep up with these rapid changes, while people on the newsgroup can't be assumed to do so. -@c FIXME: -@c ding = gmane.emacs.gnus.general -@c newsgroup = gnu.emacs.gnus = gmane.emacs.gnus.user = info-gnus-english +So if you have problems with or questions about the alpha versions, +direct those to the ding mailing list @samp{ding@@gnus.org}. This list +is also available on Gmane as @samp{gmane.emacs.gnus.general}. +@cindex Incoming* +@vindex mail-source-delete-incoming +Some variable defaults differ between alpha Gnusae and released Gnusae, +in particular, @code{mail-source-delete-incoming}. This is to prevent +lossage of mail if an alpha release hiccups while handling the mail. +@xref{Mail Source Customization}. @node Contributors @subsection Contributors @@ -27469,7 +27563,7 @@ variables should change those regexps accordingly. For example: @item Old intermediate incoming mail files (@file{Incoming*}) are deleted after a couple of days, not immediately. @xref{Mail Source -Customization}. (New in Gnus 5.10.10) +Customization}. (New in Gnus 5.10.10 / Emacs 22.2) @end itemize diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7514147711d..82cde814cb2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,56 @@ +2008-03-28 Michael Harnois (tiny change) + + * nnimap.el (nnimap-find-minmax-uid): Fix Exchange 2007 IMAP problem. + +2008-03-24 Reiner Steib + + * message.el (message-signature-separator): Change default. Improve + custom type. + (message-cite-function): Change default to + message-cite-original-without-signature. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add message-cite-function + toggle. + + * message.el (message-check-news-body-syntax): Fix signature check. + (message-setup-1): Mark buffer as unmodified _after_ running + message-setup-hook and handling message-alternative-emails. + (message-shorten-references): Be more strict when building list of + valid references to comply with GNKSA. + + * gnus-group.el (gnus-read-ephemeral-bug-group) + (gnus-read-ephemeral-debian-bug-group) + (gnus-read-ephemeral-emacs-bug-group): Use the correct variable. + + * message.el (message-info): Don't use booleanp which isn't supported + in Emacs 21 and XEmacs. + +2008-03-22 Reiner Steib + + * gnus-group.el (gnus-gmane-group-download-format): Rename from + gnus-group-gmane-group-download-format. + (gnus-group-read-ephemeral-gmane-group): Rename from + gnus-group-read-ephemeral-gmane-group. + (gnus-read-ephemeral-gmane-group-url): Rename from + gnus-group-read-ephemeral-gmane-group-url. + (gnus-bug-group-download-format-alist): New variable. + (gnus-read-ephemeral-bug-group, gnus-read-ephemeral-debian-bug-group) + (gnus-read-ephemeral-emacs-bug-group): New commands. + +2008-03-21 Reiner Steib + + * gnus-art.el (gnus-article-browse-html-article): Fix documentation. + (gnus-visible-headers): Improve custom type. + +2008-03-20 Reiner Steib + + * mml.el (mml-menu): Add workarounds for XEmacs. + + * gnus-art.el (gnus-article-browse-html-article): Inhibit display of + X-Boundary header. + + * message.el (message-simplify-recipients): Fix previous commit. + 2008-03-20 Stefan Monnier * mm-util.el (mm-set-buffer-multibyte): New function. @@ -6,6 +59,85 @@ * gnus-win.el (gnus-configure-frame, gnus-all-windows-visible-p): Prefer fboundp to functionp so it works with macros as well. +2008-03-19 Glenn Morris + + * tls.el (open-tls-stream): Restore use of `tls-end-of-info'. + Accidentally removed in the sync process with Emacs. + +2008-03-19 Reiner Steib + + * message.el (message-alter-recipients-discard-bogus-full-name): New + function. + (message-alter-recipients-function): New variable. + (message-get-reply-headers): Use it. + (message-replace-header): New helper function. + (message-recipients-without-full-name): New variable. + (message-simplify-recipients): New command. + + * mml.el (mml-menu): Add toggle for gnus-gcc-externalize-attachments. + + * message.el (message-info): Handle EasyPG manual. + + * mml.el (mml-menu): Add entry for EasyPG. + +2008-03-18 Nils Ackermann (tiny change) + + * nnmh.el (nnmh-request-expire-articles): Prefer expiry-target group + parameter. + + * message.el (message-disassociate-draft): Specify drafts group name + fully. + +2008-03-17 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-split-fancy-with-parent): Eliminate + unnecessary duplicates from the match list. + +2008-03-17 Katsumi Yamaoka + + * gnus-art.el (gnus-button-handle-info-keystrokes): Don't use optional + args of `how-many' of which the XEmacs version doesn't take; declare + Info-index-next as function. + +2008-03-16 Reiner Steib + + * gnus-score.el (gnus-score-headers): Fix handling of + gnus-inhibit-slow-scoring. + + * gnus-art.el (gnus-article-browse-html-article): Fix type in doc + string. + (gnus-button-url-regexp): Improve handling of parenthesis. + (gnus-button-alist): Extend gnus-button-handle-info-keystrokes entry. + (gnus-button-handle-info-keystrokes): Handle index entries. + +2008-03-14 Katsumi Yamaoka + + * mail-source.el (mail-source-delete-old-incoming) Fix regexp to find + Incoming* files. + +2008-03-13 Teodor Zlatanov + + * auth-source.el (auth-sources): Renamed from auth-source-choices. + (auth-source-pick): Use it. + +2008-03-12 Teodor Zlatanov + + * auth-source.el (auth-source-protocols) + (auth-source-protocols-customize, auth-source-choices): Added and + modified variable customizations and defaults. + (auth-source-pick, auth-source-user-or-password) + (auth-source-protocol-defaults, auth-source-user-or-password-imap) + (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) + (auth-source-user-or-password-sftp) + (auth-source-user-or-password-smtp): Use new variables and provide an + interface to netrc.el. + +2008-03-12 Katsumi Yamaoka + + * nntp.el (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet) + (nntp-open-via-rlogin-and-netcat, nntp-open-via-telnet-and-telnet): + Make sure the nntp port to specify is a string. + 2008-03-12 Stefan Monnier * nntp.el: Use with-current-buffer. @@ -15,8 +147,8 @@ nntp-with-open-group macro. (nntp-with-open-group): Use the function, so it's easier to debug. Add indentation and debugging info. - (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): Recommend the - use of the netcat alternatives. + (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): Recommend + the use of the netcat alternatives. * rfc2047.el (rfc2047-decode-string): Don't use `m'. Avoid mm-string-as-multibyte as well. @@ -53,6 +185,11 @@ * message.el (message-ignored-resent-headers): Add "Delivered-To". +2008-03-10 Daiki Ueno + + * mml2015.el (mml2015-epg-passphrase-callback): Type cast KEY-ID to a + string for caching if it is 'PIN. + 2008-03-08 Reiner Steib * mail-source.el (mail-source-delete-old-incoming-confirm): @@ -2095,7 +2232,7 @@ * gnus.el (gnus-version-number): Bump version. -2007-05-01 Lars Magne Ingebrigtsen +2007-05-01 Lars Magne Ingebrigtsen * gnus.el: No Gnus v0.6 is released. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 116d8b4a6a1..f37e0368845 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -1,7 +1,6 @@ ;;; auth-source.el --- authentication sources for Gnus and Emacs -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2008 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news @@ -32,53 +31,128 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'netrc)) (defgroup auth-source nil "Authentication sources." - :version "22.1" + :version "23.1" ;; No Gnus :group 'gnus) -(defcustom auth-source-choices nil +(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") + (pop3 "pop3" "pop" "pop3s" "110" "995") + (ssh "ssh" "22") + (sftp "sftp" "115") + (smtp "smtp" "25")) + "List of authentication protocols and their names" + + :group 'auth-source + :version "23.1" ;; No Gnus + :type '(repeat :tag "Authentication Protocols" + (cons :tag "Protocol Entry" + (symbol :tag "Protocol") + (repeat :tag "Names" + (string :tag "Name"))))) + +;;; generate all the protocols in a format Customize can use +(defconst auth-source-protocols-customize + (mapcar (lambda (a) + (let ((p (car-safe a))) + (list 'const + :tag (upcase (symbol-name p)) + p))) + auth-source-protocols)) + +;;; this default will be changed to ~/.authinfo.gpg +(defcustom auth-sources '((:source "~/.authinfo.enc" :host t :protocol t)) "List of authentication sources. Each entry is the authentication type with optional properties." :group 'auth-source - :type '(repeat :tag "Authentication Sources" - (cons :tag "Source definition" - (group :tag "Select a source" :inline t - (const :format "" :value :source) - (choice :tag "Authentication information" - (const :tag "None" nil) - (file :tag "File"))) - (checklist :tag "Options" :greedy t - (group :inline t - (choice :tag "Choose the hosts" - (group :tag "Select host by name" :inline t - (const :format "" :value :host) - (string :tag "Host name")) - (group :tag "Select host by regular expression" :inline t - (const :format "" :value :host-regex) - (regexp :tag "Host regular expression")) - (group :tag "Use any host" :inline t - (const :format "" :value :host-any) - (const :tag "Any" t)) - (group :tag "Use if no other host matches" :inline t - (const :tag "Fallback" nil)))) - (group :tag "Choose the protocol" :inline t - (const :format "" :value :protocol) - (choice :tag "Protocol" - (const :tag "Any" t) - (const :tag "Fallback (used if no others match)" nil) - (const :tag "IMAP" imap) - (const :tag "POP3" pop3) - (const :tag "SSH" ssh) - (const :tag "SFTP" sftp) - (const :tag "SMTP" smtp))))))) + :version "23.1" ;; No Gnus + :type `(repeat :tag "Authentication Sources" + (list :tag "Source definition" + (const :format "" :value :source) + (string :tag "Authentication Source") + (const :format "" :value :host) + (choice :tag "Host choice" + (const :tag "Any" t) + (regexp :tag "Host regular expression (TODO)") + (const :tag "Fallback" nil)) + (const :format "" :value :protocol) + (choice :tag "Protocol" + (const :tag "Any" t) + (const :tag "Fallback" nil) + ,@auth-source-protocols-customize)))) ;; temp for debugging -;; (customize-variable 'auth-source-choices) -;; (setq auth-source-choices nil) -;; (format "%S" auth-source-choices) +;; (unintern 'auth-source-protocols) +;; (unintern 'auth-sources) +;; (customize-variable 'auth-sources) +;; (setq auth-sources nil) +;; (format "%S" auth-sources) +;; (customize-variable 'auth-source-protocols) +;; (setq auth-source-protocols nil) +;; (format "%S" auth-source-protocols) +;; (auth-source-pick "a" 'imap) +;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap) +;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap) +;; (auth-source-user-or-password-imap "login" "imap.myhost.com") +;; (auth-source-user-or-password-imap "password" "imap.myhost.com") +;; (auth-source-protocol-defaults 'imap) + +(defun auth-source-pick (host protocol &optional fallback) + "Parse `auth-sources' for HOST and PROTOCOL matches. + +Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t." + (interactive "sHost: \nsProtocol: \n") ;for testing + (let (choices) + (dolist (choice auth-sources) + (let ((h (plist-get choice :host)) + (p (plist-get choice :protocol))) + (when (and + (or (equal t h) + (and (stringp h) (string-match h host)) + (and fallback (equal h nil))) + (or (equal t p) + (and (symbolp p) (equal p protocol)) + (and fallback (equal p nil)))) + (push choice choices)))) + (if choices + choices + (unless fallback + (auth-source-pick host protocol t))))) + +(defun auth-source-user-or-password (mode host protocol) + "Find user or password (from the string MODE) matching HOST and PROTOCOL." + (let (found) + (dolist (choice (auth-source-pick host protocol)) + (setq found (netrc-machine-user-or-password + mode + (plist-get choice :source) + (list host) + (list (format "%s" protocol)) + (auth-source-protocol-defaults protocol))) + (when found + (return found))))) + +(defun auth-source-protocol-defaults (protocol) + "Return a list of default ports and names for PROTOCOL." + (cdr-safe (assoc protocol auth-source-protocols))) + +(defun auth-source-user-or-password-imap (mode host) + (auth-source-user-or-password mode host 'imap)) + +(defun auth-source-user-or-password-pop3 (mode host) + (auth-source-user-or-password mode host 'pop3)) + +(defun auth-source-user-or-password-ssh (mode host) + (auth-source-user-or-password mode host 'ssh)) + +(defun auth-source-user-or-password-sftp (mode host) + (auth-source-user-or-password mode host 'sftp)) + +(defun auth-source-user-or-password-smtp (mode host) + (auth-source-user-or-password mode host 'smtp)) (provide 'auth-source) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 9033ef1ff35..55b59488e8e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -178,12 +178,15 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp) + :type '(choice + (repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp) + (const :tag "Use gnus-ignored-headers" nil) + regexp) :group 'gnus-article-hiding) (defcustom gnus-sorted-header-list @@ -2962,7 +2965,6 @@ message header will be added to the bodies of the \"text/html\" parts." (setq showed t))))) showed)) -;; FIXME: Documentation in texi/gnus.texi missing. (defun gnus-article-browse-html-article (&optional arg) "View \"text/html\" parts of the current article with a WWW browser. The message header is added to the beginning of every html part unless @@ -2970,18 +2972,20 @@ the prefix argument ARG is given. 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. +`gnus-article-browse-html-article' passes the HTML content to the +browser without eliminating these \"web bugs\" you should only +use it for mails from trusted senders. -If you alwasy want to display HTML part in the browser, set +If you always want to display HTML parts in the browser, set `mm-text-html-renderer' to nil." ;; Cf. `mm-w3m-safe-url-regexp' (interactive "P") (if arg (gnus-summary-show-article) (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value) - gnus-visible-headers))) + gnus-visible-headers)) + ;; As we insert a
, there's no need for the body boundary. + (gnus-treat-body-boundary nil)) (gnus-summary-show-article))) (with-current-buffer gnus-article-buffer (let ((header (unless arg @@ -6894,7 +6898,8 @@ groups." (concat "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: - "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]" + ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com + "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*" "\\|" "[" chars punct "]+" "[" chars "]" "\\)")) @@ -7339,9 +7344,9 @@ positives are possible." 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2) ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) - ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" - ;; Info links like `C-h i d m CC Mode RET' - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET\\([ \t\n,]*\\)\\)?" + ;; Info links like `C-h i d m Gnus RET' or `C-h i d m Gnus RET i partial RET' + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 0) ;; This is custom ("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) @@ -7887,13 +7892,40 @@ url is put as the `gnus-button-url' overlay property on the button." ;; (info) will autoload info.el (declare-function Info-menu "info" (menu-item &optional fork)) +(declare-function Info-index-next "info" (num)) (defun gnus-button-handle-info-keystrokes (url) "Call `info' when pushing the corresponding URL button." - ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. - (info) - (Info-directory) - (Info-menu url)) + ;; For links like `C-h i d m gnus RET part RET , ,', `C-h i d m CC Mode RET'. + (let (node indx comma) + (if (string-match + (concat "\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+" + "\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" + "\\([ \t\n]+i[ \t\n]+[^ ]+ ?[^ ]+[ \t\n]+RET" + "\\(?:[ \t\n,]*\\)\\)?") + url) + (setq node (match-string 2 url) + indx (match-string 3 url)) + (error "Can't parse %s" url)) + (info) + (Info-directory) + (Info-menu node) + (when (> (length indx) 0) + (string-match (concat "[ \t\n]+i[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" + "\\([ \t\n,]*\\)") + indx) + (setq comma (match-string 2 indx)) + (setq indx (match-string 1 indx)) + (Info-index indx) + (when comma + (dotimes (i (with-temp-buffer + (insert comma) + ;; Note: the XEmacs version of `how-many' takes + ;; no optional argument. + (goto-char (point-min)) + (how-many ","))) + (Info-index-next 1))) + nil))) ;; Called after pgg-snarf-keys-region, which autoloads pgg.el. (declare-function pgg-display-output-buffer "pgg" (start end status)) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8e2f82b5402..c40948c440e 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2325,7 +2325,7 @@ Return the name of the group if selection was successful." (message "Quit reading the ephemeral group") nil))))) -(defcustom gnus-group-gmane-group-download-format +(defcustom gnus-gmane-group-download-format "http://download.gmane.org/%s/%s/%s" "URL for downloading mbox files. It must contain three \"%s\". They correspond to the group, the @@ -2338,11 +2338,11 @@ minimal and maximal article numbers, respectively." ;; FIXME: ;; - Add documentation, menu, key bindings, ... -(defun gnus-group-read-ephemeral-gmane-group (group start &optional range) +(defun gnus-read-ephemeral-gmane-group (group start &optional range) "Read articles from Gmane group GROUP as an ephemeral group. START is the first article. RANGE specifies how many articles are fetched. The articles are downloaded via HTTP using the URL -specified by `gnus-group-gmane-group-download-format'." +specified by `gnus-gmane-group-download-format'." ;; See for more information. (interactive (list @@ -2357,7 +2357,7 @@ specified by `gnus-group-gmane-group-download-format'." (gnus-thread-sort-functions '(gnus-thread-sort-by-number))) (with-temp-file tmpfile (url-insert-file-contents - (format gnus-group-gmane-group-download-format + (format gnus-gmane-group-download-format group start (+ start range))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group @@ -2366,7 +2366,7 @@ specified by `gnus-group-gmane-group-download-format'." (nndoc-article-type mbox)))) (delete-file tmpfile))) -(defun gnus-group-read-ephemeral-gmane-group-url (url) +(defun gnus-read-ephemeral-gmane-group-url (url) "Create an ephemeral Gmane group from URL. Valid input formats include: @@ -2378,7 +2378,7 @@ Valid input formats include: ;; be customizable? ;; - The URLs should be added to `gnus-button-alist'. Probably we should ;; prompt the user to decide: "View via `browse-url' or in Gnus? " - ;; (`gnus-group-read-ephemeral-gmane-group-url') + ;; (`gnus-read-ephemeral-gmane-group-url') (interactive (list (gnus-group-completing-read "Gmane URL: "))) (let (group start range) @@ -2411,7 +2411,54 @@ Valid input formats include: start (string-to-number (match-string 2 url)))) (t (error "Can't parse URL %s" url))) - (gnus-group-read-ephemeral-gmane-group group start range))) + (gnus-read-ephemeral-gmane-group group start range))) + +(defcustom gnus-bug-group-download-format-alist + '((emacs ;; Only a test bed yet: + . "http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?mbox=yes;bug=%s") + (debian + . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes")) + "Alist of symbols for bug trackers and the corresponding URL format string. +The URL format string must contain a single \"%s\", specifying +the bug number, and browsing the URL must return mbox output." + :group 'gnus-group-foreign + :version "23.1" ;; No Gnus + :type '(repeat (cons (symbol) (string :tag "URL format string")))) + +(defun gnus-read-ephemeral-bug-group (number mbox-url) + "Browse bug NUMBER as ephemeral group." + (interactive (list (read-string "Enter bug number: " + (thing-at-point 'word) nil) + ;; FIXME: Add completing-read from + ;; `gnus-emacs-bug-group-download-format' ... + (cdr (assoc 'emacs gnus-bug-group-download-format-alist)))) + (when (stringp number) + (setq number (string-to-number number))) + (let ((tmpfile (make-temp-file "gnus-temp-group-"))) + (with-temp-file tmpfile + (url-insert-file-contents (format mbox-url number)) + (write-region (point-min) (point-max) tmpfile) + (gnus-group-read-ephemeral-group + "gnus-read-ephemeral-bug" + `(nndoc ,tmpfile + (nndoc-article-type mbox)))) + (delete-file tmpfile))) + +(defun gnus-read-ephemeral-debian-bug-group (number) + "Browse Debian bug NUMBER as ephemeral group." + (interactive (list (read-string "Enter bug number: " + (thing-at-point 'word) nil))) + (gnus-read-ephemeral-bug-group + number + (cdr (assoc 'debian gnus-bug-group-download-format-alist)))) + +(defun gnus-read-ephemeral-emacs-bug-group (number) + "Browse Emacs bug NUMBER as ephemeral group." + (interactive (list (read-string "Enter bug number: " + (thing-at-point 'word) nil))) + (gnus-read-ephemeral-bug-group + number + (cdr (assoc 'emacs gnus-bug-group-download-format-alist)))) (defun gnus-group-jump-to-group (group &optional prompt) "Jump to newsgroup GROUP. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 5141a5e2d32..7cdb075b836 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -520,7 +520,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." matches) (when (and this-sender (equal sender this-sender)) - (setq found (append (gnus-registry-fetch-groups key) found)) + (let ((groups (gnus-registry-fetch-groups key))) + (dolist (group groups) + (setq found (append (list group) (delete group found))))) (push key matches) (gnus-message ;; raise level of messaging if gnus-registry-track-extra @@ -542,7 +544,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." matches) (when (and this-subject (equal subject this-subject)) - (setq found (append (gnus-registry-fetch-groups key) found)) + (let ((groups (gnus-registry-fetch-groups key))) + (dolist (group groups) + (setq found (append (list group) (delete group found))))) (push key matches) (gnus-message ;; raise level of messaging if gnus-registry-track-extra diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index d79007b92e6..7a4fb257504 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1552,20 +1552,20 @@ If FORMAT, also format the current score file." (lambda (score) (length (gnus-score-get header score))) scores))) - ;; Call the scoring function for this type of "header". (when (if (and gnus-inhibit-slow-scoring - (if (and (stringp gnus-inhibit-slow-scoring) + (or (eq gnus-inhibit-slow-scoring t) + (and (stringp gnus-inhibit-slow-scoring) ;; Always true here? ;; (stringp gnus-newsgroup-name) - (string-match gnus-inhibit-slow-scoring - gnus-newsgroup-name)) - t - nil) + (string-match + gnus-inhibit-slow-scoring + gnus-newsgroup-name))) (> 0 (nth 1 (assoc header gnus-header-index)))) (progn (gnus-message 7 "Scoring on headers or body skipped.") nil) + ;; Call the scoring function for this type of "header". (setq new (funcall (nth 2 entry) scores header now expire trace))) (push new news)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d6abbd6c131..2e3b55a0c42 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2543,6 +2543,29 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["Followup via news" gnus-summary-followup-to-mail t] ["Followup via news and yank" gnus-summary-followup-to-mail-with-original t] + ["Strip signature on reply" + (lambda () + (interactive) + (if (not (memq message-cite-function + '(message-cite-original-without-signature + message-cite-original))) + ;; Stupid workaround for XEmacs not honoring :visible. + (message "Can't toggle this value of `message-cite-function'") + (setq message-cite-function + (if (eq message-cite-function + 'message-cite-original-without-signature) + 'message-cite-original + 'message-cite-original-without-signature)))) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (memq message-cite-function + '(message-cite-original-without-signature + message-cite-original)))) + :style toggle + :selected (eq message-cite-function + 'message-cite-original-without-signature) + ,@(if (featurep 'xemacs) nil + '(:help "Strip signature from cited article when replying."))] ;;("Draft" ;;["Send" gnus-summary-send-draft t] ;;["Send bounced" gnus-resend-bounced-mail t]) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 3a90990d5d8..088b91d8d58 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -555,7 +555,8 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." currday files) (setq files (directory-files mail-source-directory t - (concat mail-source-incoming-file-prefix "*")) + (concat "\\`" + (regexp-quote mail-source-incoming-file-prefix))) currday (* (car (current-time)) high2days) currday (+ currday (* low2days (nth 1 (current-time))))) (while files diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a46cb500ee5..a35d7b1bf98 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -415,9 +415,17 @@ for `message-cross-post-insert-note'." ;;; End of variables adopted from `message-utils.el'. -(defcustom message-signature-separator "^-- *$" - "Regexp matching the signature separator." - :type 'regexp +(defcustom message-signature-separator "^-- $" + "Regexp matching the signature separator. +This variable is used to strip off the signature from quoted text +when `message-cite-function' is +`message-cite-original-without-signature'. Most useful values +are \"^-- $\" (strict) and \"^-- *$\" (loose; allow missing +whitespace)." + :type '(choice (const :tag "strict" "^-- $") + (const :tag "loose" "^-- *$") + regexp) + :version "23.1" ;; No Gnus (changed default) :link '(custom-manual "(message)Various Message Variables") :group 'message-various) @@ -1010,7 +1018,7 @@ Used by `message-yank-original' via `message-yank-cite'." :link '(custom-manual "(message)Insertion Variables") :type 'integer) -(defcustom message-cite-function 'message-cite-original +(defcustom message-cite-function 'message-cite-original-without-signature "*Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. @@ -1020,6 +1028,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil." (function-item sc-cite-original) (function :tag "Other")) :link '(custom-manual "(message)Insertion Variables") + :version "23.1" ;; No Gnus (changed default) :group 'message-insertion) (defcustom message-indent-citation-function 'message-indent-citation @@ -2484,12 +2493,19 @@ Point is left at the beginning of the narrowed-to region." (defun message-info (&optional arg) "Display the Message manual. -Prefixed with one \\[universal-argument], display the Emacs MIME manual. -Prefixed with two \\[universal-argument]'s, display the PGG manual." +Prefixed with one \\[universal-argument], display the Emacs MIME +manual. With two \\[universal-argument]'s, display the EasyPG or +PGG manual, depending on the value of `mml2015-use'." (interactive "p") - (cond ((eq arg 16) (Info-goto-node "(pgg)Top")) - ((eq arg 4) (Info-goto-node "(emacs-mime)Top")) - (t (Info-goto-node "(message)Top")))) + (Info-goto-node (format "(%s)Top" + (cond ((eq arg 16) mml2015-use) + ((eq arg 4) 'emacs-mime) + ;; `booleanp' only available in Emacs 22+ + ((and (not (memq arg '(nil t))) + (symbolp arg)) + arg) + (t + 'message))))) @@ -5058,12 +5074,16 @@ Otherwise, generate and save a value for `canlock-password' first." ;; Check the length of the signature. (message-check 'signature (goto-char (point-max)) - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t)) + (if (not (re-search-backward message-signature-separator nil t)) + t + (if (>= (count-lines (1+ (point-at-eol)) (point-max)) 5) + (if (message-gnksa-enable-p 'signature) + (y-or-n-p + (format "Signature is excessively long (%d lines). Really post? " + (count-lines (1+ (point-at-eol)) (point-max)))) + (message "Denied posting -- Excessive signature.") + nil) + t))) ;; Ensure that text follows last quoted portion. (message-check 'quoting-style (goto-char (point-max)) @@ -5882,8 +5902,10 @@ they are." (with-temp-buffer (insert references) (goto-char (point-min)) - ;; Cons a list of valid references. - (while (re-search-forward "<[^>]+>" nil t) + ;; Cons a list of valid references. GNKSA says we must not include MIDs + ;; with whitespace or missing brackets (7.a "Does not propagate broken + ;; Message-IDs in original References"). + (while (re-search-forward "<[^ <]+@[^ <]+>" nil t) (push (match-string 0) refs)) (setq refs (nreverse refs) count (length refs))) @@ -6207,11 +6229,12 @@ are not included." (save-restriction (message-narrow-to-headers) (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)) + ;; Gnus posting styles are applied via buffer-local `message-setup-hook' + ;; values. (run-hooks 'message-setup-hook) ;; Do this last to give it precedence over posting styles, etc. (when (message-mail-p) @@ -6220,6 +6243,8 @@ are not included." (if message-alternative-emails (message-use-alternative-email-as-from)))) (message-position-point) + ;; Allow correct handling of `message-checksum' in `message-yank-original': + (set-buffer-modified-p nil) (undo-boundary)) (defun message-set-auto-save-file-name () @@ -6247,7 +6272,7 @@ are not included." "Disassociate the message buffer from the drafts directory." (when message-draft-article (nndraft-request-expire-articles - (list message-draft-article) "drafts" nil t))) + (list message-draft-article) "nndraft:drafts" nil t))) (defun message-insert-headers () "Generate the headers for the article." @@ -6313,6 +6338,29 @@ is a function used to switch to and display the mail buffer." (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) +(defun message-alter-recipients-discard-bogus-full-name (addrcell) + "Discard mail address in full names. +When the full name in reply headers contains the mail +address (e.g. \"foo@bar \"), discard full name. +ADDRCELL is a cons cell where the car is the mail address and the +cdr is the complete address (full name and mail address)." + (if (string-match (concat (regexp-quote (car addrcell)) ".*" + (regexp-quote (car addrcell))) + (cdr addrcell)) + (cons (car addrcell) (car addrcell)) + addrcell)) + +(defcustom message-alter-recipients-function nil + "Function called to allow alteration of reply header structures. +It is called in `message-get-reply-headers' for each recipient. +The function is called with one parameter, a cons cell ..." + :type '(choice (const :tag "None" nil) + (const :tag "Discard bogus full name" + message-alter-recipients-discard-bogus-full-name) + function) + :version "23.1" ;; No Gnus + :group 'message-headers) + (defun message-get-reply-headers (wide &optional to-address address-headers) (let (follow-to mct never-mct to cc author mft recipients extra) ;; Find all relevant headers we need. @@ -6413,7 +6461,11 @@ want to get rid of this query permanently."))) (setq recipients (mapcar (lambda (addr) - (cons (downcase (mail-strip-quoted-names addr)) addr)) + (if message-alter-recipients-function + (funcall message-alter-recipients-function + (cons (downcase (mail-strip-quoted-names addr)) + addr)) + (cons (downcase (mail-strip-quoted-names addr)) addr))) (message-tokenize-header recipients))) ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) (let ((s recipients)) @@ -7905,6 +7957,56 @@ Header and body are separated by `mail-header-separator'." (kill-buffer buff)))) (message "%s message(s) sent, %s skipped." sent skipped))) +(defun message-replace-header (header new-value &optional after force) + "Remove HEADER and insert the NEW-VALUE. +If AFTER, insert after this header. If FORCE, insert new field +even if NEW-VALUE is empty." + ;; Similar to `nnheader-replace-header' but for message buffers. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-remove-header header)) + (when (or force (> (length new-value) 0)) + (if after + (message-position-on-field header after) + (message-position-on-field header)) + (insert new-value)))) + +(defcustom message-recipients-without-full-name + (list "ding@gnus.org" + "bugs@gnus.org" + "emacs-devel@gnu.org" + "emacs-pretest-bug@gnu.org" + "bug-gnu-emacs@gnu.org") + "Mail addresses that have no full name. +Used in `message-simplify-recipients'." + ;; Maybe the addresses could be extracted from + ;; `gnus-parameter-to-list-alist'? + :type '(choice (const :tag "None" nil) + (repeat string)) + :version "23.1" ;; No Gnus + :group 'message-headers) + +(defun message-simplify-recipients () + (interactive) + (dolist (hdr '("Cc" "To")) + (message-replace-header + hdr + (mapconcat + (lambda (addrcomp) + (if (and message-recipients-without-full-name + (string-match + (regexp-opt message-recipients-without-full-name) + (cadr addrcomp))) + (cadr addrcomp) + (if (car addrcomp) + (message-make-from (car addrcomp) (cadr addrcomp)) + (cadr addrcomp)))) + (when (message-fetch-field hdr) + (mail-extract-address-components + (message-fetch-field hdr) t)) + ", ")))) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 0a7aac29ed9..79a1de772ce 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1017,14 +1017,6 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (define-key main "\C-c\C-m" map) main)) -;; (defun mml-toggle-gcc-externalize-attachments () -;; (interactive) -;; (prog1 -;; (setq gnus-gcc-externalize-attachments -;; (not gnus-gcc-externalize-attachments)) -;; (message "gnus-gcc-externalize-attachments is `%s'." -;; gnus-gcc-externalize-attachments))) - (easy-menu-define mml-menu mml-mode-map "" `("Attachments" @@ -1037,13 +1029,29 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Attach External..." mml-attach-external ,@(if (featurep 'xemacs) '(t) '(:help "Attach reference to an external file"))] - ;; ["Externalize Attachments" - ;; (lambda () (interactive) (mml-toggle-gcc-externalize-attachments)) - ;; ,@(if (featurep 'xemacs) nil - ;; '(:help "Save attachments as external parts in Gcc copies")) - ;; :visible (booleanp gnus-gcc-externalize-attachments) - ;; :style radio - ;; :selected (equal gnus-gcc-externalize-attachments t) ] + ;; FIXME: Is it possible to do this without using + ;; `gnus-gcc-externalize-attachments'? + ["Externalize Attachments" + (lambda () + (interactive) + (if (not (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil)))) + ;; Stupid workaround for XEmacs not honoring :visible. + (message "Can't handle this value of `gnus-gcc-externalize-attachments'") + (setq gnus-gcc-externalize-attachments + (not gnus-gcc-externalize-attachments)) + (message "gnus-gcc-externalize-attachments is `%s'." + gnus-gcc-externalize-attachments))) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (and (boundp 'gnus-gcc-externalize-attachments) + (memq gnus-gcc-externalize-attachments + '(all t nil))))) + :style toggle + :selected gnus-gcc-externalize-attachments + ,@(if (featurep 'xemacs) nil + '(:help "Save attachments as external parts in Gcc copies"))] "----" ;; ("Change Security Method" @@ -1094,9 +1102,18 @@ If HANDLES is non-nil, use it instead reparsing the buffer." ["Emacs MIME manual" (lambda () (interactive) (message-info 4)) ,@(if (featurep 'xemacs) '(t) '(:help "Display the Emacs MIME manual"))] - ["PGG manual" (lambda () (interactive) (message-info 16)) + ["PGG manual" (lambda () (interactive) (message-info mml2015-use)) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (equal mml2015-use 'pgg))) + ,@(if (featurep 'xemacs) '(t) + '(:help "Display the PGG manual"))] + ["EasyPG manual" (lambda () (interactive) (message-info mml2015-use)) + ;; XEmacs barfs on :visible. + ,@(if (featurep 'xemacs) nil + '(:visible (equal mml2015-use 'epg))) ,@(if (featurep 'xemacs) '(t) - '(:help "Display the PGG manual"))])) + '(:help "Display the EasyPG manual"))])) (defvar mml-mode nil "Minor mode for editing MML.") diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 8add5e5215f..eb09b71f79f 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -999,7 +999,11 @@ Whether the passphrase is cached at all is controlled by (defun mml2015-epg-passphrase-callback (context key-id ignore) (if (eq key-id 'SYM) (epg-passphrase-callback-function context key-id nil) - (let* (entry + (let* ((password-cache-key-id + (if (eq key-id 'PIN) + "PIN" + key-id)) + entry (passphrase (password-read (if (eq key-id 'PIN) @@ -1007,14 +1011,12 @@ Whether the passphrase is cached at all is controlled by (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)))) + password-cache-key-id))) (when passphrase (let ((password-cache-expiry mml2015-passphrase-cache-expiry)) - (password-cache-add key-id passphrase)) + (password-cache-add password-cache-key-id passphrase)) (setq mml2015-epg-secret-key-id-list - (cons key-id mml2015-epg-secret-key-id-list)) + (cons password-cache-key-id mml2015-epg-secret-key-id-list)) (copy-sequence passphrase))))) (defun mml2015-epg-find-usable-key (keys usage) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 18c0e23f709..b2d23d32a80 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -555,7 +555,7 @@ If EXAMINE is non-nil the group is selected read-only." (imap-mailbox-select group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch "1,*" "UID" nil 'nouidfetch) + (imap-fetch "1:*" "UID" nil 'nouidfetch) (imap-message-map (lambda (uid Uid) (setq minuid (if minuid (min minuid uid) uid) maxuid (if maxuid (max maxuid uid) uid))) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index a2e9532db13..af79acaa313 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -251,8 +251,11 @@ as unread by Gnus.") (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup server) - (let* ((is-old t) - article rest mod-time) + (let ((is-old t) + (nnmail-expiry-target + (or (gnus-group-find-parameter newsgroup 'expiry-target t) + nnmail-expiry-target)) + article rest mod-time) (nnheader-init-server-buffer) (while (and articles is-old) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index f318ee303f0..a1a7e38d240 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1885,7 +1885,10 @@ Please refer to the following variables to customize the connection: - `nntp-end-of-line'." (let ((command `(,nntp-telnet-command ,@nntp-telnet-switches - ,nntp-address ,nntp-port-number)) + ,nntp-address + ,(if (integerp nntp-port-number) + (number-to-string nntp-port-number) + nntp-port-number))) proc) (and nntp-pre-command (push nntp-pre-command command)) @@ -1928,8 +1931,11 @@ Please refer to the following variables to customize the connection: (setq proc (apply 'start-process "nntpd" buffer command)) (with-current-buffer buffer (nntp-wait-for-string "^r?telnet") - (process-send-string proc (concat "open " nntp-address - " " nntp-port-number "\n")) + (process-send-string proc (concat "open " nntp-address " " + (if (integerp nntp-port-number) + (number-to-string nntp-port-number) + nntp-port-number) + "\n")) (nntp-wait-for-string "^\r*20[01]") (beginning-of-line) (delete-region (point-min) (point)) @@ -1970,7 +1976,9 @@ Please refer to the following variables to customize the connection: ,nntp-via-netcat-command ,@nntp-via-netcat-switches ,nntp-address - ,nntp-port-number))) + ,(if (integerp nntp-port-number) + (number-to-string nntp-port-number) + nntp-port-number)))) (apply 'start-process "nntpd" buffer command))) (defun nntp-open-via-telnet-and-telnet (buffer) @@ -2029,7 +2037,9 @@ Please refer to the following variables to customize the connection: ,nntp-telnet-command ,@nntp-telnet-switches ,nntp-address - ,nntp-port-number))) + ,(if (integerp nntp-port-number) + (number-to-string nntp-port-number) + nntp-port-number)))) (process-send-string proc (concat (mapconcat 'identity real-telnet-command " ") -- 2.11.4.GIT