X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnmail.el;h=d1a0455a1b04eb0504354abfc0eec4c17a922c53;hp=e17465ab07ddc6642494669400a673f0038f955e;hb=8bb74da7932287e4f5fd806aa6c7dae35256bdce;hpb=a1aff041b833f74bc4a421c92916ac1b8ccde0ca diff --git a/lisp/nnmail.el b/lisp/nnmail.el index e17465ab0..d1a0455a1 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,7 +1,6 @@ ;;; 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 ;; Keywords: news, mail @@ -25,10 +24,6 @@ ;;; 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 @@ -41,6 +36,8 @@ (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." @@ -104,7 +101,9 @@ mail belongs in that group. 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))) @@ -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'. -Eg.: +E.g.: \(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\"; -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" @@ -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.) -Eg. +E.g.: \(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 - "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" @@ -552,9 +551,11 @@ parameter. It should return nil, `warn' or `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)) @@ -963,7 +964,7 @@ If SOURCE is a directory spec, try to return the group name component." (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) @@ -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) - (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))) @@ -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 - 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 @@ -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") - (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 @@ -1096,7 +1098,7 @@ will be copied over from that 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" "")))) @@ -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)) - (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 @@ -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) - (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)))))))) @@ -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" - (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. @@ -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)) - (list (nnmail-expand-newtext split))) + (list (nnmail-expand-newtext split t))) ;; 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 + 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)) + (setq match-data (match-data)) (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) - (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)))))) @@ -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)))))) -(defun nnmail-expand-newtext (newtext) +(defun nnmail-expand-newtext (newtext &optional fancyp) (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))) + ;; 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) @@ -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))))) -;; 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 @@ -1714,7 +1730,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) @@ -1739,7 +1756,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) @@ -1782,7 +1800,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) @@ -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 - (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. @@ -1884,7 +1907,7 @@ If TIME is nil, then return the cutoff time for oldness instead." (setq days (days-to-time days)) ;; Compare the time with the current time. (if (null time) - (time-minus (current-time) days) + (time-subtract (current-time) days) (ignore-errors (time-less-p days (time-since time))))))))) (declare-function gnus-group-mark-article-read "gnus-group" (group article)) @@ -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 (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) @@ -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) - (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)