;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
The last element should always have \"\" as the regexp.
-This variable can also have a function as its value."
+This variable can also have a function as its value, and it can
+also have a fancy split method as its value. See
+`nnmail-split-fancy' for an explanation of that syntax."
:group 'nnmail-split
:type '(choice (repeat :tag "Alist" (group (string :tag "Name")
(choice regexp function)))
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
+articles containing the string \"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\"."
:version "22.1"
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers '(To Newsgroups)
- "*Extra headers to parse."
- :version "21.1"
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
+ "Extra headers to parse.
+In addition to the standard headers, these extra headers will be
+included in NOV headers (and the like) when backends parse headers."
+ :version "24.2"
:group 'nnmail
:type '(repeat symbol))
(goto-char end)))
count))
-(defun nnmail-process-mmdf-mail-format (func artnum-func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
(let ((delim "^\^A\^A\^A\^A$")
(case-fold-search t)
(count 0)
(narrow-to-region start (point))
(goto-char (point-min))
(incf count)
- (nnmail-check-duplication message-id func artnum-func)
+ (nnmail-check-duplication message-id func artnum-func junk-func)
(setq end (point-max))))
(goto-char end)
(forward-line 2)))
"Non-nil means group names are not encoded.")
(defun nnmail-split-incoming (incoming func &optional exit-func
- group artnum-func)
+ group artnum-func junk-func)
"Go through the entire INCOMING file and pick out each individual mail.
FUNC will be called with the buffer narrowed to each mail.
INCOMING can also be a buffer object. In that case, the mail
(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))
+ (nnmail-process-mmdf-mail-format
+ func artnum-func junk-func))
((looking-at "Return-Path:")
(nnmail-process-maildir-mail-format func artnum-func))
(t
(funcall exit-func))
(kill-buffer (current-buffer))))))
-(defun nnmail-article-group (func &optional trace)
+(defun nnmail-article-group (func &optional trace junk-func)
"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."
(let ((methods (or nnmail-split-methods '(("bogus" ""))))
(run-hooks 'nnmail-split-hook)
(when (setq nnmail-split-tracing trace)
(setq nnmail-split-trace nil))
- (if (and (symbolp nnmail-split-methods)
- (fboundp nnmail-split-methods))
- (let ((split
- (condition-case error-info
- ;; `nnmail-split-methods' is a function, so we
- ;; just call this function here and use the
- ;; result.
- (or (funcall nnmail-split-methods)
- (and (not nnmail-inhibit-default-split-group)
- '("bogus")))
- (error
- (nnheader-message
- 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
- (sit-for 1)
- '("bogus")))))
+ (if (or (and (symbolp nnmail-split-methods)
+ (fboundp nnmail-split-methods))
+ (not (consp (car-safe nnmail-split-methods)))
+ (and (listp nnmail-split-methods)
+ ;; Not a regular split method, so it has to be a
+ ;; fancy one.
+ (not (let ((top-element (car-safe nnmail-split-methods)))
+ (and (= 2 (length top-element))
+ (stringp (nth 0 top-element))
+ (stringp (nth 1 top-element)))))))
+ (let* ((method-function
+ (if (and (symbolp nnmail-split-methods)
+ (fboundp nnmail-split-methods))
+ nnmail-split-methods
+ 'nnmail-split-fancy))
+ (split
+ (condition-case error-info
+ ;; `nnmail-split-methods' is a function, so we
+ ;; just call this function here and use the
+ ;; result.
+ (or (funcall method-function)
+ (and (not nnmail-inhibit-default-split-group)
+ '("bogus")))
+ (error
+ (nnheader-message
+ 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
+ (sit-for 1)
+ '("bogus")))))
(setq split (mm-delete-duplicates split))
;; 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 (and (memq 'junk split)
+ junk-func)
+ (funcall junk-func 'junk))
+ (setq split (delq 'junk split))
(when split
(setq group-art
(mapcar
;; This is the final group, which is used as a
;; catch-all.
(when (and (not group-art)
- (not nnmail-inhibit-default-split-group))
+ (or (equal "" (nth 1 method))
+ (not nnmail-inhibit-default-split-group)))
(setq group-art
(list (cons (car method)
(funcall func (car method))))))))
;;; Utility functions
(declare-function gnus-activate-group "gnus-start"
- (group &optional scan dont-check method))
+ (group &optional scan dont-check method dont-sub-check))
(defun nnmail-do-request-post (accept-func &optional server)
"Utility function to directly post a message to an nnmail-derived group.
(setq nnmail-cache-buffer nil)
(gnus-kill-buffer (current-buffer)))))
-;; Compiler directives.
-(defvar group)
-(defvar group-art-list)
-(defvar group-art)
(defun nnmail-cache-insert (id grp &optional subject sender)
(when (stringp id)
;; this will handle cases like `B r' where the group is nil
(message-narrow-to-head)
(message-fetch-field header))))
-(defun nnmail-check-duplication (message-id func artnum-func)
+(defun nnmail-check-duplication (message-id func artnum-func
+ &optional junk-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))
(cond
((not duplication)
(funcall func (setq group-art
- (nreverse (nnmail-article-group artnum-func))))
+ (nreverse (nnmail-article-group
+ artnum-func nil junk-func))))
(nnmail-cache-insert message-id (caar group-art)))
((eq action 'delete)
(setq group-art nil))
(i 0)
(new 0)
(total 0)
- incoming incomings source)
+ source)
(when (and (nnmail-get-value "%s-get-new-mail" method)
sources)
(while (setq source (pop sources))
;; and fetch the mail from each.
(while (setq source (pop fetching-sources))
(when (setq new
- (mail-source-fetch
- source
- (gnus-byte-compile
- `(lambda (file orig-file)
- (nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func
- (or in-group
- (if (equal file orig-file)
- nil
- (nnmail-get-split-group orig-file ',source)))
- ',(intern (format "%s-active-number" method)))))))
+ (condition-case cond
+ (mail-source-fetch
+ source
+ (gnus-byte-compile
+ `(lambda (file orig-file)
+ (nnmail-split-incoming
+ file ',(intern (format "%s-save-mail" method))
+ ',spool-func
+ (or in-group
+ (if (equal file orig-file)
+ nil
+ (nnmail-get-split-group orig-file
+ ',source)))
+ ',(intern (format "%s-active-number" method))))))
+ ((error quit)
+ (message "Mail source %s failed: %s" source cond)
+ 0)))
(incf total new)
(incf i)))
;; If we did indeed read any incoming spools, we save all info.
(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)
+ (when (and (consp group-art)
+ (cdr group-art))
(gnus-group-mark-article-read target (cdr group-art))))))))
(defun nnmail-fancy-expiry-target (group)