gnus.el (gnus-mode-line-buffer-identification): Don't add image data for a non-graphi...

[gnus] / lisp / nnmail.el

diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index 95a9835..d1a0455 100644 (file)
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -1,7 +1,6 @@
 ;;; nnmail.el --- mail support functions for the Gnus mail backends
 
 ;;; 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-2014 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news, mail


@@ -25,10 +24,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-;; For Emacs < 22.2.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-

 (eval-when-compile (require 'cl))
 
 (require 'gnus)                                ; for macro gnus-kill-buffer, at least
 (eval-when-compile (require 'cl))
 
 (require 'gnus)                                ; for macro gnus-kill-buffer, at least


@@ -41,6 +36,8 @@
 
 (autoload 'gnus-add-buffer "gnus")
 (autoload 'gnus-kill-buffer "gnus")
 
 (autoload 'gnus-add-buffer "gnus")
 (autoload 'gnus-kill-buffer "gnus")

+(eval-when-compile
+  (autoload 'mail-send-and-exit "sendmail" nil t))

 
 (defgroup nnmail nil
   "Reading mail with Gnus."
 
 (defgroup nnmail nil
   "Reading mail with Gnus."


@@ -104,7 +101,9 @@ mail belongs in that group.
 
 The last element should always have \"\" as the regexp.
 
 
 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)))
   :group 'nnmail-split
   :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
                                             (choice regexp function)))


@@ -176,7 +175,7 @@ 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'.
 
 many days an article can be stored before it is considered \"old\".
 It can also return the values `never' and `immediate'.
 

-Eg.:
+E.g.:

 
 \(setq nnmail-expiry-wait-function
       (lambda (newsgroup)
 
 \(setq nnmail-expiry-wait-function
       (lambda (newsgroup)


@@ -225,7 +224,7 @@ Example:
 
 In this case, articles containing the string \"boss\" in the To or the
 From header will be expired to the group \"nnfolder:Work\";
 
 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"
 be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
 everything else will be expired to \"nnfolder:Archive-YYYY\"."
   :version "22.1"


@@ -288,7 +287,7 @@ 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.)
 
 emptied, and can be used to call any mail box programs you have
 running (\"xwatch\", etc.)
 

-Eg.
+E.g.:

 
 \(add-hook 'nnmail-read-incoming-hook
          (lambda ()
 
 \(add-hook 'nnmail-read-incoming-hook
          (lambda ()


@@ -371,7 +370,7 @@ messages will be shown to indicate the current status."
                  (number :tag "count")))
 
 (define-widget 'nnmail-lazy 'default
                  (number :tag "count")))
 
 (define-widget 'nnmail-lazy 'default

-  "Base widget for recursive datastructures.
+  "Base widget for recursive data structures.

 
 This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
   :format "%{%t%}: %v"
 
 This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
   :format "%{%t%}: %v"


@@ -552,9 +551,11 @@ parameter.  It should return nil, `warn' or `delete'."
                 (const warn)
                 (const delete)))
 
                 (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.3"

   :group 'nnmail
   :type '(repeat symbol))
 
   :group 'nnmail
   :type '(repeat symbol))
 


@@ -963,7 +964,7 @@ If SOURCE is a directory spec, try to return the group name component."
        (goto-char end)))
     count))
 
        (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)
   (let ((delim "^\^A\^A\^A\^A$")
        (case-fold-search t)
        (count 0)


@@ -1011,7 +1012,7 @@ If SOURCE is a directory spec, try to return the group name component."
            (narrow-to-region start (point))
            (goto-char (point-min))
            (incf count)
            (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)))
            (setq end (point-max))))
        (goto-char end)
        (forward-line 2)))


@@ -1056,7 +1057,7 @@ If SOURCE is a directory spec, try to return the group name component."
   "Non-nil means group names are not encoded.")
 
 (defun nnmail-split-incoming (incoming func &optional exit-func
   "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
   "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


@@ -1087,7 +1088,8 @@ will be copied over from that buffer."
                       (looking-at "BABYL OPTIONS:"))
                   (nnmail-process-babyl-mail-format func artnum-func))
                  ((looking-at "\^A\^A\^A\^A")
                       (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
                  ((looking-at "Return-Path:")
                   (nnmail-process-maildir-mail-format func artnum-func))
                  (t


@@ -1096,7 +1098,7 @@ will be copied over from that buffer."
          (funcall exit-func))
        (kill-buffer (current-buffer))))))
 
          (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" ""))))
   "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" ""))))


@@ -1144,28 +1146,42 @@ FUNC will be called with the group name to determine the article number."
        (run-hooks 'nnmail-split-hook)
        (when (setq nnmail-split-tracing trace)
          (setq nnmail-split-trace nil))
        (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...
              (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
              (when split
                (setq group-art
                      (mapcar


@@ -1199,7 +1215,8 @@ FUNC will be called with the group name to determine the article number."
              ;; This is the final group, which is used as a
              ;; catch-all.
              (when (and (not group-art)
              ;; 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))))))))
                (setq group-art
                      (list (cons (car method)
                                  (funcall func (car method))))))))


@@ -1331,7 +1348,7 @@ Eudora has a broken References line, but an OK In-Reply-To."
 ;;; Utility functions
 
 (declare-function gnus-activate-group "gnus-start"
 ;;; 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.
 
 (defun nnmail-do-request-post (accept-func &optional server)
   "Utility function to directly post a message to an nnmail-derived group.


@@ -1376,7 +1393,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
      ((stringp split)
       (when nnmail-split-tracing
        (push split nnmail-split-trace))
      ((stringp split)
       (when nnmail-split-tracing
        (push split nnmail-split-trace))

-      (list (nnmail-expand-newtext split)))
+      (list (nnmail-expand-newtext split t)))

 
      ;; Junk the message.
      ((eq split 'junk)
 
      ;; Junk the message.
      ((eq split 'junk)


@@ -1409,12 +1426,14 @@ See the documentation for the variable `nnmail-split-fancy' for details."
      ;; Check the cache for the regexp for this split.
      ((setq cached-pair (assq split nnmail-split-cache))
       (let (split-result
      ;; Check the cache for the regexp for this split.
      ((setq cached-pair (assq split nnmail-split-cache))
       (let (split-result

+           match-data

            (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))
            (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))

+         (setq match-data (match-data))

          (when nnmail-split-tracing
            (push split nnmail-split-trace))
          (let ((split-rest (cddr split))
          (when nnmail-split-tracing
            (push split nnmail-split-trace))
          (let ((split-rest (cddr split))


@@ -1443,12 +1462,9 @@ See the documentation for the variable `nnmail-split-fancy' for details."
                (setq split-rest (cddr split-rest))))
            (when split-rest
              (goto-char end)
                (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))
+             ;; Someone might want to do a \N sub on this match, so
+             ;; restore the match data.
+             (set-match-data match-data)

              (dolist (sp (nnmail-split-it (car split-rest)))
                (unless (member sp split-result)
                  (push sp split-result))))))
              (dolist (sp (nnmail-split-it (car split-rest)))
                (unless (member sp split-result)
                  (push sp split-result))))))


@@ -1497,7 +1513,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
        ;; on the same split, which will find it immediately in the cache.
        (nnmail-split-it split))))))
 
        ;; on the same split, which will find it immediately in the cache.
        (nnmail-split-it split))))))
 

-(defun nnmail-expand-newtext (newtext)
+(defun nnmail-expand-newtext (newtext &optional fancyp)

   (let ((len (length newtext))
        (pos 0)
        c expanded beg N did-expand)
   (let ((len (length newtext))
        (pos 0)
        c expanded beg N did-expand)


@@ -1522,6 +1538,10 @@ See the documentation for the variable `nnmail-split-fancy' for details."
          (if (= c ?\&)
              (setq N 0)
            (setq N (- c ?0)))
          (if (= c ?\&)
              (setq N 0)
            (setq N (- c ?0)))

+         ;; We wrapped the searches in parentheses, so we have to
+         ;; add some parentheses here...
+         (when fancyp
+           (setq N (+ N 3)))

          (when (match-beginning N)
            (push (if nnmail-split-lowercase-expanded
                      (downcase (buffer-substring (match-beginning N)
          (when (match-beginning N)
            (push (if nnmail-split-lowercase-expanded
                      (downcase (buffer-substring (match-beginning N)


@@ -1609,10 +1629,6 @@ See the documentation for the variable `nnmail-split-fancy' for details."
       (setq nnmail-cache-buffer nil)
       (gnus-kill-buffer (current-buffer)))))
 
       (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
 (defun nnmail-cache-insert (id grp &optional subject sender)
   (when (stringp id)
     ;; this will handle cases like `B r' where the group is nil


@@ -1714,7 +1730,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (message-narrow-to-head)
       (message-fetch-field header))))
 
       (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))
   (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))


@@ -1739,7 +1756,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (cond
      ((not duplication)
       (funcall func (setq group-art
     (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))
       (nnmail-cache-insert message-id (caar group-art)))
      ((eq action 'delete)
       (setq group-art nil))


@@ -1782,7 +1800,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
         (i 0)
         (new 0)
         (total 0)
         (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))
     (when (and (nnmail-get-value "%s-get-new-mail" method)
               sources)
       (while (setq source (pop sources))


@@ -1825,18 +1843,23 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       ;; and fetch the mail from each.
       (while (setq source (pop fetching-sources))
        (when (setq new
       ;; 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.
          (incf total new)
          (incf i)))
       ;; If we did indeed read any incoming spools, we save all info.


@@ -1901,7 +1924,8 @@ If TIME is nil, then return the cutoff time for oldness instead."
       (when (or (gnus-request-group target)
                (gnus-request-create-group target))
        (let ((group-art (gnus-request-accept-article target nil nil t)))
       (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)
            (gnus-group-mark-article-read target (cdr group-art))))))))
 
 (defun nnmail-fancy-expiry-target (group)


@@ -1927,9 +1951,13 @@ If TIME is nil, then return the cutoff time for oldness instead."
        ((and (equal header 'to-from)
             (or (string-match (cadr regexp-target-pair) from)
                 (and (string-match (cadr regexp-target-pair) to)
        ((and (equal header 'to-from)
             (or (string-match (cadr regexp-target-pair) from)
                 (and (string-match (cadr regexp-target-pair) to)

-                     (let ((rmail-dont-reply-to-names
-                            (message-dont-reply-to-names)))
-                       (equal (rmail-dont-reply-to from) "")))))
+                     (let* ((mail-dont-reply-to-names
+                             (message-dont-reply-to-names))
+                            (rmail-dont-reply-to-names ; obsolete since 24.1
+                             mail-dont-reply-to-names))
+                       (equal (if (fboundp 'rmail-dont-reply-to)
+                                  (rmail-dont-reply-to from)
+                                (mail-dont-reply-to from)) "")))))

        (setq target (format-time-string (caddr regexp-target-pair) date)))
        ((and (not (equal header 'to-from))
             (string-match (cadr regexp-target-pair)
        (setq target (format-time-string (caddr regexp-target-pair) date)))
        ((and (not (equal header 'to-from))
             (string-match (cadr regexp-target-pair)