X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnmail.el;h=f3f9e55cf7810e8bd18b55a7b36cd5945e8ce6b9;hp=2cab38c127b04754d9b874c20de66014b8572109;hb=9b139a13c0650a18872ebd64849560a97554afa8;hpb=bbaa6736e285258f29be9409b7b75751bb847e96 diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 2cab38c12..f3f9e55cf 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,6 +1,7 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -9,7 +10,7 @@ ;; 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 -;; the Free Software Foundation; either version 2, or (at your option) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -19,8 +20,8 @@ ;; 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 -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -48,7 +49,7 @@ :group 'nnmail) (defgroup nnmail-prepare nil - "Preparing (or mangling) new mail after retrival." + "Preparing (or mangling) new mail after retrieval." :group 'nnmail) (defgroup nnmail-duplicate nil @@ -118,6 +119,7 @@ If nil, the first match found will be used." (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." + :version "22.1" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -126,6 +128,7 @@ This can also be a list of regexps." (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." + :version "22.1" :group 'nnmail-split :type '(choice (const :tag "none" nil) (regexp :value ".*") @@ -223,6 +226,7 @@ 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\"." + :version "22.1" :group 'nnmail-expire :type '(repeat (list (choice :tag "Match against" (string :tag "Header") @@ -242,6 +246,10 @@ This variable is a list of mail source specifiers. This variable is obsolete; `mail-sources' should be used instead." :group 'nnmail-files :type 'sexp) +(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 (defcustom nnmail-resplit-incoming nil "*If non-nil, re-split incoming procmail sorted mail." @@ -351,6 +359,7 @@ discarded after running the split process." (defcustom nnmail-spool-hook nil "*A hook called when a new article is spooled." + :version "22.1" :group 'nnmail :type 'hook) @@ -365,14 +374,14 @@ messages will be shown to indicate the current status." (define-widget 'nnmail-lazy 'default "Base widget for recursive datastructures. -This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." +This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." :format "%{%t%}: %v" :convert-widget 'widget-value-convert-widget :value-create (lambda (widget) (let ((value (widget-get widget :value)) (type (widget-get widget :type))) - (widget-put widget :children - (list (widget-create-child-value + (widget-put widget :children + (list (widget-create-child-value widget (widget-convert type) value))))) :value-delete 'widget-children-value-delete :value-get (lambda (widget) @@ -404,7 +413,7 @@ This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." (list :tag "Function with fixed arguments (:)" :value (:) (const :format "" :value :) - function + function (editable-list :inline t (sexp :tag "Arg")) ) (list :tag "Function with split arguments (!)" @@ -412,11 +421,11 @@ This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility." (const :format "" !) function (editable-list :inline t nnmail-split-fancy)) - (list :tag "Field match" - (choice :tag "Field" + (list :tag "Field match" + (choice :tag "Field" regexp symbol) (choice :tag "Match" - regexp + regexp (symbol :value mail)) (repeat :inline t :tag "Restrictions" @@ -549,7 +558,7 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type '(repeat symbol)) -(defcustom nnmail-split-header-length-limit 512 +(defcustom nnmail-split-header-length-limit 2048 "Header lines longer than this limit are excluded from the split function." :version "21.1" :group 'nnmail @@ -557,11 +566,13 @@ parameter. It should return nil, `warn' or `delete'." (defcustom nnmail-mail-splitting-charset nil "Default charset to be used when splitting incoming mail." + :version "22.1" :group 'nnmail :type 'symbol) (defcustom nnmail-mail-splitting-decodes nil "Whether the nnmail splitting functionality should MIME decode headers." + :version "22.1" :group 'nnmail :type 'boolean) @@ -571,6 +582,7 @@ Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\ surrounded by anything." + :version "22.1" :group 'nnmail :type 'boolean) @@ -578,6 +590,7 @@ by anything." "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)." + :version "22.1" :group 'nnmail :type 'boolean) @@ -646,9 +659,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." (expand-file-name group dir) ;; If not, we translate dots into slashes. (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) + (nnheader-replace-chars-in-string group ?. ?/) dir)))) (or file ""))) @@ -760,7 +771,7 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (save-excursion (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) - (setq content-length (string-to-int + (setq content-length (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) @@ -897,7 +908,7 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (re-search-forward "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) - (setq content-length (string-to-int (match-string 1))) + (setq content-length (string-to-number (match-string 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. @@ -1033,6 +1044,9 @@ If SOURCE is a directory spec, try to return the group name component." (nnmail-check-duplication message-id func artnum-func)) 1)) +(defvar nnmail-group-names-not-encoded-p nil + "Non-nil means group names are not encoded.") + (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. @@ -1042,7 +1056,8 @@ FUNC will be called with the buffer narrowed to each mail." (nnmail-split-methods (if (and group (not nnmail-resplit-incoming)) (list (list group "")) - nnmail-split-methods))) + nnmail-split-methods)) + (nnmail-group-names-not-encoded-p t)) (save-excursion ;; Insert the incoming file. (set-buffer (get-buffer-create nnmail-article-buffer)) @@ -1121,7 +1136,7 @@ FUNC will be called with the group name to determine the article number." (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (let ((split - (condition-case nil + (condition-case error-info ;; `nnmail-split-methods' is a function, so we ;; just call this function here and use the ;; result. @@ -1129,10 +1144,10 @@ FUNC will be called with the group name to determine the article number." '("bogus")) (error (nnheader-message - 5 "Error in `nnmail-split-methods'; using `bogus' mail group") + 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info) (sit-for 1) '("bogus"))))) - (setq split (gnus-remove-duplicates split)) + (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... @@ -1233,11 +1248,11 @@ Return the number of characters in the body." (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - (insert (format " %s:%d" - (mm-encode-coding-string - (caar group-alist) - nnmail-pathname-coding-system) - (cdar group-alist))) + (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))))) (setq group-alist (cdr group-alist))) (insert "\n"))) @@ -1271,10 +1286,20 @@ Return the number of characters in the body." "Translate TAB characters into SPACE characters." (subst-char-in-region (point-min) (point-max) ?\t ? t)) -(defun nnmail-fix-eudora-headers () - "Eudora has a broken References line, but an OK In-Reply-To." +(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." (goto-char (point-min)) - (when (re-search-forward "^X-Mailer:.*Eudora" nil t) + (when (re-search-forward nnmail-broken-references-mailers nil t) (goto-char (point-min)) (when (re-search-forward "^References:" nil t) (beginning-of-line) @@ -1283,8 +1308,11 @@ Return the number of characters in the body." (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) (replace-match "\\1" t)))) +(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) +(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) + (custom-add-option 'nnmail-prepare-incoming-header-hook - 'nnmail-fix-eudora-headers) + 'nnmail-ignore-broken-references) ;;; Utility functions @@ -1411,11 +1439,12 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; Not in cache, compute a regexp for the field/value pair. (t - (let* ((field (nth 0 split)) - (value (nth 1 split)) - partial-front - partial-rear - regexp) + (let ((field (nth 0 split)) + (value (nth 1 split)) + (split-rest (cddr split)) + partial-front + partial-rear + regexp) (if (symbolp value) (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (if (and (>= (length value) 2) @@ -1427,7 +1456,13 @@ See the documentation for the variable `nnmail-split-fancy' for details." (string= ".*" (substring value -2))) (setq value (substring value 0 -2) partial-rear "")) - (when nnmail-split-fancy-match-partial-words + ;; 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) (setq partial-front "" partial-rear "")) (setq regexp (concat "^\\(\\(" @@ -1442,7 +1477,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (or partial-rear "\\>"))) (push (cons split regexp) nnmail-split-cache) ;; Now that it's in the cache, just call nnmail-split-it again - ;; on the same split, which will find it immediately in the cache. + ;; on the same split, which will find it immediately in the cache. (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) @@ -1567,7 +1602,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (when (stringp id) ;; this will handle cases like `B r' where the group is nil (let ((grp (or grp gnus-newsgroup-name "UNKNOWN"))) - (run-hook-with-args 'nnmail-spool-hook + (run-hook-with-args 'nnmail-spool-hook id grp subject sender)) (when nnmail-treat-duplicates ;; Store some information about the group this message is written @@ -1590,7 +1625,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (unless (and regexp (string-match regexp grp)) (insert id "\t" grp "\n"))) (insert id "\n")))))) - + (defun nnmail-cache-primary-mail-backend () (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) (be nil) @@ -1728,7 +1763,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." &optional group spool-func) "Read new incoming mail." (let* ((sources (or mail-sources - (if (listp nnmail-spool-file) nnmail-spool-file + (if (listp nnmail-spool-file) + nnmail-spool-file (list nnmail-spool-file)))) fetching-sources (group-in group) @@ -1858,9 +1894,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (case-fold-search nil) (from (or (message-fetch-field "from") "")) (to (or (message-fetch-field "to") "")) - (date (date-to-time - (or (message-fetch-field "date") (current-time-string)))) + (date (message-fetch-field "date")) (target 'delete)) + (setq date (if date + (condition-case err + (date-to-time date) + (error + (message "%s" (error-message-string err)) + (current-time))) + (current-time))) (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target) (setq header (car regexp-target-pair)) (cond @@ -1868,7 +1910,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; To or From header ((and (equal header 'to-from) (or (string-match (cadr regexp-target-pair) from) - (and (string-match message-dont-reply-to-names from) + (and (string-match (message-dont-reply-to-names) from) (string-match (cadr regexp-target-pair) to)))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) @@ -1961,14 +2003,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (with-output-to-temp-buffer "*nnmail split history*" (with-current-buffer standard-output (fundamental-mode)) ; for Emacs 20.4+ - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) + (dolist (elem nnmail-split-history) (princ (mapconcat (lambda (ga) (concat (car ga) ":" (int-to-string (cdr ga)))) elem ", ")) - (princ "\n"))))) + (princ "\n")))) (defun nnmail-purge-split-history (group) "Remove all instances of GROUP from `nnmail-split-history'."