1997-04-16 22:13:18 +00:00
|
|
|
|
;;; nnmail.el --- mail support functions for the Gnus mail backends
|
2005-08-06 19:51:42 +00:00
|
|
|
|
|
|
|
|
|
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
2007-01-21 03:53:13 +00:00
|
|
|
|
;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Keywords: news, 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
|
2007-07-25 04:24:43 +00:00
|
|
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; 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
|
2005-07-04 17:55:18 +00:00
|
|
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
|
|
;; Boston, MA 02110-1301, USA.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
1997-08-25 04:50:34 +00:00
|
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(require 'gnus) ; for macro gnus-kill-buffer, at least
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(require 'nnheader)
|
|
|
|
|
(require 'message)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(require 'gnus-util)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(require 'mail-source)
|
|
|
|
|
(require 'mm-util)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(eval-and-compile
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(autoload 'gnus-add-buffer "gnus")
|
|
|
|
|
(autoload 'gnus-kill-buffer "gnus"))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defgroup nnmail nil
|
|
|
|
|
"Reading mail with Gnus."
|
|
|
|
|
:group 'gnus)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-retrieve nil
|
|
|
|
|
"Retrieving new mail."
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-prepare nil
|
2005-07-04 00:56:02 +00:00
|
|
|
|
"Preparing (or mangling) new mail after retrieval."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-duplicate nil
|
|
|
|
|
"Handling of duplicate mail messages."
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-split nil
|
2002-11-29 15:57:52 +00:00
|
|
|
|
"Organizing the incoming mail in folders."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-files nil
|
|
|
|
|
"Mail files."
|
|
|
|
|
:group 'gnus-files
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-expire nil
|
|
|
|
|
"Expiring old mail."
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-procmail nil
|
|
|
|
|
"Interfacing with procmail and other mail agents."
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
|
|
|
|
(defgroup nnmail-various nil
|
|
|
|
|
"Various mail options."
|
|
|
|
|
:group 'nnmail)
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defcustom nnmail-split-methods '(("mail.misc" ""))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
"*Incoming mail will be split according to this variable.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
If you'd like, for instance, one mail group for mail from the
|
|
|
|
|
\"4ad-l\" mailing list, one group for junk mail and one for everything
|
|
|
|
|
else, you could do something like this:
|
|
|
|
|
|
|
|
|
|
(setq nnmail-split-methods
|
|
|
|
|
'((\"mail.4ad\" \"From:.*4ad\")
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
|
|
|
|
|
(\"mail.misc\" \"\")))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
As you can see, this variable is a list of lists, where the first
|
|
|
|
|
element in each \"rule\" is the name of the group (which, by the way,
|
|
|
|
|
does not have to be called anything beginning with \"mail\",
|
|
|
|
|
\"yonka.zow\" is a fine, fine name), and the second is a regexp that
|
|
|
|
|
nnmail will try to match on the header to find a fit.
|
|
|
|
|
|
|
|
|
|
The second element can also be a function. In that case, it will be
|
|
|
|
|
called narrowed to the headers with the first element of the rule as
|
|
|
|
|
the argument. It should return a non-nil value if it thinks that the
|
|
|
|
|
mail belongs in that group.
|
|
|
|
|
|
|
|
|
|
The last element should always have \"\" as the regexp.
|
|
|
|
|
|
|
|
|
|
This variable can also have a function as its value."
|
|
|
|
|
:group 'nnmail-split
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:type '(choice (repeat :tag "Alist" (group (string :tag "Name")
|
|
|
|
|
(choice regexp function)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(function-item nnmail-split-fancy)
|
|
|
|
|
(function :tag "Other")))
|
|
|
|
|
|
|
|
|
|
;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
|
|
(defcustom nnmail-crosspost t
|
|
|
|
|
"If non-nil, do crossposting if several split methods match the mail.
|
|
|
|
|
If nil, the first match found will be used."
|
|
|
|
|
:group 'nnmail-split
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
|
|
|
|
|
"Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
|
|
|
|
|
This can also be a list of regexps."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail-split
|
|
|
|
|
:type '(choice (const :tag "none" nil)
|
|
|
|
|
(regexp :value ".*")
|
|
|
|
|
(repeat :value (".*") regexp)))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-cache-ignore-groups nil
|
|
|
|
|
"Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
|
|
|
|
|
This can also be a list of regexps."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail-split
|
|
|
|
|
:type '(choice (const :tag "none" nil)
|
|
|
|
|
(regexp :value ".*")
|
|
|
|
|
(repeat :value (".*") regexp)))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
|
|
|
|
|
(defcustom nnmail-keep-last-article nil
|
1997-09-24 01:50:24 +00:00
|
|
|
|
"If non-nil, nnmail will never delete/move a group's last article.
|
|
|
|
|
It can be marked expirable, so it will be deleted when it is no longer last.
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
You may need to set this variable if other programs are putting
|
|
|
|
|
new mail into folder numbers that Gnus has marked as expired."
|
|
|
|
|
:group 'nnmail-procmail
|
|
|
|
|
:group 'nnmail-various
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-use-long-file-names nil
|
|
|
|
|
"If non-nil the mail backends will use long file and directory names.
|
|
|
|
|
If nil, groups like \"mail.misc\" will end up in directories like
|
|
|
|
|
\"mail/misc/\"."
|
|
|
|
|
:group 'nnmail-files
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-default-file-modes 384
|
|
|
|
|
"Set the mode bits of all new mail files to this integer."
|
|
|
|
|
:group 'nnmail-files
|
|
|
|
|
:type 'integer)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-expiry-wait 7
|
|
|
|
|
"*Expirable articles that are older than this will be expired.
|
|
|
|
|
This variable can either be a number (which will be interpreted as a
|
|
|
|
|
number of days) -- this doesn't have to be an integer. This variable
|
|
|
|
|
can also be `immediate' and `never'."
|
|
|
|
|
:group 'nnmail-expire
|
|
|
|
|
:type '(choice (const immediate)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(number :tag "days")
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(const never)))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-expiry-wait-function nil
|
|
|
|
|
"Variable that holds function to specify how old articles should be before they are expired.
|
2004-09-04 13:13:48 +00:00
|
|
|
|
The function will be called with the name of the group that the expiry
|
|
|
|
|
is to be performed in, and it should return an integer that says how
|
|
|
|
|
many days an article can be stored before it is considered \"old\".
|
|
|
|
|
It can also return the values `never' and `immediate'.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
Eg.:
|
|
|
|
|
|
|
|
|
|
\(setq nnmail-expiry-wait-function
|
|
|
|
|
(lambda (newsgroup)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(cond ((string-match \"private\" newsgroup) 31)
|
|
|
|
|
((string-match \"junk\" newsgroup) 1)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
((string-match \"important\" newsgroup) 'never)
|
|
|
|
|
(t 7))))"
|
|
|
|
|
:group 'nnmail-expire
|
|
|
|
|
:type '(choice (const :tag "nnmail-expiry-wait" nil)
|
|
|
|
|
(function :format "%v" nnmail-)))
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defcustom nnmail-expiry-target 'delete
|
|
|
|
|
"*Variable that says where expired messages should end up.
|
|
|
|
|
The default value is `delete' (which says to delete the messages),
|
|
|
|
|
but it can also be a string or a function. If it is a string, expired
|
|
|
|
|
messages end up in that group. If it is a function, the function is
|
|
|
|
|
called in a buffer narrowed to the message in question. The function
|
|
|
|
|
receives one argument, the name of the group the message comes from.
|
|
|
|
|
The return value should be `delete' or a group name (a string)."
|
2000-11-10 22:57:08 +00:00
|
|
|
|
:version "21.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail-expire
|
|
|
|
|
:type '(choice (const delete)
|
|
|
|
|
(function :format "%v" nnmail-)
|
|
|
|
|
string))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-fancy-expiry-targets nil
|
|
|
|
|
"Determine expiry target based on articles using fancy techniques.
|
|
|
|
|
|
|
|
|
|
This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
|
|
|
|
|
`nnmail-expiry-target' is set to the function
|
|
|
|
|
`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
|
|
|
|
|
the message will be expired to a group determined by invoking
|
|
|
|
|
`format-time-string' with TARGET used as the format string and the
|
|
|
|
|
time extracted from the articles' Date header (if missing the current
|
|
|
|
|
time is used).
|
|
|
|
|
|
|
|
|
|
In the special cases that HEADER is the symbol `to-from', the regexp
|
|
|
|
|
will try to match against both the From and the To header.
|
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
|
|
\(setq nnmail-fancy-expiry-targets
|
|
|
|
|
'((to-from \"boss\" \"nnfolder:Work\")
|
|
|
|
|
(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
|
|
|
|
|
(\"from\" \".*\" \"nnfolder:Archive-%Y\")))
|
|
|
|
|
|
|
|
|
|
In this case, articles containing the string \"boss\" in the To or the
|
|
|
|
|
From header will be expired to the group \"nnfolder:Work\";
|
|
|
|
|
articles containing the sting \"IMPORTANT\" in the Subject header will
|
|
|
|
|
be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
|
|
|
|
|
everything else will be expired to \"nnfolder:Archive-YYYY\"."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail-expire
|
|
|
|
|
:type '(repeat (list (choice :tag "Match against"
|
|
|
|
|
(string :tag "Header")
|
|
|
|
|
(const to-from))
|
|
|
|
|
regexp
|
|
|
|
|
(string :tag "Target group format string"))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defcustom nnmail-cache-accepted-message-ids nil
|
2004-09-04 13:13:48 +00:00
|
|
|
|
"If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
|
|
|
|
|
If non-nil, also update the cache when copy or move articles."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
2007-03-31 13:57:00 +00:00
|
|
|
|
(make-obsolete-variable 'nnmail-spool-file
|
|
|
|
|
"This option is obsolete in Gnus 5.9. \
|
|
|
|
|
Use `mail-sources' instead.")
|
|
|
|
|
;; revision 5.29 / p0-85 / Gnus 5.9
|
2007-12-06 00:21:00 +00:00
|
|
|
|
;; Variable removed in No Gnus v0.7
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defcustom nnmail-resplit-incoming nil
|
|
|
|
|
"*If non-nil, re-split incoming procmail sorted mail."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail-procmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defcustom nnmail-scan-directory-mail-source-once nil
|
|
|
|
|
"*If non-nil, scan all incoming procmail sorted mails once.
|
|
|
|
|
It scans low-level sorted spools even when not required."
|
2000-11-10 22:57:08 +00:00
|
|
|
|
:version "21.1"
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail-procmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-delete-file-function 'delete-file
|
|
|
|
|
"Function called to delete files in some mail backends."
|
|
|
|
|
:group 'nnmail-files
|
|
|
|
|
:type 'function)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-crosspost-link-function
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(if (string-match "windows-nt\\|emx" (symbol-name system-type))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
'copy-file
|
|
|
|
|
'add-name-to-file)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
"*Function called to create a copy of a file.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
This is `add-name-to-file' by default, which means that crossposts
|
|
|
|
|
will use hard links. If your file system doesn't allow hard
|
|
|
|
|
links, you could set this variable to `copy-file' instead."
|
|
|
|
|
:group 'nnmail-files
|
|
|
|
|
:type '(radio (function-item add-name-to-file)
|
|
|
|
|
(function-item copy-file)
|
|
|
|
|
(function :tag "Other")))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-read-incoming-hook
|
|
|
|
|
(if (eq system-type 'windows-nt)
|
|
|
|
|
'(nnheader-ms-strip-cr)
|
|
|
|
|
nil)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
"*Hook that will be run after the incoming mail has been transferred.
|
2000-09-20 16:54:57 +00:00
|
|
|
|
The incoming mail is moved from the specified spool file (which normally is
|
1997-04-16 22:13:18 +00:00
|
|
|
|
something like \"/usr/spool/mail/$user\") to the user's home
|
|
|
|
|
directory. This hook is called after the incoming mail box has been
|
|
|
|
|
emptied, and can be used to call any mail box programs you have
|
|
|
|
|
running (\"xwatch\", etc.)
|
|
|
|
|
|
|
|
|
|
Eg.
|
|
|
|
|
|
|
|
|
|
\(add-hook 'nnmail-read-incoming-hook
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(lambda ()
|
|
|
|
|
(call-process \"/local/bin/mailsend\" nil nil nil
|
2007-10-28 09:18:39 +00:00
|
|
|
|
\"read\"
|
|
|
|
|
;; The incoming mail box file.
|
|
|
|
|
(expand-file-name (user-login-name)
|
|
|
|
|
rmail-spool-directory))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
If you have xwatch running, this will alert it that mail has been
|
|
|
|
|
read.
|
|
|
|
|
|
|
|
|
|
If you use `display-time', you could use something like this:
|
|
|
|
|
|
|
|
|
|
\(add-hook 'nnmail-read-incoming-hook
|
|
|
|
|
(lambda ()
|
|
|
|
|
;; Update the displayed time, since that will clear out
|
|
|
|
|
;; the flag that says you have mail.
|
|
|
|
|
(when (eq (process-status \"display-time\") 'run)
|
|
|
|
|
(display-time-filter display-time-process \"\"))))"
|
|
|
|
|
:group 'nnmail-prepare
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-prepare-incoming-hook nil
|
|
|
|
|
"Hook called before treating incoming mail.
|
|
|
|
|
The hook is run in a buffer with all the new, incoming mail."
|
|
|
|
|
:group 'nnmail-prepare
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-prepare-incoming-header-hook nil
|
|
|
|
|
"Hook called narrowed to the headers of each message.
|
|
|
|
|
This can be used to remove excessive spaces (and stuff like
|
|
|
|
|
that) from the headers before splitting and saving the messages."
|
|
|
|
|
:group 'nnmail-prepare
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-prepare-incoming-message-hook nil
|
|
|
|
|
"Hook called narrowed to each message."
|
|
|
|
|
:group 'nnmail-prepare
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-list-identifiers nil
|
|
|
|
|
"Regexp that matches list identifiers to be removed.
|
|
|
|
|
This can also be a list of regexps."
|
|
|
|
|
:group 'nnmail-prepare
|
|
|
|
|
:type '(choice (const :tag "none" nil)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(regexp :value ".*")
|
|
|
|
|
(repeat :value (".*") regexp)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defcustom nnmail-pre-get-new-mail-hook nil
|
|
|
|
|
"Hook called just before starting to handle new incoming mail."
|
|
|
|
|
:group 'nnmail-retrieve
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-post-get-new-mail-hook nil
|
|
|
|
|
"Hook called just after finishing handling new incoming mail."
|
|
|
|
|
:group 'nnmail-retrieve
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-split-hook nil
|
|
|
|
|
"Hook called before deciding where to split an article.
|
|
|
|
|
The functions in this hook are free to modify the buffer
|
|
|
|
|
contents in any way they choose -- the buffer contents are
|
|
|
|
|
discarded after running the split process."
|
|
|
|
|
:group 'nnmail-split
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defcustom nnmail-spool-hook nil
|
|
|
|
|
"*A hook called when a new article is spooled."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'hook)
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defcustom nnmail-large-newsgroup 50
|
2004-09-04 13:13:48 +00:00
|
|
|
|
"*The number of articles which indicates a large newsgroup or nil.
|
|
|
|
|
If the number of articles is greater than the value, verbose
|
1997-04-16 22:13:18 +00:00
|
|
|
|
messages will be shown to indicate the current status."
|
|
|
|
|
:group 'nnmail-various
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:type '(choice (const :tag "infinite" nil)
|
|
|
|
|
(number :tag "count")))
|
|
|
|
|
|
|
|
|
|
(define-widget 'nnmail-lazy 'default
|
|
|
|
|
"Base widget for recursive datastructures.
|
|
|
|
|
|
2005-02-09 15:50:47 +00:00
|
|
|
|
This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:format "%{%t%}: %v"
|
|
|
|
|
:convert-widget 'widget-value-convert-widget
|
|
|
|
|
:value-create (lambda (widget)
|
|
|
|
|
(let ((value (widget-get widget :value))
|
|
|
|
|
(type (widget-get widget :type)))
|
2005-02-09 15:50:47 +00:00
|
|
|
|
(widget-put widget :children
|
|
|
|
|
(list (widget-create-child-value
|
2004-09-04 13:13:48 +00:00
|
|
|
|
widget (widget-convert type) value)))))
|
|
|
|
|
:value-delete 'widget-children-value-delete
|
|
|
|
|
:value-get (lambda (widget)
|
|
|
|
|
(widget-value (car (widget-get widget :children))))
|
|
|
|
|
:value-inline (lambda (widget)
|
|
|
|
|
(widget-apply (car (widget-get widget :children))
|
|
|
|
|
:value-inline))
|
|
|
|
|
:default-get (lambda (widget)
|
|
|
|
|
(widget-default-get
|
|
|
|
|
(widget-convert (widget-get widget :type))))
|
|
|
|
|
:match (lambda (widget value)
|
|
|
|
|
(widget-apply (widget-convert (widget-get widget :type))
|
|
|
|
|
:match value))
|
|
|
|
|
:validate (lambda (widget)
|
|
|
|
|
(widget-apply (car (widget-get widget :children)) :validate)))
|
|
|
|
|
|
|
|
|
|
(define-widget 'nnmail-split-fancy 'nnmail-lazy
|
|
|
|
|
"Widget for customizing splits in the variable of the same name."
|
|
|
|
|
:tag "Split"
|
|
|
|
|
:type '(menu-choice :value (any ".*value.*" "misc")
|
|
|
|
|
:tag "Type"
|
|
|
|
|
(string :tag "Destination")
|
|
|
|
|
(list :tag "Use first match (|)" :value (|)
|
|
|
|
|
(const :format "" |)
|
|
|
|
|
(editable-list :inline t nnmail-split-fancy))
|
|
|
|
|
(list :tag "Use all matches (&)" :value (&)
|
|
|
|
|
(const :format "" &)
|
|
|
|
|
(editable-list :inline t nnmail-split-fancy))
|
|
|
|
|
(list :tag "Function with fixed arguments (:)"
|
2007-10-28 09:18:39 +00:00
|
|
|
|
:value (:)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(const :format "" :value :)
|
2005-02-09 15:50:47 +00:00
|
|
|
|
function
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(editable-list :inline t (sexp :tag "Arg"))
|
|
|
|
|
)
|
|
|
|
|
(list :tag "Function with split arguments (!)"
|
2007-10-28 09:18:39 +00:00
|
|
|
|
:value (!)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(const :format "" !)
|
|
|
|
|
function
|
|
|
|
|
(editable-list :inline t nnmail-split-fancy))
|
2005-02-09 15:50:47 +00:00
|
|
|
|
(list :tag "Field match"
|
|
|
|
|
(choice :tag "Field"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
regexp symbol)
|
|
|
|
|
(choice :tag "Match"
|
2005-02-09 15:50:47 +00:00
|
|
|
|
regexp
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(symbol :value mail))
|
|
|
|
|
(repeat :inline t
|
|
|
|
|
:tag "Restrictions"
|
|
|
|
|
(group :inline t
|
|
|
|
|
(const :format "" -)
|
|
|
|
|
regexp))
|
|
|
|
|
nnmail-split-fancy)
|
|
|
|
|
(const :tag "Junk (delete mail)" junk)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defcustom nnmail-split-fancy "mail.misc"
|
|
|
|
|
"Incoming mail can be split according to this fancy variable.
|
|
|
|
|
To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
|
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
The format of this variable is SPLIT, where SPLIT can be one of
|
1997-04-16 22:13:18 +00:00
|
|
|
|
the following:
|
|
|
|
|
|
|
|
|
|
GROUP: Mail will be stored in GROUP (a string).
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
\(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
|
2003-02-04 13:24:35 +00:00
|
|
|
|
field FIELD (a regexp) contains VALUE (a regexp), store the messages
|
2000-09-19 13:37:09 +00:00
|
|
|
|
as specified by SPLIT. If RESTRICT (a regexp) matches some string
|
2001-12-20 19:01:00 +00:00
|
|
|
|
after FIELD and before the end of the matched VALUE, return nil,
|
2000-09-19 13:37:09 +00:00
|
|
|
|
otherwise process SPLIT. Multiple RESTRICTs add up, further
|
|
|
|
|
restricting the possibility of processing SPLIT.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
\(| SPLIT...): Process each SPLIT expression until one of them matches.
|
|
|
|
|
A SPLIT expression is said to match if it will cause the mail
|
|
|
|
|
message to be stored in one or more groups.
|
|
|
|
|
|
|
|
|
|
\(& SPLIT...): Process each SPLIT expression.
|
|
|
|
|
|
|
|
|
|
\(: FUNCTION optional args): Call FUNCTION with the optional args, in
|
|
|
|
|
the buffer containing the message headers. The return value FUNCTION
|
|
|
|
|
should be a split, which is then recursively processed.
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
\(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
|
|
|
|
|
return value FUNCTION should be a split, which is then recursively
|
|
|
|
|
processed.
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
junk: Mail will be deleted. Use with care! Do not submerge in water!
|
|
|
|
|
Example:
|
|
|
|
|
(setq nnmail-split-fancy
|
|
|
|
|
'(| (\"Subject\" \"MAKE MONEY FAST\" junk)
|
|
|
|
|
...other.rules.omitted...))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
FIELD must match a complete field name. VALUE must match a complete
|
|
|
|
|
word according to the `nnmail-split-fancy-syntax-table' syntax table.
|
|
|
|
|
You can use \".*\" in the regexps to match partial field names or words.
|
|
|
|
|
|
2007-10-28 09:18:39 +00:00
|
|
|
|
FIELD and VALUE can also be Lisp symbols, in that case they are expanded
|
1997-04-16 22:13:18 +00:00
|
|
|
|
as specified in `nnmail-split-abbrev-alist'.
|
|
|
|
|
|
|
|
|
|
GROUP can contain \\& and \\N which will substitute from matching
|
|
|
|
|
\\(\\) patterns in the previous VALUE.
|
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
|
|
|
|
|
\(setq nnmail-split-methods 'nnmail-split-fancy
|
|
|
|
|
nnmail-split-fancy
|
|
|
|
|
;; Messages from the mailer daemon are not crossposted to any of
|
|
|
|
|
;; the ordinary groups. Warnings are put in a separate group
|
|
|
|
|
;; from real errors.
|
|
|
|
|
'(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
|
|
|
|
|
\"mail.misc\"))
|
|
|
|
|
;; Non-error messages are crossposted to all relevant
|
|
|
|
|
;; groups, but we don't crosspost between the group for the
|
|
|
|
|
;; (ding) list and the group for other (ding) related mail.
|
|
|
|
|
(& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
|
|
|
|
|
(\"subject\" \"ding\" \"ding.misc\"))
|
|
|
|
|
;; Other mailing lists...
|
|
|
|
|
(any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
|
|
|
|
|
(any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
|
2004-09-04 13:13:48 +00:00
|
|
|
|
;; Both lists below have the same suffix, so prevent
|
|
|
|
|
;; cross-posting to mkpkg.list of messages posted only to
|
|
|
|
|
;; the bugs- list, but allow cross-posting when the
|
|
|
|
|
;; message was really cross-posted.
|
|
|
|
|
(any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
|
|
|
|
|
(any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
|
|
|
|
|
;;
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; People...
|
|
|
|
|
(any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
|
|
|
|
|
;; Unmatched mail goes to the catch all group.
|
|
|
|
|
\"misc.misc\"))"
|
|
|
|
|
:group 'nnmail-split
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:type 'nnmail-split-fancy)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defcustom nnmail-split-abbrev-alist
|
|
|
|
|
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
|
|
|
|
|
(mail . "mailer-daemon\\|postmaster\\|uucp")
|
|
|
|
|
(to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
|
1997-09-24 01:50:24 +00:00
|
|
|
|
(from . "from\\|sender\\|resent-from")
|
|
|
|
|
(nato . "to\\|cc\\|resent-to\\|resent-cc")
|
|
|
|
|
(naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
"*Alist of abbreviations allowed in `nnmail-split-fancy'."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
:group 'nnmail-split
|
|
|
|
|
:type '(repeat (cons :format "%v" symbol regexp)))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-message-id-cache-length 1000
|
|
|
|
|
"*The approximate number of Message-IDs nnmail will keep in its cache.
|
|
|
|
|
If this variable is nil, no checking on duplicate messages will be
|
|
|
|
|
performed."
|
|
|
|
|
:group 'nnmail-duplicate
|
|
|
|
|
:type '(choice (const :tag "disable" nil)
|
|
|
|
|
(integer :format "%v")))
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
|
|
|
|
|
"*The file name of the nnmail Message-ID cache."
|
|
|
|
|
:group 'nnmail-duplicate
|
|
|
|
|
:group 'nnmail-files
|
|
|
|
|
:type 'file)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-treat-duplicates 'warn
|
|
|
|
|
"*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
Three values are valid: nil, which means that nnmail is not to keep a
|
1997-04-16 22:13:18 +00:00
|
|
|
|
Message-ID cache; `warn', which means that nnmail should insert extra
|
|
|
|
|
headers to warn the user about the duplication (this is the default);
|
|
|
|
|
and `delete', which means that nnmail will delete duplicated mails.
|
|
|
|
|
|
|
|
|
|
This variable can also be a function. It will be called from a buffer
|
|
|
|
|
narrowed to the article in question with the Message-ID as a
|
|
|
|
|
parameter. It should return nil, `warn' or `delete'."
|
|
|
|
|
:group 'nnmail-duplicate
|
|
|
|
|
:type '(choice (const :tag "off" nil)
|
|
|
|
|
(const warn)
|
|
|
|
|
(const delete)))
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defcustom nnmail-extra-headers '(To Newsgroups)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
"*Extra headers to parse."
|
2000-11-10 22:57:08 +00:00
|
|
|
|
:version "21.1"
|
2000-09-19 13:37:09 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type '(repeat symbol))
|
|
|
|
|
|
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Merge from gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-74
Update from CVS
2004-12-02 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/message.el (message-forward-make-body-mml): Remove headers
according to message-forward-ignored-headers if a message is
decoded.
2004-12-02 Romain Francoise <romain@orebokech.com>
* lisp/gnus/message.el (message-forward-make-body-plain): Always remove
headers according to message-forward-ignored-headers.
2004-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/lpath.el: Remove bbdb-create-internal, bbdb-records,
spam-BBDB-register-routine and spam-enter-ham-BBDB.
* lisp/gnus/nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in
order to silence the byte compiler.
* lisp/gnus/pop3.el (pop3-md5): Define it before being used.
* lisp/gnus/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,
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,
spam-stat-register-ham-routine, spam-stat-register-spam-routine,
spam-stat-save and spam-stat-split-fancy.
2004-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/canlock.el (canlock-password): Remove `:size 0' or `:size 1'
which may confuse users.
(canlock-password-for-verify): Ditto.
* lisp/gnus/deuglify.el (gnus-outlook-deuglify-unwrap-stop-chars): Ditto.
* lisp/gnus/gnus-art.el (gnus-emphasis-alist): Ditto.
* lisp/gnus/gnus-registry.el (gnus-registry-max-entries): Ditto.
* lisp/gnus/gnus-score.el (gnus-adaptive-word-length-limit): Ditto.
* lisp/gnus/gnus-start.el (gnus-save-killed-list): Ditto.
* lisp/gnus/gnus-sum.el (gnus-thread-hide-subtree): Ditto.
(gnus-sum-thread-tree-root): Ditto.
(gnus-sum-thread-tree-false-root): Ditto.
(gnus-sum-thread-tree-single-indent): Ditto.
* lisp/gnus/message.el (message-courtesy-message): Ditto.
(message-archive-note): Ditto.
(message-subscribed-address-file): Ditto.
(message-user-fqdn): Ditto.
* lisp/gnus/spam-report.el (spam-report-gmane-regex): Ditto.
* lisp/gnus/spam.el (spam-blackhole-good-server-regex): Ditto.
2004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/message.el (message-forbidden-properties): Fixed typo in doc
string.
2004-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
* lisp/gnus/message.el (message-strip-forbidden-properties): Bind
buffer-read-only (etc) to nil.
2004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-util.el (gnus-replace-in-string): Added doc string.
* lisp/gnus/nnmail.el (nnmail-split-header-length-limit): Increase to 2048
to avoid problems when splitting mails with many recipients.
2004-11-23 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/rfc2047.el (rfc2047-header-encoding-alist): Add In-Reply-To to
address-mime. Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
2004-11-22 Marek Martin <marek.martin@mum.pri.ee> (tiny change)
* lisp/gnus/nnfolder.el (nnfolder-request-create-group): Save current buffer.
2004-11-22 Reiner Steib <Reiner.Steib@gmx.de>
* man/message.texi (Various Message Variables): Mention that all mail
file variables are derived from `message-directory'.
* man/gnus.texi (Splitting Mail): Clarify bogus group.
2004-11-16 Reiner Steib <Reiner.Steib@gmx.de>
* man/gnus.texi (Filtering Spam Using The Spam ELisp Package):
2004-12-07 21:56:42 +00:00
|
|
|
|
(defcustom nnmail-split-header-length-limit 2048
|
2000-09-19 13:37:09 +00:00
|
|
|
|
"Header lines longer than this limit are excluded from the split function."
|
2000-11-10 22:57:08 +00:00
|
|
|
|
:version "21.1"
|
2000-09-19 13:37:09 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'integer)
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defcustom nnmail-mail-splitting-charset nil
|
|
|
|
|
"Default charset to be used when splitting incoming mail."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'symbol)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-mail-splitting-decodes nil
|
|
|
|
|
"Whether the nnmail splitting functionality should MIME decode headers."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-split-fancy-match-partial-words nil
|
|
|
|
|
"Whether to match partial words when fancy splitting.
|
|
|
|
|
Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
|
|
|
|
|
by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
|
|
|
|
|
surrounded
|
|
|
|
|
by anything."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
|
|
|
(defcustom nnmail-split-lowercase-expanded t
|
|
|
|
|
"Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
|
|
|
|
|
This avoids the creation of multiple groups when users send to an address
|
|
|
|
|
using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
|
2005-02-09 15:50:47 +00:00
|
|
|
|
:version "22.1"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
:group 'nnmail
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;;; Internal variables.
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defvar nnmail-article-buffer " *nnmail incoming*"
|
|
|
|
|
"The buffer used for splitting incoming mails.")
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defvar nnmail-split-history nil
|
|
|
|
|
"List of group/article elements that say where the previous split put messages.")
|
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defvar nnmail-split-fancy-syntax-table
|
|
|
|
|
(let ((table (make-syntax-table)))
|
|
|
|
|
;; support the %-hack
|
|
|
|
|
(modify-syntax-entry ?\% "." table)
|
|
|
|
|
table)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
"Syntax table used by `nnmail-split-fancy'.")
|
|
|
|
|
|
|
|
|
|
(defvar nnmail-prepare-save-mail-hook nil
|
|
|
|
|
"Hook called before saving mail.")
|
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(defvar nnmail-split-tracing nil)
|
|
|
|
|
(defvar nnmail-split-trace nil)
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun nnmail-request-post (&optional server)
|
|
|
|
|
(mail-send-and-exit nil))
|
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(defvar nnmail-file-coding-system 'raw-text
|
|
|
|
|
"Coding system used in nnmail.")
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defvar nnmail-incoming-coding-system
|
|
|
|
|
mm-text-coding-system
|
|
|
|
|
"Coding system used in reading inbox")
|
|
|
|
|
|
2001-08-18 19:22:22 +00:00
|
|
|
|
(defvar nnmail-pathname-coding-system nil
|
2003-01-16 01:19:03 +00:00
|
|
|
|
"*Coding system for file name.")
|
1997-08-28 04:51:02 +00:00
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-find-file (file)
|
|
|
|
|
"Insert FILE in server buffer safely."
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(delete-region (point-min) (point-max))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(let ((format-alist nil)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(after-insert-file-functions nil))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(condition-case ()
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(let ((coding-system-for-read nnmail-file-coding-system)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(auto-mode-alist (mm-auto-mode-alist))
|
|
|
|
|
(file-name-coding-system nnmail-pathname-coding-system))
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(insert-file-contents file)
|
|
|
|
|
t)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(file-error nil))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-group-pathname (group dir &optional file)
|
2003-01-16 01:19:03 +00:00
|
|
|
|
"Make file name for GROUP."
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(concat
|
|
|
|
|
(let ((dir (file-name-as-directory (expand-file-name dir))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(setq group (nnheader-replace-duplicate-chars-in-string
|
|
|
|
|
(nnheader-replace-chars-in-string group ?/ ?_)
|
|
|
|
|
?. ?_))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(setq group (nnheader-translate-file-chars group))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; If this directory exists, we use it directly.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(file-name-as-directory
|
|
|
|
|
(if (or nnmail-use-long-file-names
|
|
|
|
|
(file-directory-p (concat dir group)))
|
|
|
|
|
(expand-file-name group dir)
|
|
|
|
|
;; If not, we translate dots into slashes.
|
|
|
|
|
(expand-file-name
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(nnheader-replace-chars-in-string group ?. ?/)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
dir))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(or file "")))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-get-active ()
|
|
|
|
|
"Returns an assoc of group names and active ranges.
|
|
|
|
|
nn*-request-list should have been called before calling this function."
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;; Go through all groups from the active list.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(nnmail-parse-active)))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-parse-active ()
|
|
|
|
|
"Parse the active file in the current buffer and return an alist."
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(unless (re-search-forward "[\\\"]" nil t)
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(while (re-search-backward "[][';?()#]" nil t)
|
|
|
|
|
(insert ?\\)))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(let ((buffer (current-buffer))
|
|
|
|
|
group-assoc group max min)
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(condition-case err
|
|
|
|
|
(progn
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(narrow-to-region (point) (point-at-eol))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(setq group (read buffer))
|
|
|
|
|
(unless (stringp group)
|
|
|
|
|
(setq group (symbol-name group)))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(if (and (numberp (setq max (read buffer)))
|
|
|
|
|
(numberp (setq min (read buffer))))
|
2007-11-19 05:50:39 +00:00
|
|
|
|
(push (list (mm-string-as-unibyte group) (cons min max))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
group-assoc)))
|
|
|
|
|
(error nil))
|
|
|
|
|
(widen)
|
|
|
|
|
(forward-line 1))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
group-assoc))
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defvar nnmail-active-file-coding-system 'raw-text
|
1997-08-28 04:51:02 +00:00
|
|
|
|
"*Coding system for active file.")
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-save-active (group-assoc file-name)
|
|
|
|
|
"Save GROUP-ASSOC in ACTIVE-FILE."
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(let ((coding-system-for-write nnmail-active-file-coding-system))
|
|
|
|
|
(when file-name
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(with-temp-file file-name
|
2007-11-19 05:50:39 +00:00
|
|
|
|
(mm-disable-multibyte)
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(nnmail-generate-active group-assoc)))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-generate-active (alist)
|
|
|
|
|
"Generate an active file from group-alist ALIST."
|
|
|
|
|
(erase-buffer)
|
|
|
|
|
(let (group)
|
|
|
|
|
(while (setq group (pop alist))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
|
|
|
|
|
(caadr group))))
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(while (search-backward "\\." nil t)
|
|
|
|
|
(delete-char 1))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defun nnmail-get-split-group (file source)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
"Find out whether this FILE is to be split into GROUP only.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
If SOURCE is a directory spec, try to return the group name component."
|
|
|
|
|
(if (eq (car source) 'directory)
|
|
|
|
|
(let ((file (file-name-nondirectory file)))
|
|
|
|
|
(mail-source-bind (directory source)
|
|
|
|
|
(if (string-match (concat (regexp-quote suffix) "$") file)
|
|
|
|
|
(substring file 0 (match-beginning 0))
|
|
|
|
|
nil)))
|
|
|
|
|
nil))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-process-babyl-mail-format (func artnum-func)
|
|
|
|
|
(let ((case-fold-search t)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(count 0)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
start message-id content-length do-search end)
|
|
|
|
|
(while (not (eobp))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(goto-char (point-min))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(re-search-forward
|
|
|
|
|
"\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
|
|
|
|
|
(goto-char (match-end 0))
|
|
|
|
|
(delete-region (match-beginning 0) (match-end 0))
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
(setq start (point))
|
|
|
|
|
(progn
|
|
|
|
|
;; Skip all the headers in case there are more "From "s...
|
|
|
|
|
(or (search-forward "\n\n" nil t)
|
|
|
|
|
(search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
|
|
|
|
|
(search-forward ""))
|
|
|
|
|
(point)))
|
|
|
|
|
;; Unquote the ">From " line, if any.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(when (looking-at ">From ")
|
|
|
|
|
(replace-match "X-From-Line: ") )
|
|
|
|
|
(run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
;; Find the Message-ID header.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(if (re-search-backward
|
|
|
|
|
"^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
|
|
|
|
|
(setq message-id (buffer-substring (match-beginning 1)
|
|
|
|
|
(match-end 1)))
|
|
|
|
|
;; There is no Message-ID here, so we create one.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "Original-")))
|
|
|
|
|
(forward-line -1)
|
|
|
|
|
(insert "Message-ID: " (setq message-id (nnmail-message-id))
|
|
|
|
|
"\n")))
|
|
|
|
|
;; Look for a Content-Length header.
|
|
|
|
|
(if (not (save-excursion
|
|
|
|
|
(and (re-search-backward
|
|
|
|
|
"^Content-Length:[ \t]*\\([0-9]+\\)" start t)
|
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 76)
- Update from CVS
2005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-agent.el (gnus-agent-regenerate-group)
(gnus-agent-fetch-articles): Replace `string-to-int' by
`string-to-number'.
* lisp/gnus/gnus-art.el (gnus-button-fetch-group): Ditto.
* lisp/gnus/gnus-cache.el (gnus-cache-generate-active)
(gnus-cache-articles-in-group): Ditto.
* lisp/gnus/gnus-group.el (gnus-group-set-current-level)
(gnus-group-insert-group-line): Ditto.
* lisp/gnus/gnus-score.el (gnus-score-set-expunge-below)
(gnus-score-set-mark-below, gnus-summary-score-effect)
(gnus-summary-score-entry): Ditto.
* lisp/gnus/gnus-soup.el (gnus-soup-send-packet, gnus-soup-parse-areas)
(gnus-soup-pack): Ditto.
* lisp/gnus/gnus-spec.el (gnus-xmas-format): Ditto.
* lisp/gnus/gnus-start.el (gnus-newsrc-to-gnus-format): Ditto.
* lisp/gnus/gnus-sum.el (gnus-create-xref-hashtb): Ditto.
* lisp/gnus/gnus-uu.el (gnus-uu-expand-numbers): Ditto.
* lisp/gnus/nnbabyl.el (nnbabyl-article-group-number): Ditto.
* lisp/gnus/nndb.el (nndb-get-remote-expire-response): Ditto.
* lisp/gnus/nndiary.el (nndiary-parse-schedule-value)
(nndiary-string-to-number, nndiary-request-replace-article)
(nndiary-request-article): Ditto.
* lisp/gnus/nndoc.el (nndoc-rnews-body-end, nndoc-mbox-body-end): Ditto.
* lisp/gnus/nndraft.el (nndraft-articles, nndraft-request-group): Ditto.
* lisp/gnus/nneething.el (nneething-make-head): Ditto.
* lisp/gnus/nnfolder.el (nnfolder-request-article)
(nnfolder-retrieve-headers): Ditto.
* lisp/gnus/nnheader.el (nnheader-file-to-number): Ditto.
* lisp/gnus/nnkiboze.el (nnkiboze-request-article): Ditto.
* lisp/gnus/nnmail.el (nnmail-process-unix-mail-format)
(nnmail-process-babyl-mail-format): Ditto.
* lisp/gnus/nnmbox.el (nnmbox-read-mbox, nnmbox-article-group-number): Ditto.
* lisp/gnus/nnmh.el (nnmh-update-gnus-unreads, nnmh-active-number)
(nnmh-request-create-group, nnmh-request-list-1)
(nnmh-request-group, nnmh-request-article): Ditto.
* lisp/gnus/nnml.el (nnml-request-replace-article, nnml-request-article): Ditto.
* lisp/gnus/nnrss.el (nnrss-find-rss-via-syndic8): Ditto.
* lisp/gnus/nnsoup.el (nnsoup-make-active): Ditto.
* lisp/gnus/nnspool.el (nnspool-find-id, nnspool-request-group): Ditto.
* lisp/gnus/nntp.el (nntp-find-group-and-number)
(nntp-retrieve-headers-with-xover): Ditto.
* lisp/gnus/pgg-gpg.el (pgg-gpg-snarf-keys-region): Ditto.
* lisp/gnus/pgg-parse.el (pgg-read-body, pgg-read-bytes)
(pgg-format-key-identifier): Ditto.
* lisp/gnus/pop3.el (pop3-last, pop3-stat): Ditto.
* lisp/gnus/qp.el (quoted-printable-decode-region): Ditto.
* lisp/gnus/spam-report.el (spam-report-url-ping-mm-url): Use format instead
of concat.
2005-05-30 17:13:58 +00:00
|
|
|
|
(setq content-length (string-to-number
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(buffer-substring
|
|
|
|
|
(match-beginning 1)
|
|
|
|
|
(match-end 1))))
|
|
|
|
|
;; We destroy the header, since none of
|
|
|
|
|
;; the backends ever use it, and we do not
|
|
|
|
|
;; want to confuse other mailers by having
|
|
|
|
|
;; a (possibly) faulty header.
|
|
|
|
|
(progn (insert "X-") t))))
|
|
|
|
|
(setq do-search t)
|
|
|
|
|
(widen)
|
|
|
|
|
(if (or (= (+ (point) content-length) (point-max))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (+ (point) content-length))
|
|
|
|
|
(looking-at "")))
|
|
|
|
|
(progn
|
|
|
|
|
(goto-char (+ (point) content-length))
|
|
|
|
|
(setq do-search nil))
|
|
|
|
|
(setq do-search t)))
|
|
|
|
|
(widen)
|
|
|
|
|
;; Go to the beginning of the next article - or to the end
|
|
|
|
|
;; of the buffer.
|
|
|
|
|
(when do-search
|
|
|
|
|
(if (re-search-forward "^" nil t)
|
|
|
|
|
(goto-char (match-beginning 0))
|
|
|
|
|
(goto-char (1- (point-max)))))
|
|
|
|
|
(delete-char 1) ; delete ^_
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start (point))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(nnmail-check-duplication message-id func artnum-func)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(incf count)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(setq end (point-max))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(goto-char end))
|
|
|
|
|
count))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defsubst nnmail-search-unix-mail-delim ()
|
|
|
|
|
"Put point at the beginning of the next Unix mbox message."
|
2002-05-16 12:01:57 +00:00
|
|
|
|
;; Algorithm used to find the next article in the
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; brain-dead Unix mbox format:
|
|
|
|
|
;;
|
|
|
|
|
;; 1) Search for "^From ".
|
|
|
|
|
;; 2) If we find it, then see whether the previous
|
|
|
|
|
;; line is blank and the next line looks like a header.
|
|
|
|
|
;; Then it's possible that this is a mail delim, and we use it.
|
|
|
|
|
(let ((case-fold-search nil)
|
|
|
|
|
found)
|
|
|
|
|
(while (not found)
|
|
|
|
|
(if (not (re-search-forward "^From " nil t))
|
|
|
|
|
(setq found 'no)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(when (and (or (bobp)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line -1)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(eq (char-after) ?\n)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line 1)
|
1997-09-24 01:50:24 +00:00
|
|
|
|
(while (looking-at ">From \\|From ")
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(forward-line 1))
|
|
|
|
|
(looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
|
|
|
(setq found 'yes)))))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(eq found 'yes)))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-search-unix-mail-delim-backward ()
|
|
|
|
|
"Put point at the beginning of the current Unix mbox message."
|
2002-05-16 12:01:57 +00:00
|
|
|
|
;; Algorithm used to find the next article in the
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; brain-dead Unix mbox format:
|
|
|
|
|
;;
|
|
|
|
|
;; 1) Search for "^From ".
|
|
|
|
|
;; 2) If we find it, then see whether the previous
|
|
|
|
|
;; line is blank and the next line looks like a header.
|
|
|
|
|
;; Then it's possible that this is a mail delim, and we use it.
|
|
|
|
|
(let ((case-fold-search nil)
|
|
|
|
|
found)
|
|
|
|
|
(while (not found)
|
|
|
|
|
(if (not (re-search-backward "^From " nil t))
|
|
|
|
|
(setq found 'no)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(when (and (or (bobp)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line -1)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(eq (char-after) ?\n)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(forward-line 1)
|
1997-09-24 01:50:24 +00:00
|
|
|
|
(while (looking-at ">From \\|From ")
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(forward-line 1))
|
|
|
|
|
(looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
|
|
|
(setq found 'yes)))))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(eq found 'yes)))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-process-unix-mail-format (func artnum-func)
|
|
|
|
|
(let ((case-fold-search t)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(count 0)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
start message-id content-length end skip head-end)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (not (and (re-search-forward "^From " nil t)
|
|
|
|
|
(goto-char (match-beginning 0))))
|
|
|
|
|
;; Possibly wrong format?
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
|
|
|
|
|
(if (buffer-file-name) "file" "buffer")
|
|
|
|
|
(or (buffer-file-name) (buffer-name)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Carry on until the bitter end.
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(setq start (point)
|
|
|
|
|
end nil)
|
|
|
|
|
;; Find the end of the head.
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
start
|
|
|
|
|
(if (search-forward "\n\n" nil t)
|
|
|
|
|
(1- (point))
|
|
|
|
|
;; This will never happen, but just to be on the safe side --
|
|
|
|
|
;; if there is no head-body delimiter, we search a bit manually.
|
|
|
|
|
(while (and (looking-at "From \\|[^ \t]+:")
|
|
|
|
|
(not (eobp)))
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(point)))
|
|
|
|
|
;; Find the Message-ID header.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
|
|
|
(setq message-id (match-string 1))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "Original-")))
|
|
|
|
|
;; There is no Message-ID here, so we create one.
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
|
|
;; Look for a Content-Length header.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (not (re-search-forward
|
|
|
|
|
"^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
|
|
|
|
|
(setq content-length nil)
|
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 76)
- Update from CVS
2005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-agent.el (gnus-agent-regenerate-group)
(gnus-agent-fetch-articles): Replace `string-to-int' by
`string-to-number'.
* lisp/gnus/gnus-art.el (gnus-button-fetch-group): Ditto.
* lisp/gnus/gnus-cache.el (gnus-cache-generate-active)
(gnus-cache-articles-in-group): Ditto.
* lisp/gnus/gnus-group.el (gnus-group-set-current-level)
(gnus-group-insert-group-line): Ditto.
* lisp/gnus/gnus-score.el (gnus-score-set-expunge-below)
(gnus-score-set-mark-below, gnus-summary-score-effect)
(gnus-summary-score-entry): Ditto.
* lisp/gnus/gnus-soup.el (gnus-soup-send-packet, gnus-soup-parse-areas)
(gnus-soup-pack): Ditto.
* lisp/gnus/gnus-spec.el (gnus-xmas-format): Ditto.
* lisp/gnus/gnus-start.el (gnus-newsrc-to-gnus-format): Ditto.
* lisp/gnus/gnus-sum.el (gnus-create-xref-hashtb): Ditto.
* lisp/gnus/gnus-uu.el (gnus-uu-expand-numbers): Ditto.
* lisp/gnus/nnbabyl.el (nnbabyl-article-group-number): Ditto.
* lisp/gnus/nndb.el (nndb-get-remote-expire-response): Ditto.
* lisp/gnus/nndiary.el (nndiary-parse-schedule-value)
(nndiary-string-to-number, nndiary-request-replace-article)
(nndiary-request-article): Ditto.
* lisp/gnus/nndoc.el (nndoc-rnews-body-end, nndoc-mbox-body-end): Ditto.
* lisp/gnus/nndraft.el (nndraft-articles, nndraft-request-group): Ditto.
* lisp/gnus/nneething.el (nneething-make-head): Ditto.
* lisp/gnus/nnfolder.el (nnfolder-request-article)
(nnfolder-retrieve-headers): Ditto.
* lisp/gnus/nnheader.el (nnheader-file-to-number): Ditto.
* lisp/gnus/nnkiboze.el (nnkiboze-request-article): Ditto.
* lisp/gnus/nnmail.el (nnmail-process-unix-mail-format)
(nnmail-process-babyl-mail-format): Ditto.
* lisp/gnus/nnmbox.el (nnmbox-read-mbox, nnmbox-article-group-number): Ditto.
* lisp/gnus/nnmh.el (nnmh-update-gnus-unreads, nnmh-active-number)
(nnmh-request-create-group, nnmh-request-list-1)
(nnmh-request-group, nnmh-request-article): Ditto.
* lisp/gnus/nnml.el (nnml-request-replace-article, nnml-request-article): Ditto.
* lisp/gnus/nnrss.el (nnrss-find-rss-via-syndic8): Ditto.
* lisp/gnus/nnsoup.el (nnsoup-make-active): Ditto.
* lisp/gnus/nnspool.el (nnspool-find-id, nnspool-request-group): Ditto.
* lisp/gnus/nntp.el (nntp-find-group-and-number)
(nntp-retrieve-headers-with-xover): Ditto.
* lisp/gnus/pgg-gpg.el (pgg-gpg-snarf-keys-region): Ditto.
* lisp/gnus/pgg-parse.el (pgg-read-body, pgg-read-bytes)
(pgg-format-key-identifier): Ditto.
* lisp/gnus/pop3.el (pop3-last, pop3-stat): Ditto.
* lisp/gnus/qp.el (quoted-printable-decode-region): Ditto.
* lisp/gnus/spam-report.el (spam-report-url-ping-mm-url): Use format instead
of concat.
2005-05-30 17:13:58 +00:00
|
|
|
|
(setq content-length (string-to-number (match-string 1)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; We destroy the header, since none of the backends ever
|
|
|
|
|
;; use it, and we do not want to confuse other mailers by
|
|
|
|
|
;; having a (possibly) faulty header.
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "X-"))
|
|
|
|
|
(run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
|
|
;; Find the end of this article.
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(widen)
|
|
|
|
|
(setq head-end (point))
|
|
|
|
|
;; We try the Content-Length value. The idea: skip over the header
|
|
|
|
|
;; separator, then check what happens content-length bytes into the
|
2002-11-29 15:57:52 +00:00
|
|
|
|
;; message body. This should be either the end of the buffer, the
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; message separator or a blank line followed by the separator.
|
|
|
|
|
;; The blank line should probably be deleted. If neither of the
|
|
|
|
|
;; three is met, the content-length header is probably invalid.
|
|
|
|
|
(when content-length
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(setq skip (+ (point) content-length))
|
|
|
|
|
(goto-char skip)
|
|
|
|
|
(cond ((or (= skip (point-max))
|
|
|
|
|
(= (1+ skip) (point-max)))
|
|
|
|
|
(setq end (point-max)))
|
|
|
|
|
((looking-at "From ")
|
|
|
|
|
(setq end skip))
|
|
|
|
|
((looking-at "[ \t]*\n\\(From \\)")
|
|
|
|
|
(setq end (match-beginning 1)))
|
|
|
|
|
(t (setq end nil))))
|
|
|
|
|
(if end
|
|
|
|
|
(goto-char end)
|
|
|
|
|
;; No Content-Length, so we find the beginning of the next
|
|
|
|
|
;; article or the end of the buffer.
|
|
|
|
|
(goto-char head-end)
|
|
|
|
|
(or (nnmail-search-unix-mail-delim)
|
|
|
|
|
(goto-char (point-max))))
|
|
|
|
|
;; Allow the backend to save the article.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start (point))
|
|
|
|
|
(goto-char (point-min))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(incf count)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(nnmail-check-duplication message-id func artnum-func)
|
|
|
|
|
(setq end (point-max))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(goto-char end)))
|
|
|
|
|
count))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-process-mmdf-mail-format (func artnum-func)
|
|
|
|
|
(let ((delim "^\^A\^A\^A\^A$")
|
|
|
|
|
(case-fold-search t)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(count 0)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
start message-id end)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (not (and (re-search-forward delim nil t)
|
|
|
|
|
(forward-line 1)))
|
|
|
|
|
;; Possibly wrong format?
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(error "Error, unknown mail format! (Possibly corrupted.)")
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Carry on until the bitter end.
|
|
|
|
|
(while (not (eobp))
|
|
|
|
|
(setq start (point))
|
|
|
|
|
;; Find the end of the head.
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
start
|
|
|
|
|
(if (search-forward "\n\n" nil t)
|
|
|
|
|
(1- (point))
|
|
|
|
|
;; This will never happen, but just to be on the safe side --
|
|
|
|
|
;; if there is no head-body delimiter, we search a bit manually.
|
|
|
|
|
(while (and (looking-at "From \\|[^ \t]+:")
|
|
|
|
|
(not (eobp)))
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(point)))
|
|
|
|
|
;; Find the Message-ID header.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
|
|
|
(setq message-id (match-string 1))
|
|
|
|
|
;; There is no Message-ID here, so we create one.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "Original-")))
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
|
|
(run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
|
|
;; Find the end of this article.
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(widen)
|
|
|
|
|
(if (re-search-forward delim nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(goto-char (point-max)))
|
|
|
|
|
;; Allow the backend to save the article.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(narrow-to-region start (point))
|
|
|
|
|
(goto-char (point-min))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(incf count)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(nnmail-check-duplication message-id func artnum-func)
|
|
|
|
|
(setq end (point-max))))
|
|
|
|
|
(goto-char end)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(forward-line 2)))
|
|
|
|
|
count))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-process-maildir-mail-format (func artnum-func)
|
|
|
|
|
;; In a maildir, every file contains exactly one mail.
|
|
|
|
|
(let ((case-fold-search t)
|
|
|
|
|
message-id)
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
;; Find the end of the head.
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
(point-min)
|
|
|
|
|
(if (search-forward "\n\n" nil t)
|
|
|
|
|
(1- (point))
|
|
|
|
|
;; This will never happen, but just to be on the safe side --
|
|
|
|
|
;; if there is no head-body delimiter, we search a bit manually.
|
|
|
|
|
(while (and (looking-at "From \\|[^ \t]+:")
|
|
|
|
|
(not (eobp)))
|
|
|
|
|
(forward-line 1))
|
|
|
|
|
(point)))
|
|
|
|
|
;; Find the Message-ID header.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
|
|
|
|
|
(setq message-id (match-string 1))
|
|
|
|
|
;; There is no Message-ID here, so we create one.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "Original-")))
|
|
|
|
|
(forward-line 1)
|
|
|
|
|
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
|
|
(run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
|
|
;; Allow the backend to save the article.
|
|
|
|
|
(widen)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(nnmail-check-duplication message-id func artnum-func))
|
|
|
|
|
1))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(defvar nnmail-group-names-not-encoded-p nil
|
|
|
|
|
"Non-nil means group names are not encoded.")
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-split-incoming (incoming func &optional exit-func
|
|
|
|
|
group artnum-func)
|
|
|
|
|
"Go through the entire INCOMING file and pick out each individual mail.
|
|
|
|
|
FUNC will be called with the buffer narrowed to each mail."
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(let ( ;; If this is a group-specific split, we bind the split
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; methods to just this group.
|
|
|
|
|
(nnmail-split-methods (if (and group
|
|
|
|
|
(not nnmail-resplit-incoming))
|
|
|
|
|
(list (list group ""))
|
2007-10-28 09:18:39 +00:00
|
|
|
|
nnmail-split-methods))
|
|
|
|
|
(nnmail-group-names-not-encoded-p t))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
;; Insert the incoming file.
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(set-buffer (get-buffer-create nnmail-article-buffer))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(erase-buffer)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(let ((coding-system-for-read nnmail-incoming-coding-system))
|
|
|
|
|
(mm-insert-file-contents incoming))
|
|
|
|
|
(prog1
|
|
|
|
|
(if (zerop (buffer-size))
|
|
|
|
|
0
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
|
|
|
|
|
;; Handle both babyl, MMDF and unix mail formats, since
|
|
|
|
|
;; movemail will use the former when fetching from a
|
|
|
|
|
;; mailbox, the latter when fetching from a file.
|
|
|
|
|
(cond ((or (looking-at "\^L")
|
|
|
|
|
(looking-at "BABYL OPTIONS:"))
|
|
|
|
|
(nnmail-process-babyl-mail-format func artnum-func))
|
|
|
|
|
((looking-at "\^A\^A\^A\^A")
|
|
|
|
|
(nnmail-process-mmdf-mail-format func artnum-func))
|
|
|
|
|
((looking-at "Return-Path:")
|
|
|
|
|
(nnmail-process-maildir-mail-format func artnum-func))
|
|
|
|
|
(t
|
|
|
|
|
(nnmail-process-unix-mail-format func artnum-func))))
|
|
|
|
|
(when exit-func
|
|
|
|
|
(funcall exit-func))
|
|
|
|
|
(kill-buffer (current-buffer))))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(defun nnmail-article-group (func &optional trace)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
"Look at the headers and return an alist of groups that match.
|
|
|
|
|
FUNC will be called with the group name to determine the article number."
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(let ((methods (or nnmail-split-methods '(("bogus" ""))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(obuf (current-buffer))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
group-art method grp)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(if (and (sequencep methods)
|
|
|
|
|
(= (length methods) 1))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; If there is only just one group to put everything in, we
|
|
|
|
|
;; just return a list with just this one method in.
|
|
|
|
|
(setq group-art
|
|
|
|
|
(list (cons (caar methods) (funcall func (caar methods)))))
|
|
|
|
|
;; We do actual comparison.
|
|
|
|
|
(save-excursion
|
2004-09-04 13:13:48 +00:00
|
|
|
|
;; Copy the article into the work buffer.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(set-buffer nntp-server-buffer)
|
|
|
|
|
(erase-buffer)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(insert-buffer-substring obuf)
|
|
|
|
|
;; Narrow to headers.
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(if (search-forward "\n\n" nil t)
|
|
|
|
|
(point)
|
|
|
|
|
(point-max)))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
;; Decode MIME headers and charsets.
|
|
|
|
|
(when nnmail-mail-splitting-decodes
|
|
|
|
|
(let ((mail-parse-charset nnmail-mail-splitting-charset))
|
|
|
|
|
(mail-decode-encoded-word-region (point-min) (point-max))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Fold continuation lines.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
|
|
|
(replace-match " " t t))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; Nuke pathologically long headers. Since Gnus applies
|
|
|
|
|
;; pathologically complex regexps to the buffer, lines
|
|
|
|
|
;; that are looong will take longer than the Universe's
|
|
|
|
|
;; existence to process.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (not (eobp))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(unless (< (move-to-column nnmail-split-header-length-limit)
|
|
|
|
|
nnmail-split-header-length-limit)
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(delete-region (point) (point-at-eol)))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(forward-line 1))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Allow washing.
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(goto-char (point-min))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(run-hooks 'nnmail-split-hook)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(when (setq nnmail-split-tracing trace)
|
|
|
|
|
(setq nnmail-split-trace nil))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(if (and (symbolp nnmail-split-methods)
|
|
|
|
|
(fboundp nnmail-split-methods))
|
|
|
|
|
(let ((split
|
2006-07-21 06:34:45 +00:00
|
|
|
|
(condition-case error-info
|
1997-09-24 01:50:24 +00:00
|
|
|
|
;; `nnmail-split-methods' is a function, so we
|
|
|
|
|
;; just call this function here and use the
|
|
|
|
|
;; result.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(or (funcall nnmail-split-methods)
|
|
|
|
|
'("bogus"))
|
|
|
|
|
(error
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(nnheader-message
|
2006-07-21 06:34:45 +00:00
|
|
|
|
5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(sit-for 1)
|
|
|
|
|
'("bogus")))))
|
2005-10-04 22:51:06 +00:00
|
|
|
|
(setq split (mm-delete-duplicates split))
|
1997-09-24 01:50:24 +00:00
|
|
|
|
;; The article may be "cross-posted" to `junk'. What
|
|
|
|
|
;; to do? Just remove the `junk' spec. Don't really
|
|
|
|
|
;; see anything else to do...
|
|
|
|
|
(let (elem)
|
|
|
|
|
(while (setq elem (car (memq 'junk split)))
|
|
|
|
|
(setq split (delq elem split))))
|
|
|
|
|
(when split
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(setq group-art
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (group) (cons group (funcall func group)))
|
|
|
|
|
split))))
|
|
|
|
|
;; Go through the split methods to find a match.
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(while (and methods
|
|
|
|
|
(or nnmail-crosspost
|
|
|
|
|
(not group-art)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(goto-char (point-max))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(setq method (pop methods)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
grp (car method))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(if (or methods
|
|
|
|
|
(not (equal "" (nth 1 method))))
|
|
|
|
|
(when (and
|
|
|
|
|
(ignore-errors
|
|
|
|
|
(if (stringp (nth 1 method))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(let ((expand (string-match "\\\\[0-9&]" grp))
|
|
|
|
|
(pos (re-search-backward (cadr method)
|
|
|
|
|
nil t)))
|
|
|
|
|
(and expand
|
|
|
|
|
(setq grp (nnmail-expand-newtext grp)))
|
|
|
|
|
pos)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Function to say whether this is a match.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(funcall (nth 1 method) grp)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Don't enter the article into the same
|
|
|
|
|
;; group twice.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(not (assoc grp group-art)))
|
|
|
|
|
(push (cons grp (funcall func grp))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
group-art))
|
|
|
|
|
;; This is the final group, which is used as a
|
|
|
|
|
;; catch-all.
|
|
|
|
|
(unless group-art
|
|
|
|
|
(setq group-art
|
|
|
|
|
(list (cons (car method)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(funcall func (car method))))))))
|
|
|
|
|
;; Fall back on "bogus" if all else fails.
|
|
|
|
|
(unless group-art
|
|
|
|
|
(setq group-art (list (cons "bogus" (funcall func "bogus"))))))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; Produce a trace if non-empty.
|
|
|
|
|
(when (and trace nnmail-split-trace)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(let ((restore (current-buffer)))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(nnheader-set-temp-buffer "*Split Trace*")
|
|
|
|
|
(gnus-add-buffer)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(dolist (trace (nreverse nnmail-split-trace))
|
|
|
|
|
(prin1 trace (current-buffer))
|
|
|
|
|
(insert "\n"))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(gnus-configure-windows 'split-trace)
|
|
|
|
|
(set-buffer restore)))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(widen)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; See whether the split methods returned `junk'.
|
|
|
|
|
(if (equal group-art '(junk))
|
|
|
|
|
nil
|
1997-09-24 01:50:24 +00:00
|
|
|
|
;; The article may be "cross-posted" to `junk'. What
|
|
|
|
|
;; to do? Just remove the `junk' spec. Don't really
|
|
|
|
|
;; see anything else to do...
|
|
|
|
|
(let (elem)
|
|
|
|
|
(while (setq elem (car (memq 'junk group-art)))
|
|
|
|
|
(setq group-art (delq elem group-art)))
|
|
|
|
|
(nreverse group-art)))))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-insert-lines ()
|
|
|
|
|
"Insert how many lines there are in the body of the mail.
|
|
|
|
|
Return the number of characters in the body."
|
|
|
|
|
(let (lines chars)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
2003-02-04 13:24:35 +00:00
|
|
|
|
(unless (search-forward "\n\n" nil t)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(insert "\n"))
|
|
|
|
|
(setq chars (- (point-max) (point)))
|
|
|
|
|
(setq lines (count-lines (point) (point-max)))
|
|
|
|
|
(forward-char -1)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(when (re-search-backward "^Lines: " nil t)
|
|
|
|
|
(delete-region (point) (progn (forward-line 1) (point)))))
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert (format "Lines: %d\n" (max lines 0)))
|
|
|
|
|
chars)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-insert-xref (group-alist)
|
|
|
|
|
"Insert an Xref line based on the (group . article) alist."
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(unless (search-forward "\n\n" nil t)
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(insert "\n"))
|
|
|
|
|
(forward-char -1)
|
|
|
|
|
(when (re-search-backward "^Xref: " nil t)
|
|
|
|
|
(delete-region (match-beginning 0)
|
|
|
|
|
(progn (forward-line 1) (point))))
|
|
|
|
|
(insert (format "Xref: %s" (system-name)))
|
|
|
|
|
(while group-alist
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(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)))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(setq group-alist (cdr group-alist)))
|
|
|
|
|
(insert "\n")))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
;;; Message washing functions
|
|
|
|
|
|
|
|
|
|
(defun nnmail-remove-leading-whitespace ()
|
|
|
|
|
"Remove excessive whitespace from all headers."
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (re-search-forward "^\\([^ :]+: \\) +" nil t)
|
|
|
|
|
(replace-match "\\1" t)))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-remove-list-identifiers ()
|
|
|
|
|
"Remove list identifiers from Subject headers."
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(let ((regexp
|
|
|
|
|
(if (consp nnmail-list-identifiers)
|
|
|
|
|
(mapconcat 'identity nnmail-list-identifiers " *\\|")
|
|
|
|
|
nnmail-list-identifiers)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(when regexp
|
|
|
|
|
(goto-char (point-min))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(while (re-search-forward
|
|
|
|
|
(concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
|
|
|
|
|
nil t)
|
|
|
|
|
(delete-region (match-beginning 2) (match-end 0))
|
|
|
|
|
(beginning-of-line))
|
|
|
|
|
(when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
|
|
|
|
|
nil t)
|
|
|
|
|
(delete-region (match-beginning 1) (match-end 1))
|
|
|
|
|
(beginning-of-line)))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-remove-tabs ()
|
|
|
|
|
"Translate TAB characters into SPACE characters."
|
|
|
|
|
(subst-char-in-region (point-min) (point-max) ?\t ? t))
|
|
|
|
|
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(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."
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(goto-char (point-min))
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(when (re-search-forward nnmail-broken-references-mailers nil t)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(when (re-search-forward "^References:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert "X-Gnus-Broken-Eudora-"))
|
|
|
|
|
(goto-char (point-min))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
|
|
|
|
|
(replace-match "\\1" t))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
|
|
|
|
|
(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(custom-add-option 'nnmail-prepare-incoming-header-hook
|
2007-10-28 09:18:39 +00:00
|
|
|
|
'nnmail-ignore-broken-references)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;;; Utility functions
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defun nnmail-do-request-post (accept-func &optional server)
|
|
|
|
|
"Utility function to directly post a message to an nnmail-derived group.
|
|
|
|
|
Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
|
|
|
|
|
to actually put the message in the right group."
|
|
|
|
|
(let ((success t))
|
|
|
|
|
(dolist (mbx (message-unquote-tokens
|
|
|
|
|
(message-tokenize-header
|
|
|
|
|
(message-fetch-field "Newsgroups") ", ")) success)
|
|
|
|
|
(let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
|
|
|
|
|
(or (gnus-active to-newsgroup)
|
|
|
|
|
(gnus-activate-group to-newsgroup)
|
|
|
|
|
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
|
|
|
|
|
to-newsgroup))
|
|
|
|
|
(or (and (gnus-request-create-group
|
|
|
|
|
to-newsgroup gnus-command-method)
|
|
|
|
|
(gnus-activate-group to-newsgroup nil nil
|
|
|
|
|
gnus-command-method))
|
|
|
|
|
(error "Couldn't create group %s" to-newsgroup)))
|
|
|
|
|
(error "No such group: %s" to-newsgroup))
|
|
|
|
|
(unless (funcall accept-func mbx (nth 1 gnus-command-method))
|
|
|
|
|
(setq success nil))))))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-split-fancy ()
|
|
|
|
|
"Fancy splitting method.
|
2004-09-04 13:13:48 +00:00
|
|
|
|
See the documentation for the variable `nnmail-split-fancy' for details."
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(with-syntax-table nnmail-split-fancy-syntax-table
|
|
|
|
|
(nnmail-split-it nnmail-split-fancy)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defvar nnmail-split-cache nil)
|
|
|
|
|
;; Alist of split expressions their equivalent regexps.
|
|
|
|
|
|
|
|
|
|
(defun nnmail-split-it (split)
|
|
|
|
|
;; Return a list of groups matching SPLIT.
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(let (cached-pair)
|
|
|
|
|
(cond
|
|
|
|
|
;; nil split
|
|
|
|
|
((null split)
|
|
|
|
|
nil)
|
|
|
|
|
|
|
|
|
|
;; A group name. Do the \& and \N subs into the string.
|
|
|
|
|
((stringp split)
|
|
|
|
|
(when nnmail-split-tracing
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(push split nnmail-split-trace))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(list (nnmail-expand-newtext split)))
|
|
|
|
|
|
|
|
|
|
;; Junk the message.
|
|
|
|
|
((eq split 'junk)
|
|
|
|
|
(when nnmail-split-tracing
|
|
|
|
|
(push "junk" nnmail-split-trace))
|
|
|
|
|
(list 'junk))
|
|
|
|
|
|
|
|
|
|
;; Builtin & operation.
|
|
|
|
|
((eq (car split) '&)
|
|
|
|
|
(apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
|
|
|
|
|
|
|
|
|
|
;; Builtin | operation.
|
|
|
|
|
((eq (car split) '|)
|
|
|
|
|
(let (done)
|
|
|
|
|
(while (and (not done) (cdr split))
|
|
|
|
|
(setq split (cdr split)
|
|
|
|
|
done (nnmail-split-it (car split))))
|
|
|
|
|
done))
|
|
|
|
|
|
|
|
|
|
;; Builtin : operation.
|
|
|
|
|
((eq (car split) ':)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(when nnmail-split-tracing
|
|
|
|
|
(push split nnmail-split-trace))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(nnmail-split-it (save-excursion (eval (cdr split)))))
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;; Builtin ! operation.
|
|
|
|
|
((eq (car split) '!)
|
|
|
|
|
(funcall (cadr split) (nnmail-split-it (caddr split))))
|
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; Check the cache for the regexp for this split.
|
|
|
|
|
((setq cached-pair (assq split nnmail-split-cache))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(let (split-result
|
|
|
|
|
(end-point (point-max))
|
|
|
|
|
(value (nth 1 split)))
|
|
|
|
|
(if (symbolp value)
|
|
|
|
|
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
|
|
(while (and (goto-char end-point)
|
|
|
|
|
(re-search-backward (cdr cached-pair) nil t))
|
|
|
|
|
(when nnmail-split-tracing
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(push split nnmail-split-trace))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(let ((split-rest (cddr split))
|
|
|
|
|
(end (match-end 0))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
|
|
|
|
|
;; So, start-of-value is the point just before the
|
|
|
|
|
;; beginning of the value, whereas after-header-name
|
|
|
|
|
;; is the point just after the field name.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(start-of-value (match-end 1))
|
|
|
|
|
(after-header-name (match-end 2)))
|
|
|
|
|
;; Start the next search just before the beginning of the
|
|
|
|
|
;; VALUE match.
|
|
|
|
|
(setq end-point (1- start-of-value))
|
|
|
|
|
;; Handle - RESTRICTs
|
|
|
|
|
(while (eq (car split-rest) '-)
|
|
|
|
|
;; RESTRICT must start after-header-name and
|
|
|
|
|
;; end after start-of-value, so that, for
|
|
|
|
|
;; (any "foo" - "x-foo" "foo.list")
|
|
|
|
|
;; we do not exclude foo.list just because
|
|
|
|
|
;; the header is: ``To: x-foo, foo''
|
|
|
|
|
(goto-char end)
|
|
|
|
|
(if (and (re-search-backward (cadr split-rest)
|
|
|
|
|
after-header-name t)
|
|
|
|
|
(> (match-end 0) start-of-value))
|
|
|
|
|
(setq split-rest nil)
|
|
|
|
|
(setq split-rest (cddr split-rest))))
|
|
|
|
|
(when split-rest
|
|
|
|
|
(goto-char end)
|
|
|
|
|
(let ((value (nth 1 split)))
|
|
|
|
|
(if (symbolp value)
|
|
|
|
|
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
|
|
;; Someone might want to do a \N sub on this match, so get the
|
|
|
|
|
;; correct match positions.
|
|
|
|
|
(re-search-backward value start-of-value))
|
|
|
|
|
(dolist (sp (nnmail-split-it (car split-rest)))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(unless (member sp split-result)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(push sp split-result))))))
|
|
|
|
|
split-result))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
|
|
|
|
|
;; Not in cache, compute a regexp for the field/value pair.
|
|
|
|
|
(t
|
2006-03-09 07:11:51 +00:00
|
|
|
|
(let ((field (nth 0 split))
|
|
|
|
|
(value (nth 1 split))
|
|
|
|
|
(split-rest (cddr split))
|
|
|
|
|
partial-front
|
|
|
|
|
partial-rear
|
|
|
|
|
regexp)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(if (symbolp value)
|
|
|
|
|
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
|
|
|
|
|
(if (and (>= (length value) 2)
|
|
|
|
|
(string= ".*" (substring value 0 2)))
|
|
|
|
|
(setq value (substring value 2)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
partial-front ""))
|
|
|
|
|
;; Same trick for the rear of the regexp
|
|
|
|
|
(if (and (>= (length value) 2)
|
|
|
|
|
(string= ".*" (substring value -2)))
|
|
|
|
|
(setq value (substring value 0 -2)
|
|
|
|
|
partial-rear ""))
|
2006-03-09 07:11:51 +00:00
|
|
|
|
;; Invert the match-partial-words behavior if the optional
|
|
|
|
|
;; last element is specified.
|
|
|
|
|
(while (eq (car split-rest) '-)
|
|
|
|
|
(setq split-rest (cddr split-rest)))
|
|
|
|
|
(when (if (cadr split-rest)
|
|
|
|
|
(not nnmail-split-fancy-match-partial-words)
|
|
|
|
|
nnmail-split-fancy-match-partial-words)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(setq partial-front ""
|
|
|
|
|
partial-rear ""))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(setq regexp (concat "^\\(\\("
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(if (symbolp field)
|
|
|
|
|
(cdr (assq field nnmail-split-abbrev-alist))
|
|
|
|
|
field)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
"\\):.*\\)"
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(or partial-front "\\<")
|
2000-09-19 13:37:09 +00:00
|
|
|
|
"\\("
|
|
|
|
|
value
|
2004-09-04 13:13:48 +00:00
|
|
|
|
"\\)"
|
|
|
|
|
(or partial-rear "\\>")))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(push (cons split regexp) nnmail-split-cache)
|
|
|
|
|
;; Now that it's in the cache, just call nnmail-split-it again
|
2006-03-09 07:11:51 +00:00
|
|
|
|
;; on the same split, which will find it immediately in the cache.
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(nnmail-split-it split))))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-expand-newtext (newtext)
|
|
|
|
|
(let ((len (length newtext))
|
|
|
|
|
(pos 0)
|
|
|
|
|
c expanded beg N did-expand)
|
|
|
|
|
(while (< pos len)
|
|
|
|
|
(setq beg pos)
|
|
|
|
|
(while (and (< pos len)
|
|
|
|
|
(not (= (aref newtext pos) ?\\)))
|
|
|
|
|
(setq pos (1+ pos)))
|
|
|
|
|
(unless (= beg pos)
|
|
|
|
|
(push (substring newtext beg pos) expanded))
|
|
|
|
|
(when (< pos len)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; We hit a \; expand it.
|
|
|
|
|
(setq did-expand t
|
|
|
|
|
pos (1+ pos)
|
|
|
|
|
c (aref newtext pos))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(if (not (or (= c ?\&)
|
|
|
|
|
(and (>= c ?1)
|
|
|
|
|
(<= c ?9))))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
;; \ followed by some character we don't expand.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(push (char-to-string c) expanded)
|
|
|
|
|
;; \& or \N
|
|
|
|
|
(if (= c ?\&)
|
|
|
|
|
(setq N 0)
|
|
|
|
|
(setq N (- c ?0)))
|
|
|
|
|
(when (match-beginning N)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(push (if nnmail-split-lowercase-expanded
|
|
|
|
|
(downcase (buffer-substring (match-beginning N)
|
|
|
|
|
(match-end N)))
|
|
|
|
|
(buffer-substring (match-beginning N) (match-end N)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
expanded))))
|
|
|
|
|
(setq pos (1+ pos)))
|
|
|
|
|
(if did-expand
|
|
|
|
|
(apply 'concat (nreverse expanded))
|
|
|
|
|
newtext)))
|
|
|
|
|
|
|
|
|
|
;; Activate a backend only if it isn't already activated.
|
|
|
|
|
;; If FORCE, re-read the active file even if the backend is
|
|
|
|
|
;; already activated.
|
|
|
|
|
(defun nnmail-activate (backend &optional force)
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(nnheader-init-server-buffer)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(let (file timestamp file-time)
|
|
|
|
|
(if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
|
|
|
|
|
force
|
|
|
|
|
(and (setq file (ignore-errors
|
|
|
|
|
(symbol-value (intern (format "%s-active-file"
|
|
|
|
|
backend)))))
|
|
|
|
|
(setq file-time (nth 5 (file-attributes file)))
|
|
|
|
|
(or (not
|
|
|
|
|
(setq timestamp
|
|
|
|
|
(condition-case ()
|
|
|
|
|
(symbol-value (intern
|
|
|
|
|
(format "%s-active-timestamp"
|
|
|
|
|
backend)))
|
|
|
|
|
(error 'none))))
|
|
|
|
|
(not (consp timestamp))
|
|
|
|
|
(equal timestamp '(0 0))
|
|
|
|
|
(> (nth 0 file-time) (nth 0 timestamp))
|
|
|
|
|
(and (= (nth 0 file-time) (nth 0 timestamp))
|
|
|
|
|
(> (nth 1 file-time) (nth 1 timestamp))))))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(or (eq timestamp 'none)
|
|
|
|
|
(set (intern (format "%s-active-timestamp" backend))
|
|
|
|
|
file-time))
|
|
|
|
|
(funcall (intern (format "%s-request-list" backend)))))
|
|
|
|
|
t))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-message-id ()
|
|
|
|
|
(concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
|
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; nnmail duplicate handling
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(defvar nnmail-cache-buffer nil)
|
|
|
|
|
|
|
|
|
|
(defun nnmail-cache-open ()
|
|
|
|
|
(if (or (not nnmail-treat-duplicates)
|
|
|
|
|
(and nnmail-cache-buffer
|
|
|
|
|
(buffer-name nnmail-cache-buffer)))
|
|
|
|
|
() ; The buffer is open.
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer
|
|
|
|
|
(setq nnmail-cache-buffer
|
|
|
|
|
(get-buffer-create " *nnmail message-id cache*")))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(gnus-add-buffer)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(when (file-exists-p nnmail-message-id-cache-file)
|
|
|
|
|
(nnheader-insert-file-contents nnmail-message-id-cache-file))
|
|
|
|
|
(set-buffer-modified-p nil)
|
|
|
|
|
(current-buffer))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-cache-close ()
|
|
|
|
|
(when (and nnmail-cache-buffer
|
|
|
|
|
nnmail-treat-duplicates
|
|
|
|
|
(buffer-name nnmail-cache-buffer)
|
|
|
|
|
(buffer-modified-p nnmail-cache-buffer))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nnmail-cache-buffer)
|
|
|
|
|
;; Weed out the excess number of Message-IDs.
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(when (search-backward "\n" nil t nnmail-message-id-cache-length)
|
|
|
|
|
(progn
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(delete-region (point-min) (point))))
|
|
|
|
|
;; Save the buffer.
|
|
|
|
|
(or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
|
|
|
|
|
(make-directory (file-name-directory nnmail-message-id-cache-file)
|
|
|
|
|
t))
|
|
|
|
|
(nnmail-write-region (point-min) (point-max)
|
|
|
|
|
nnmail-message-id-cache-file nil 'silent)
|
|
|
|
|
(set-buffer-modified-p nil)
|
|
|
|
|
(setq nnmail-cache-buffer nil)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(gnus-kill-buffer (current-buffer)))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;; Compiler directives.
|
|
|
|
|
(defvar group)
|
|
|
|
|
(defvar group-art-list)
|
|
|
|
|
(defvar group-art)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(defun nnmail-cache-insert (id grp &optional subject sender)
|
|
|
|
|
(when (stringp id)
|
|
|
|
|
;; this will handle cases like `B r' where the group is nil
|
|
|
|
|
(let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
|
2005-02-09 15:50:47 +00:00
|
|
|
|
(run-hook-with-args 'nnmail-spool-hook
|
2004-09-04 13:13:48 +00:00
|
|
|
|
id grp subject sender))
|
|
|
|
|
(when nnmail-treat-duplicates
|
|
|
|
|
;; Store some information about the group this message is written
|
|
|
|
|
;; to. This is passed in as the grp argument -- all locations this
|
|
|
|
|
;; has been called from have been checked and the group is available.
|
|
|
|
|
;; The only ambiguous case is nnmail-check-duplication which will only
|
|
|
|
|
;; pass the first (of possibly >1) group which matches. -Josh
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(unless (gnus-buffer-live-p nnmail-cache-buffer)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(nnmail-cache-open))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(save-excursion
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(set-buffer nnmail-cache-buffer)
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(if (and grp (not (string= "" grp))
|
|
|
|
|
(gnus-methods-equal-p gnus-command-method
|
|
|
|
|
(nnmail-cache-primary-mail-backend)))
|
|
|
|
|
(let ((regexp (if (consp nnmail-cache-ignore-groups)
|
|
|
|
|
(mapconcat 'identity nnmail-cache-ignore-groups
|
|
|
|
|
"\\|")
|
|
|
|
|
nnmail-cache-ignore-groups)))
|
|
|
|
|
(unless (and regexp (string-match regexp grp))
|
|
|
|
|
(insert id "\t" grp "\n")))
|
|
|
|
|
(insert id "\n"))))))
|
2005-02-09 15:50:47 +00:00
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defun nnmail-cache-primary-mail-backend ()
|
|
|
|
|
(let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(be nil)
|
|
|
|
|
(res nil)
|
|
|
|
|
(get-new-mail nil))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(while (and (null res) be-list)
|
|
|
|
|
(setq be (car be-list))
|
|
|
|
|
(setq be-list (cdr be-list))
|
|
|
|
|
(when (and (gnus-method-option-p be 'respool)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(setq get-new-mail
|
|
|
|
|
(intern (format "%s-get-new-mail" (car be))))
|
|
|
|
|
(boundp get-new-mail)
|
|
|
|
|
(symbol-value get-new-mail))
|
|
|
|
|
(setq res be)))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
res))
|
|
|
|
|
|
|
|
|
|
;; Fetch the group name corresponding to the message id stored in the
|
|
|
|
|
;; cache.
|
|
|
|
|
(defun nnmail-cache-fetch-group (id)
|
|
|
|
|
(when (and nnmail-treat-duplicates nnmail-cache-buffer)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nnmail-cache-buffer)
|
|
|
|
|
(goto-char (point-max))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(when (search-backward id nil t)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(skip-chars-forward "^\n\r\t")
|
|
|
|
|
(unless (looking-at "[\r\n]")
|
|
|
|
|
(forward-char 1)
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(buffer-substring (point) (point-at-eol)))))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
|
|
|
|
|
;; Function for nnmail-split-fancy: look up all references in the
|
|
|
|
|
;; cache and if a match is found, return that group.
|
|
|
|
|
(defun nnmail-split-fancy-with-parent ()
|
2004-09-04 13:13:48 +00:00
|
|
|
|
"Split this message into the same group as its parent.
|
|
|
|
|
This function can be used as an entry in `nnmail-split-fancy', for
|
|
|
|
|
example like this: (: nnmail-split-fancy-with-parent)
|
|
|
|
|
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 message id
|
|
|
|
|
cache file (given by the variable `nnmail-message-id-cache-file') to
|
|
|
|
|
see which group that message was put in. This group is returned.
|
|
|
|
|
|
|
|
|
|
See the Info node `(gnus)Fancy Mail Splitting' for more details."
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(let* ((refstr (or (message-fetch-field "references")
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(message-fetch-field "in-reply-to")))
|
|
|
|
|
(references nil)
|
|
|
|
|
(res nil)
|
|
|
|
|
(regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
|
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (x) (format "\\(%s\\)" x))
|
|
|
|
|
nnmail-split-fancy-with-parent-ignore-groups
|
|
|
|
|
"\\|")
|
|
|
|
|
nnmail-split-fancy-with-parent-ignore-groups)))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(when refstr
|
|
|
|
|
(setq references (nreverse (gnus-split-references refstr)))
|
|
|
|
|
(unless (gnus-buffer-live-p nnmail-cache-buffer)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(nnmail-cache-open))
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(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)))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
res)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-cache-id-exists-p (id)
|
|
|
|
|
(when nnmail-treat-duplicates
|
|
|
|
|
(save-excursion
|
|
|
|
|
(set-buffer nnmail-cache-buffer)
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(search-backward id nil t))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-fetch-field (header)
|
|
|
|
|
(save-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(message-narrow-to-head)
|
|
|
|
|
(message-fetch-field header))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-check-duplication (message-id func artnum-func)
|
|
|
|
|
(run-hooks 'nnmail-prepare-incoming-message-hook)
|
|
|
|
|
;; If this is a duplicate message, then we do not save it.
|
|
|
|
|
(let* ((duplication (nnmail-cache-id-exists-p message-id))
|
|
|
|
|
(case-fold-search t)
|
|
|
|
|
(action (when duplication
|
|
|
|
|
(cond
|
|
|
|
|
((memq nnmail-treat-duplicates '(warn delete))
|
|
|
|
|
nnmail-treat-duplicates)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
((functionp nnmail-treat-duplicates)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(funcall nnmail-treat-duplicates message-id))
|
|
|
|
|
(t
|
|
|
|
|
nnmail-treat-duplicates))))
|
|
|
|
|
group-art)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;; We insert a line that says what the mail source is.
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(re-search-forward "^message-id[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Let the backend save the article (or not).
|
|
|
|
|
(cond
|
|
|
|
|
((not duplication)
|
|
|
|
|
(funcall func (setq group-art
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(nreverse (nnmail-article-group artnum-func))))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(nnmail-cache-insert message-id (caar group-art)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
((eq action 'delete)
|
|
|
|
|
(setq group-art nil))
|
|
|
|
|
((eq action 'warn)
|
|
|
|
|
;; We insert a warning.
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(re-search-forward "^message-id[ \t]*:" nil t)
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(insert
|
|
|
|
|
"Gnus-Warning: This is a duplicate of message " message-id "\n")
|
|
|
|
|
(funcall func (setq group-art
|
|
|
|
|
(nreverse (nnmail-article-group artnum-func))))))
|
|
|
|
|
(t
|
|
|
|
|
(funcall func (setq group-art
|
|
|
|
|
(nreverse (nnmail-article-group artnum-func))))))
|
|
|
|
|
;; Add the group-art list to the history list.
|
|
|
|
|
(if group-art
|
|
|
|
|
(push group-art nnmail-split-history)
|
|
|
|
|
(delete-region (point-min) (point-max)))))
|
|
|
|
|
|
|
|
|
|
;;; Get new mail.
|
|
|
|
|
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(defvar nnmail-fetched-sources nil)
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-get-value (&rest args)
|
|
|
|
|
(let ((sym (intern (apply 'format args))))
|
|
|
|
|
(when (boundp sym)
|
|
|
|
|
(symbol-value sym))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-get-new-mail (method exit-func temp
|
|
|
|
|
&optional group spool-func)
|
|
|
|
|
"Read new incoming mail."
|
2007-12-06 00:21:00 +00:00
|
|
|
|
(let* ((sources mail-sources)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
fetching-sources
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(group-in group)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(i 0)
|
|
|
|
|
(new 0)
|
|
|
|
|
(total 0)
|
|
|
|
|
incoming incomings source)
|
2000-09-20 16:54:57 +00:00
|
|
|
|
(when (and (nnmail-get-value "%s-get-new-mail" method)
|
|
|
|
|
sources)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(while (setq source (pop sources))
|
|
|
|
|
;; Hack to only fetch the contents of a single group's spool file.
|
|
|
|
|
(when (and (eq (car source) 'directory)
|
|
|
|
|
(null nnmail-scan-directory-mail-source-once)
|
|
|
|
|
group)
|
|
|
|
|
(mail-source-bind (directory source)
|
|
|
|
|
(setq source (append source
|
|
|
|
|
(list
|
|
|
|
|
:predicate
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(gnus-byte-compile
|
|
|
|
|
`(lambda (file)
|
|
|
|
|
(string-equal
|
|
|
|
|
,(concat group suffix)
|
|
|
|
|
(file-name-nondirectory file)))))))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(when nnmail-fetched-sources
|
|
|
|
|
(if (member source nnmail-fetched-sources)
|
|
|
|
|
(setq source nil)
|
|
|
|
|
(push source nnmail-fetched-sources)
|
|
|
|
|
(push source fetching-sources)))))
|
|
|
|
|
(when fetching-sources
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; We first activate all the groups.
|
|
|
|
|
(nnmail-activate method)
|
|
|
|
|
;; Allow the user to hook.
|
|
|
|
|
(run-hooks 'nnmail-pre-get-new-mail-hook)
|
|
|
|
|
;; Open the message-id cache.
|
|
|
|
|
(nnmail-cache-open)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
;; The we go through all the existing mail source specification
|
|
|
|
|
;; and fetch the mail from each.
|
|
|
|
|
(while (setq source (pop fetching-sources))
|
|
|
|
|
(nnheader-message 4 "%s: Reading incoming mail from %s..."
|
|
|
|
|
method (car source))
|
|
|
|
|
(when (setq new
|
|
|
|
|
(mail-source-fetch
|
|
|
|
|
source
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(gnus-byte-compile
|
|
|
|
|
`(lambda (file orig-file)
|
|
|
|
|
(nnmail-split-incoming
|
|
|
|
|
file ',(intern (format "%s-save-mail" method))
|
|
|
|
|
',spool-func
|
|
|
|
|
(if (equal file orig-file)
|
|
|
|
|
nil
|
|
|
|
|
(nnmail-get-split-group orig-file ',source))
|
|
|
|
|
',(intern (format "%s-active-number" method)))))))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(incf total new)
|
|
|
|
|
(incf i)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; If we did indeed read any incoming spools, we save all info.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(if (zerop total)
|
|
|
|
|
(nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
|
|
|
|
|
method (car source))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(nnmail-save-active
|
|
|
|
|
(nnmail-get-value "%s-group-alist" method)
|
|
|
|
|
(nnmail-get-value "%s-active-file" method))
|
|
|
|
|
(when exit-func
|
|
|
|
|
(funcall exit-func))
|
|
|
|
|
(run-hooks 'nnmail-read-incoming-hook)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
|
|
|
|
|
total))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Close the message-id cache.
|
|
|
|
|
(nnmail-cache-close)
|
|
|
|
|
;; Allow the user to hook.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(run-hooks 'nnmail-post-get-new-mail-hook))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-expired-article-p (group time force &optional inhibit)
|
|
|
|
|
"Say whether an article that is TIME old in GROUP should be expired."
|
|
|
|
|
(if force
|
|
|
|
|
t
|
|
|
|
|
(let ((days (or (and nnmail-expiry-wait-function
|
|
|
|
|
(funcall nnmail-expiry-wait-function group))
|
|
|
|
|
nnmail-expiry-wait)))
|
|
|
|
|
(cond ((or (eq days 'never)
|
|
|
|
|
(and (not force)
|
|
|
|
|
inhibit))
|
|
|
|
|
;; This isn't an expirable group.
|
|
|
|
|
nil)
|
|
|
|
|
((eq days 'immediate)
|
|
|
|
|
;; We expire all articles on sight.
|
|
|
|
|
t)
|
|
|
|
|
((equal time '(0 0))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
;; This is an ange-ftp group, and we don't have any dates.
|
1997-04-16 22:13:18 +00:00
|
|
|
|
nil)
|
|
|
|
|
((numberp days)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(setq days (days-to-time days))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Compare the time with the current time.
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(ignore-errors (time-less-p days (time-since time))))))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-expiry-target-group (target group)
|
2004-09-04 13:13:48 +00:00
|
|
|
|
;; Do not invoke this from nntp-server-buffer! At least nnfolder clears
|
|
|
|
|
;; that buffer if the nnfolder group isn't selected.
|
|
|
|
|
(let (nnmail-cache-accepted-message-ids)
|
|
|
|
|
;; Don't enter Message-IDs into cache.
|
|
|
|
|
;; Let users hack it in TARGET function.
|
|
|
|
|
(when (functionp target)
|
|
|
|
|
(setq target (funcall target group)))
|
|
|
|
|
(unless (eq target 'delete)
|
|
|
|
|
(when (or (gnus-request-group target)
|
|
|
|
|
(gnus-request-create-group target))
|
|
|
|
|
(let ((group-art (gnus-request-accept-article target nil nil t)))
|
|
|
|
|
(when (consp group-art)
|
|
|
|
|
(gnus-group-mark-article-read target (cdr group-art))))))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-fancy-expiry-target (group)
|
|
|
|
|
"Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
|
|
|
|
|
(let* (header
|
|
|
|
|
(case-fold-search nil)
|
|
|
|
|
(from (or (message-fetch-field "from") ""))
|
|
|
|
|
(to (or (message-fetch-field "to") ""))
|
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 157-168)
- Merge from emacs--cvs-trunk--0
- Update from CVS
- Update from CVS: texi/message.texi: Fix default values.
2005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/mm-decode.el (mm-discouraged-alternatives): Fix custom type.
Suggest image/.* in the doc string.
2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/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 <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-art.el (gnus-default-article-saver): Add user-defined
`function' to custom type.
2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
* lisp/gnus/mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
parens.
2005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
long lines.
(gnus-cache-delete-group): Wrap doc strings.
* lisp/gnus/gnus-agent.el (gnus-agent-rename-group)
(gnus-agent-delete-group): Wrap doc strings.
2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
* lisp/gnus/rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
of current-time-string.
2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change)
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
date header.
2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
* lisp/gnus/imap.el (imap-kerberos4-open): Ignore SSL stuff.
2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc>
* lisp/gnus/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.
* lisp/gnus/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 <yamaoka@jpl.org>
* lisp/gnus/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 <yamaoka@jpl.org>
* lisp/gnus/gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
* lisp/gnus/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 <ken.manheimer@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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-30 Chong Yidong <cyd@stupidchicken.com>
* lisp/gnus/imap.el (imap-open): Handle case where buffer is a buffer
object.
2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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 <ken.manheimer+emacs@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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.
* lisp/gnus/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.
* lisp/gnus/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 <swilde@sha-bang.de>
* lisp/gnus/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.
* lisp/gnus/pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
New user commands for symmetric encryption.
2005-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
* man/pgg.texi (User Commands): Fix description of pgg-verify-region.
(Selecting an implementation): Fix descriptions.
2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Various Message Variables): Addition.
2005-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi: Fix default values.
2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Header Commands): Clarify descriptions of
message-cross-post-followup-to, message-reduce-to-to-cc, and
message-insert-wide-reply.
(Various Commands): Fix kindex for message-kill-to-signature;
clarify description of message-tab.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Mailing Lists): Fix description about MFT.
* man/gnus.texi (Emacs Lisp): Use ~/.gnus.el instead of ~/.emacs.
2005-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Slow Terminal Connection): Replace old description
with new one.
2005-11-16 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Oort Gnus): Use ~/.gnus.el instead of ~/.emacs;
replace X-Draft-Headers with X-Draft-From.
2005-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Various Various): Fix the default value of
nnheader-max-head-length.
(Gnus Versions): Fix typo.
2005-12-09 08:57:58 +00:00
|
|
|
|
(date (message-fetch-field "date"))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(target 'delete))
|
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-668
Merge from gnus--rel--5.10
Patches applied:
* gnus--rel--5.10 (patch 157-168)
- Merge from emacs--cvs-trunk--0
- Update from CVS
- Update from CVS: texi/message.texi: Fix default values.
2005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/mm-decode.el (mm-discouraged-alternatives): Fix custom type.
Suggest image/.* in the doc string.
2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/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 <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-art.el (gnus-default-article-saver): Add user-defined
`function' to custom type.
2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
* lisp/gnus/mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
parens.
2005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
* lisp/gnus/gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
long lines.
(gnus-cache-delete-group): Wrap doc strings.
* lisp/gnus/gnus-agent.el (gnus-agent-rename-group)
(gnus-agent-delete-group): Wrap doc strings.
2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
* lisp/gnus/rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
of current-time-string.
2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change)
* lisp/gnus/nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
date header.
2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
* lisp/gnus/imap.el (imap-kerberos4-open): Ignore SSL stuff.
2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc>
* lisp/gnus/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.
* lisp/gnus/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 <yamaoka@jpl.org>
* lisp/gnus/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 <yamaoka@jpl.org>
* lisp/gnus/gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
* lisp/gnus/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 <ken.manheimer@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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-30 Chong Yidong <cyd@stupidchicken.com>
* lisp/gnus/imap.el (imap-open): Handle case where buffer is a buffer
object.
2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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 <ken.manheimer+emacs@gmail.com>
* lisp/gnus/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.
* lisp/gnus/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.
* lisp/gnus/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.
* lisp/gnus/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 <swilde@sha-bang.de>
* lisp/gnus/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.
* lisp/gnus/pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
New user commands for symmetric encryption.
2005-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
* man/pgg.texi (User Commands): Fix description of pgg-verify-region.
(Selecting an implementation): Fix descriptions.
2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Various Message Variables): Addition.
2005-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi: Fix default values.
2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Header Commands): Clarify descriptions of
message-cross-post-followup-to, message-reduce-to-to-cc, and
message-insert-wide-reply.
(Various Commands): Fix kindex for message-kill-to-signature;
clarify description of message-tab.
2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
* man/message.texi (Mailing Lists): Fix description about MFT.
* man/gnus.texi (Emacs Lisp): Use ~/.gnus.el instead of ~/.emacs.
2005-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Slow Terminal Connection): Replace old description
with new one.
2005-11-16 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Oort Gnus): Use ~/.gnus.el instead of ~/.emacs;
replace X-Draft-Headers with X-Draft-From.
2005-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
* man/gnus.texi (Various Various): Fix the default value of
nnheader-max-head-length.
(Gnus Versions): Fix typo.
2005-12-09 08:57:58 +00:00
|
|
|
|
(setq date (if date
|
|
|
|
|
(condition-case err
|
|
|
|
|
(date-to-time date)
|
|
|
|
|
(error
|
|
|
|
|
(message "%s" (error-message-string err))
|
|
|
|
|
(current-time)))
|
|
|
|
|
(current-time)))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
|
|
|
|
|
(setq header (car regexp-target-pair))
|
|
|
|
|
(cond
|
|
|
|
|
;; If the header is to-from then match against the
|
|
|
|
|
;; To or From header
|
|
|
|
|
((and (equal header 'to-from)
|
|
|
|
|
(or (string-match (cadr regexp-target-pair) from)
|
2007-10-20 02:22:19 +00:00
|
|
|
|
(and (string-match (cadr regexp-target-pair) to)
|
|
|
|
|
(let ((rmail-dont-reply-to-names
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(message-dont-reply-to-names)))
|
2007-10-20 02:22:19 +00:00
|
|
|
|
(equal (rmail-dont-reply-to from) "")))))
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(setq target (format-time-string (caddr regexp-target-pair) date)))
|
|
|
|
|
((and (not (equal header 'to-from))
|
|
|
|
|
(string-match (cadr regexp-target-pair)
|
|
|
|
|
(or
|
|
|
|
|
(message-fetch-field header)
|
|
|
|
|
"")))
|
|
|
|
|
(setq target
|
|
|
|
|
(format-time-string (caddr regexp-target-pair) date)))))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
(defun nnmail-check-syntax ()
|
|
|
|
|
"Check (and modify) the syntax of the message in the current buffer."
|
|
|
|
|
(save-restriction
|
|
|
|
|
(message-narrow-to-head)
|
|
|
|
|
(let ((case-fold-search t))
|
|
|
|
|
(unless (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
|
|
|
(insert "Message-ID: " (nnmail-message-id) "\n")))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-write-region (start end filename &optional append visit lockname)
|
|
|
|
|
"Do a `write-region', and then set the file modes."
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(let ((coding-system-for-write nnmail-file-coding-system)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(file-name-coding-system nnmail-pathname-coding-system))
|
1997-08-28 04:51:02 +00:00
|
|
|
|
(write-region start end filename append visit lockname)
|
|
|
|
|
(set-file-modes filename nnmail-default-file-modes)))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
|
|
|
|
;;;
|
|
|
|
|
;;; Status functions
|
|
|
|
|
;;;
|
|
|
|
|
|
|
|
|
|
(defun nnmail-replace-status (name value)
|
|
|
|
|
"Make status NAME and VALUE part of the current status line."
|
|
|
|
|
(save-restriction
|
|
|
|
|
(message-narrow-to-head)
|
|
|
|
|
(let ((status (nnmail-decode-status)))
|
|
|
|
|
(setq status (delq (member name status) status))
|
|
|
|
|
(when value
|
|
|
|
|
(push (cons name value) status))
|
|
|
|
|
(message-remove-header "status")
|
|
|
|
|
(goto-char (point-max))
|
|
|
|
|
(insert "Status: " (nnmail-encode-status status) "\n"))))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-decode-status ()
|
|
|
|
|
"Return a status-value alist from STATUS."
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(when (re-search-forward "^Status: " nil t)
|
|
|
|
|
(let (name value status)
|
|
|
|
|
(save-restriction
|
|
|
|
|
;; Narrow to the status.
|
|
|
|
|
(narrow-to-region
|
|
|
|
|
(point)
|
|
|
|
|
(if (re-search-forward "^[^ \t]" nil t)
|
|
|
|
|
(1- (point))
|
|
|
|
|
(point-max)))
|
|
|
|
|
;; Go through all elements and add them to the list.
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (re-search-forward "[^ \t=]+" nil t)
|
|
|
|
|
(setq name (match-string 0))
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(if (not (eq (char-after) ?=))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;; Implied "yes".
|
|
|
|
|
(setq value "yes")
|
|
|
|
|
(forward-char 1)
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(if (not (eq (char-after) ?\"))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(if (not (looking-at "[^ \t]"))
|
|
|
|
|
;; Implied "no".
|
|
|
|
|
(setq value "no")
|
|
|
|
|
;; Unquoted value.
|
|
|
|
|
(setq value (match-string 0))
|
|
|
|
|
(goto-char (match-end 0)))
|
|
|
|
|
;; Quoted value.
|
|
|
|
|
(setq value (read (current-buffer)))))
|
|
|
|
|
(push (cons name value) status)))
|
|
|
|
|
status)))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-encode-status (status)
|
|
|
|
|
"Return a status string from STATUS."
|
|
|
|
|
(mapconcat
|
|
|
|
|
(lambda (elem)
|
|
|
|
|
(concat
|
|
|
|
|
(car elem) "="
|
|
|
|
|
(if (string-match "[ \t]" (cdr elem))
|
|
|
|
|
(prin1-to-string (cdr elem))
|
|
|
|
|
(cdr elem))))
|
|
|
|
|
status " "))
|
|
|
|
|
|
|
|
|
|
(defun nnmail-split-history ()
|
|
|
|
|
"Generate an overview of where the last mail split put articles."
|
|
|
|
|
(interactive)
|
|
|
|
|
(unless nnmail-split-history
|
|
|
|
|
(error "No current split history"))
|
|
|
|
|
(with-output-to-temp-buffer "*nnmail split history*"
|
2000-09-19 13:37:09 +00:00
|
|
|
|
(with-current-buffer standard-output
|
|
|
|
|
(fundamental-mode)) ; for Emacs 20.4+
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(dolist (elem nnmail-split-history)
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(princ (mapconcat (lambda (ga)
|
|
|
|
|
(concat (car ga) ":" (int-to-string (cdr ga))))
|
|
|
|
|
elem
|
|
|
|
|
", "))
|
2007-10-28 09:18:39 +00:00
|
|
|
|
(princ "\n"))))
|
1997-04-16 22:13:18 +00:00
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(defun nnmail-purge-split-history (group)
|
|
|
|
|
"Remove all instances of GROUP from `nnmail-split-history'."
|
|
|
|
|
(let ((history nnmail-split-history))
|
|
|
|
|
(while history
|
2004-09-04 13:13:48 +00:00
|
|
|
|
(setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(car history)))
|
|
|
|
|
(pop history))
|
|
|
|
|
(setq nnmail-split-history (delq nil nnmail-split-history))))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(defun nnmail-new-mail-p (group)
|
|
|
|
|
"Say whether GROUP has new mail."
|
|
|
|
|
(let ((his nnmail-split-history)
|
|
|
|
|
found)
|
|
|
|
|
(while his
|
|
|
|
|
(when (assoc group (pop his))
|
|
|
|
|
(setq found t
|
|
|
|
|
his nil)))
|
|
|
|
|
found))
|
|
|
|
|
|
1999-02-20 14:05:57 +00:00
|
|
|
|
(defun nnmail-within-headers-p ()
|
|
|
|
|
"Check to see if point is within the headers of a unix mail message.
|
|
|
|
|
Doesn't change point."
|
|
|
|
|
(let ((pos (point)))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(and (nnmail-search-unix-mail-delim-backward)
|
|
|
|
|
(not (search-forward "\n\n" pos t))))))
|
|
|
|
|
|
1997-04-16 22:13:18 +00:00
|
|
|
|
(run-hooks 'nnmail-load-hook)
|
|
|
|
|
|
|
|
|
|
(provide 'nnmail)
|
|
|
|
|
|
2003-09-01 15:45:59 +00:00
|
|
|
|
;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
|
1997-04-16 22:13:18 +00:00
|
|
|
|
;;; nnmail.el ends here
|