X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=8ccd7b02a16ff3e084f2fb71ce439b89ae523697;hb=79a508f1f7f8e13b242201273ffb8ce266e88b90;hp=7b06ec4df209c3e85020ed1c3e61b7eb761b3a7d;hpb=85d83e62d3d84f12fa7305e62206b9d092da6335;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 7b06ec4df..8ccd7b02a 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,16 +1,17 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) 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 @@ -18,27 +19,28 @@ ;; 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 -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; Code: +;; For Emacs <22.2 and XEmacs. +(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 (require 'nnheader) (require 'message) -(require 'custom) (require 'gnus-util) (require 'mail-source) (require 'mm-util) +(require 'gnus-int) -(eval-and-compile - (autoload 'gnus-add-buffer "gnus") - (autoload 'gnus-kill-buffer "gnus")) +(autoload 'gnus-add-buffer "gnus") +(autoload 'gnus-kill-buffer "gnus") (defgroup nnmail nil "Reading mail with Gnus." @@ -49,7 +51,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 @@ -102,7 +104,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))) @@ -119,6 +123,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 ".*") @@ -127,6 +132,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 ".*") @@ -195,7 +201,7 @@ The return value should be `delete' or a group name (a string)." :version "21.1" :group 'nnmail-expire :type '(choice (const delete) - (function :format "%v" nnmail-) + function string)) (defcustom nnmail-fancy-expiry-targets nil @@ -221,9 +227,10 @@ 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" :group 'nnmail-expire :type '(repeat (list (choice :tag "Match against" (string :tag "Header") @@ -237,12 +244,10 @@ If non-nil, also update the cache when copy or move articles." :group 'nnmail :type 'boolean) -(defcustom nnmail-spool-file '((file)) - "*Where the mail backends will look for incoming mail. -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 'mail-sources + "Gnus 5.9 (Emacs 22.1)") +;; revision 5.29 / p0-85 / Gnus 5.9 +;; Variable removed in No Gnus v0.7 (defcustom nnmail-resplit-incoming nil "*If non-nil, re-split incoming procmail sorted mail." @@ -262,7 +267,7 @@ It scans low-level sorted spools even when not required." :type 'function) (defcustom nnmail-crosspost-link-function - (if (string-match "windows-nt\\|emx" (symbol-name system-type)) + (if (string-match "windows-nt" (symbol-name system-type)) 'copy-file 'add-name-to-file) "*Function called to create a copy of a file. @@ -290,7 +295,10 @@ Eg. \(add-hook 'nnmail-read-incoming-hook (lambda () (call-process \"/local/bin/mailsend\" nil nil nil - \"read\" nnmail-spool-file))) + \"read\" + ;; The incoming mail box file. + (expand-file-name (user-login-name) + rmail-spool-directory)))) If you have xwatch running, this will alert it that mail has been read. @@ -352,6 +360,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) @@ -363,6 +372,70 @@ messages will be shown to indicate the current status." :type '(choice (const :tag "infinite" nil) (number :tag "count"))) +(define-widget 'nnmail-lazy 'default + "Base widget for recursive datastructures. + +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 (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 (:)" + :value (:) + (const :format "" :value :) + function + (editable-list :inline t (sexp :tag "Arg")) + ) + (list :tag "Function with split arguments (!)" + :value (!) + (const :format "" !) + function + (editable-list :inline t nnmail-split-fancy)) + (list :tag "Field match" + (choice :tag "Field" + regexp symbol) + (choice :tag "Match" + regexp + (symbol :value mail)) + (repeat :inline t + :tag "Restrictions" + (group :inline t + (const :format "" -) + regexp)) + nnmail-split-fancy) + (const :tag "Junk (delete mail)" junk))) + (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'. @@ -403,7 +476,7 @@ 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. -FIELD and VALUE can also be lisp symbols, in that case they are expanded +FIELD and VALUE can also be Lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. GROUP can contain \\& and \\N which will substitute from matching @@ -438,8 +511,7 @@ Example: ;; Unmatched mail goes to the catch all group. \"misc.misc\"))" :group 'nnmail-split - ;; Sigh! - :type 'sexp) + :type 'nnmail-split-fancy) (defcustom nnmail-split-abbrev-alist '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") @@ -460,8 +532,9 @@ performed." :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." +(defcustom nnmail-message-id-cache-file + (nnheader-concat gnus-home-directory ".nnmail-cache") + "The file name of the nnmail Message-ID cache." :group 'nnmail-duplicate :group 'nnmail-files :type 'file) @@ -487,7 +560,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 @@ -495,11 +568,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) @@ -509,6 +584,15 @@ 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) + +(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)." + :version "22.1" :group 'nnmail :type 'boolean) @@ -532,6 +616,7 @@ by anything." (defvar nnmail-split-tracing nil) (defvar nnmail-split-trace nil) +(defvar nnmail-inhibit-default-split-group nil) @@ -545,7 +630,14 @@ by anything." mm-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system nil +(defvar nnmail-pathname-coding-system + ;; This causes Emacs 22.2 and 22.3 to issue a useless warning. + ;;(if (and (featurep 'xemacs) (featurep 'file-coding)) + (if (featurep 'xemacs) + (if (featurep 'file-coding) + ;; Work around a bug in many XEmacs 21.5 betas. + ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134 + (setq file-name-coding-system (coding-system-aliasee 'file-name)))) "*Coding system for file name.") (defun nnmail-find-file (file) @@ -577,9 +669,7 @@ by anything." (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 ""))) @@ -587,8 +677,7 @@ by anything." "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (nnmail-parse-active))) (defun nnmail-parse-active () @@ -604,13 +693,13 @@ nn*-request-list should have been called before calling this function." (while (not (eobp)) (condition-case err (progn - (narrow-to-region (point) (gnus-point-at-eol)) + (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) (setq group (symbol-name group))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) - (push (list group (cons min max)) + (push (list (mm-string-as-unibyte group) (cons min max)) group-assoc))) (error nil)) (widen) @@ -625,6 +714,7 @@ nn*-request-list should have been called before calling this function." (let ((coding-system-for-write nnmail-active-file-coding-system)) (when file-name (with-temp-file file-name + (mm-disable-multibyte) (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) @@ -691,7 +781,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)))) @@ -828,7 +918,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. @@ -875,7 +965,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) @@ -923,7 +1013,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))) @@ -964,22 +1054,29 @@ 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) + 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." +FUNC will be called with the buffer narrowed to each mail. +INCOMING can also be a buffer object. In that case, the mail +will be copied over from that buffer." (let ( ;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group (not nnmail-resplit-incoming)) (list (list group "")) - nnmail-split-methods))) - (save-excursion - ;; Insert the incoming file. - (set-buffer (get-buffer-create nnmail-article-buffer)) + nnmail-split-methods)) + (nnmail-group-names-not-encoded-p t)) + ;; Insert the incoming file. + (with-current-buffer (get-buffer-create nnmail-article-buffer) (erase-buffer) - (let ((coding-system-for-read nnmail-incoming-coding-system)) - (mm-insert-file-contents incoming)) + (if (bufferp incoming) + (insert-buffer-substring incoming) + (let ((coding-system-for-read nnmail-incoming-coding-system)) + (mm-insert-file-contents incoming))) (prog1 (if (zerop (buffer-size)) 0 @@ -992,7 +1089,8 @@ FUNC will be called with the buffer narrowed to each 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 @@ -1001,22 +1099,22 @@ FUNC will be called with the buffer narrowed to each mail." (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" "")))) (obuf (current-buffer)) group-art method grp) (if (and (sequencep methods) - (= (length methods) 1)) + (= (length methods) 1) + (not nnmail-inhibit-default-split-group)) ;; 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 - ;; Copy the article into the work buffer. - (set-buffer nntp-server-buffer) + ;; Copy the article into the work buffer. + (with-current-buffer nntp-server-buffer (erase-buffer) (insert-buffer-substring obuf) ;; Narrow to headers. @@ -1042,34 +1140,48 @@ FUNC will be called with the group name to determine the article number." (while (not (eobp)) (unless (< (move-to-column nnmail-split-header-length-limit) nnmail-split-header-length-limit) - (delete-region (point) (gnus-point-at-eol))) + (delete-region (point) (point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) (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 nil - ;; `nnmail-split-methods' is a function, so we - ;; just call this function here and use the - ;; result. - (or (funcall nnmail-split-methods) - '("bogus")) - (error - (nnheader-message - 5 "Error in `nnmail-split-methods'; using `bogus' mail group") - (sit-for 1) - '("bogus"))))) - (setq split (gnus-remove-duplicates split)) + (if (or (and (symbolp nnmail-split-methods) + (fboundp 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 @@ -1102,12 +1214,14 @@ FUNC will be called with the group name to determine the article number." group-art)) ;; This is the final group, which is used as a ;; catch-all. - (unless group-art + (when (and (not group-art) + (not nnmail-inhibit-default-split-group)) (setq group-art (list (cons (car method) (funcall func (car method)))))))) ;; Fall back on "bogus" if all else fails. - (unless group-art + (when (and (not group-art) + (not nnmail-inhibit-default-split-group)) (setq group-art (list (cons "bogus" (funcall func "bogus")))))) ;; Produce a trace if non-empty. (when (and trace nnmail-split-trace) @@ -1164,11 +1278,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"))) @@ -1202,10 +1316,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.1" ;; 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) @@ -1214,11 +1338,17 @@ 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 "Emacs 23.1") + (custom-add-option 'nnmail-prepare-incoming-header-hook - 'nnmail-fix-eudora-headers) + 'nnmail-ignore-broken-references) ;;; Utility functions +(declare-function gnus-activate-group "gnus-start" + (group &optional scan dont-check method)) + (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') @@ -1244,12 +1374,8 @@ to actually put the message in the right group." (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for details." - (let ((syntab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table nnmail-split-fancy-syntax-table) - (nnmail-split-it nnmail-split-fancy)) - (set-syntax-table syntab)))) + (with-syntax-table nnmail-split-fancy-syntax-table + (nnmail-split-it nnmail-split-fancy))) (defvar nnmail-split-cache nil) ;; Alist of split expressions their equivalent regexps. @@ -1346,11 +1472,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) @@ -1362,7 +1489,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 "^\\(\\(" @@ -1377,7 +1510,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) @@ -1406,7 +1539,10 @@ See the documentation for the variable `nnmail-split-fancy' for details." (setq N 0) (setq N (- c ?0))) (when (match-beginning N) - (push (buffer-substring (match-beginning N) (match-end N)) + (push (if nnmail-split-lowercase-expanded + (downcase (buffer-substring (match-beginning N) + (match-end N))) + (buffer-substring (match-beginning N) (match-end N))) expanded)))) (setq pos (1+ pos))) (if did-expand @@ -1458,10 +1594,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) () ; The buffer is open. - (save-excursion - (set-buffer + (with-current-buffer (setq nnmail-cache-buffer - (get-buffer-create " *nnmail message-id cache*"))) + (get-buffer-create " *nnmail message-id cache*")) (gnus-add-buffer) (when (file-exists-p nnmail-message-id-cache-file) (nnheader-insert-file-contents nnmail-message-id-cache-file)) @@ -1473,8 +1608,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." nnmail-treat-duplicates (buffer-name nnmail-cache-buffer) (buffer-modified-p nnmail-cache-buffer)) - (save-excursion - (set-buffer nnmail-cache-buffer) + (with-current-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) @@ -1491,14 +1625,12 @@ 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) +(defun nnmail-cache-insert (id grp &optional subject sender) (when (stringp id) - (run-hook-with-args 'nnmail-spool-hook - id grp subject) + ;; 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 + 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 @@ -1507,8 +1639,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; pass the first (of possibly >1) group which matches. -Josh (unless (gnus-buffer-live-p nnmail-cache-buffer) (nnmail-cache-open)) - (save-excursion - (set-buffer nnmail-cache-buffer) + (with-current-buffer nnmail-cache-buffer (goto-char (point-max)) (if (and grp (not (string= "" grp)) (gnus-methods-equal-p gnus-command-method @@ -1520,7 +1651,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) @@ -1541,15 +1672,14 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; cache. (defun nnmail-cache-fetch-group (id) (when (and nnmail-treat-duplicates nnmail-cache-buffer) - (save-excursion - (set-buffer nnmail-cache-buffer) + (with-current-buffer nnmail-cache-buffer (goto-char (point-max)) (when (search-backward id nil t) (beginning-of-line) (skip-chars-forward "^\n\r\t") (unless (looking-at "[\r\n]") (forward-char 1) - (buffer-substring (point) (gnus-point-at-eol))))))) + (buffer-substring (point) (point-at-eol))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. @@ -1577,18 +1707,16 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq references (nreverse (gnus-split-references refstr))) (unless (gnus-buffer-live-p nnmail-cache-buffer) (nnmail-cache-open)) - (mapcar (lambda (x) - (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))) - references) + (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))) res))) (defun nnmail-cache-id-exists-p (id) (when nnmail-treat-duplicates - (save-excursion - (set-buffer nnmail-cache-buffer) + (with-current-buffer nnmail-cache-buffer (goto-char (point-max)) (search-backward id nil t)))) @@ -1598,7 +1726,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)) @@ -1623,7 +1752,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)) @@ -1655,13 +1785,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (symbol-value sym)))) (defun nnmail-get-new-mail (method exit-func temp - &optional group spool-func) + &optional group spool-func) "Read new incoming mail." - (let* ((sources (or mail-sources - (if (listp nnmail-spool-file) nnmail-spool-file - (list nnmail-spool-file)))) + (nnmail-get-new-mail-1 method exit-func temp group nil spool-func)) + +(defun nnmail-get-new-mail-1 (method exit-func temp + group in-group spool-func) + (let* ((sources mail-sources) fetching-sources - (group-in group) (i 0) (new 0) (total 0) @@ -1669,20 +1800,16 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (and (nnmail-get-value "%s-get-new-mail" method) sources) (while (setq source (pop sources)) - ;; Be compatible with old values. - (cond - ((stringp source) - (setq source - (cond - ((string-match "^po:" source) - (list 'pop :user (substring source (match-end 0)))) - ((file-directory-p source) - (list 'directory :path source)) - (t - (list 'file :path source))))) - ((eq source 'procmail) - (message "Invalid value for nnmail-spool-file: `procmail'") - nil)) + ;; Use group's parameter + (when (eq (car source) 'group) + (let ((mail-sources + (list + (gnus-group-find-parameter + (concat (symbol-name method) ":" group) + 'mail-source t)))) + (nnmail-get-new-mail-1 method exit-func temp + group group spool-func)) + (setq source nil)) ;; 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) @@ -1711,8 +1838,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; 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 @@ -1721,16 +1846,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) + (or in-group + (if (equal file orig-file) + nil + (nnmail-get-split-group orig-file ',source))) ',(intern (format "%s-active-number" method))))))) (incf total new) (incf i))) ;; If we did indeed read any incoming spools, we save all info. (if (zerop total) - (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" - method (car source)) + (when mail-source-plugged + (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" + method (car source))) (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) @@ -1745,9 +1872,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (run-hooks 'nnmail-post-get-new-mail-hook)))) (defun nnmail-expired-article-p (group time force &optional inhibit) - "Say whether an article that is TIME old in GROUP should be expired." + "Say whether an article that is TIME old in GROUP should be expired. +If TIME is nil, then return the cutoff time for oldness instead." (if force - t + (if (null time) + (current-time) + t) (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) @@ -1758,14 +1888,20 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nil) ((eq days 'immediate) ;; We expire all articles on sight. - t) + (if (null time) + (current-time) + t)) ((equal time '(0 0)) ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) (setq days (days-to-time days)) ;; Compare the time with the current time. - (ignore-errors (time-less-p days (time-since time)))))))) + (if (null time) + (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)) (defun nnmail-expiry-target-group (target group) ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears @@ -1778,7 +1914,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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))) + (let ((group-art (gnus-request-accept-article target nil t t))) (when (consp group-art) (gnus-group-mark-article-read target (cdr group-art)))))))) @@ -1788,9 +1924,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 @@ -1798,8 +1940,10 @@ 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) - (string-match (cadr regexp-target-pair) to)))) + (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) ""))))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) (string-match (cadr regexp-target-pair) @@ -1891,14 +2035,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'."