X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnmail.el;h=731d85b53caba859dadbec11d849406e7a67f5cc;hp=d653b82172d2bcfc7f306e13d5e9de0f8e8cca91;hb=2a6100b64dea45b4a72f4443f8fd49db523f35ce;hpb=0aefeda33decb8bdac60ae9a120452a87b68fccc diff --git a/lisp/nnmail.el b/lisp/nnmail.el index d653b8217..681116017 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,16 +1,16 @@ ;;; 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-2015 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,9 +18,7 @@ ;; 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: @@ -34,10 +32,11 @@ (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") +(autoload 'mail-send-and-exit "sendmail" nil t) (defgroup nnmail nil "Reading mail with Gnus." @@ -48,7 +47,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 @@ -101,7 +100,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))) @@ -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 ".*") @@ -171,7 +174,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) @@ -194,7 +197,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 @@ -214,15 +217,16 @@ will try to match against both the From and the To header. Example: \(setq nnmail-fancy-expiry-targets - '((to-from \"boss\" \"nnfolder:Work\") + \\='((to-from \"boss\" \"nnfolder:Work\") (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\") (\"from\" \".*\" \"nnfolder:Archive-%Y\"))) 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") @@ -236,12 +240,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." @@ -261,7 +263,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. @@ -284,23 +286,26 @@ 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 +\(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. If you use `display-time', you could use something like this: -\(add-hook 'nnmail-read-incoming-hook +\(add-hook \\='nnmail-read-incoming-hook (lambda () ;; Update the displayed time, since that will clear out ;; the flag that says you have mail. - (when (eq (process-status \"display-time\") 'run) + (when (eq (process-status \"display-time\") \\='run) (display-time-filter display-time-process \"\"))))" :group 'nnmail-prepare :type 'hook) @@ -351,6 +356,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,16 +369,16 @@ 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 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 +410,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 +418,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" @@ -459,7 +465,7 @@ GROUP: Mail will be stored in GROUP (a string). junk: Mail will be deleted. Use with care! Do not submerge in water! Example: (setq nnmail-split-fancy - '(| (\"Subject\" \"MAKE MONEY FAST\" junk) + \\='(| (\"Subject\" \"MAKE MONEY FAST\" junk) ...other.rules.omitted...)) FIELD must match a complete field name. VALUE must match a complete @@ -474,12 +480,12 @@ GROUP can contain \\& and \\N which will substitute from matching Example: -\(setq nnmail-split-methods 'nnmail-split-fancy +\(setq nnmail-split-methods \\='nnmail-split-fancy nnmail-split-fancy ;; Messages from the mailer daemon are not crossposted to any of ;; the ordinary groups. Warnings are put in a separate group ;; from real errors. - '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") + \\='(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") \"mail.misc\")) ;; Non-error messages are crossposted to all relevant ;; groups, but we don't crosspost between the group for the @@ -522,8 +528,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) @@ -543,13 +550,15 @@ 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)) -(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,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) @@ -594,6 +614,7 @@ by anything." (defvar nnmail-split-tracing nil) (defvar nnmail-split-trace nil) +(defvar nnmail-inhibit-default-split-group nil) @@ -607,7 +628,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) @@ -639,9 +667,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 ""))) @@ -649,8 +675,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 () @@ -672,7 +697,7 @@ nn*-request-list should have been called before calling this function." (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) @@ -687,6 +712,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) @@ -753,7 +779,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)))) @@ -890,7 +916,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. @@ -937,7 +963,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) @@ -985,7 +1011,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))) @@ -1026,22 +1052,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 @@ -1054,7 +1087,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 @@ -1063,22 +1097,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. @@ -1111,27 +1145,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 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)) + (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 @@ -1164,12 +1213,15 @@ 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) + (or (equal "" (nth 1 method)) + (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) @@ -1226,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"))) @@ -1264,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) @@ -1276,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 dont-sub-check)) + (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') @@ -1324,7 +1392,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) @@ -1357,12 +1425,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)) @@ -1391,12 +1461,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)))))) @@ -1404,11 +1471,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) @@ -1420,7 +1488,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 "^\\(\\(" @@ -1435,10 +1509,10 @@ 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) +(defun nnmail-expand-newtext (newtext &optional fancyp) (let ((len (length newtext)) (pos 0) c expanded beg N did-expand) @@ -1463,8 +1537,15 @@ 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 (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 @@ -1516,10 +1597,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)) @@ -1531,8 +1611,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) @@ -1549,15 +1628,11 @@ 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 (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 @@ -1567,21 +1642,19 @@ 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))) + (if (and grp (not (string= "" grp)) + (gnus-methods-equal-p gnus-command-method + (nnmail-cache-primary-mail-backend))) (let ((regexp (if (consp nnmail-cache-ignore-groups) (mapconcat 'identity nnmail-cache-ignore-groups "\\|") nnmail-cache-ignore-groups))) (unless (and regexp (string-match regexp grp)) - (if (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend)) - (insert id "\t" grp "\n") - (insert id "\n")))) + (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) @@ -1602,8 +1675,7 @@ 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) @@ -1638,18 +1710,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)))) @@ -1659,7 +1729,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)) @@ -1684,7 +1755,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)) @@ -1716,34 +1788,31 @@ 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) - incoming incomings source) + source) (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) @@ -1772,26 +1841,31 @@ 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 - (gnus-byte-compile - `(lambda (file orig-file) - (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)) - ',(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. (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)) @@ -1806,9 +1880,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))) @@ -1819,14 +1896,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 @@ -1837,10 +1920,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (functionp target) (setq target (funcall target group))) (unless (eq target 'delete) - (when (or (gnus-request-group target) + (when (or (gnus-request-group target nil nil (gnus-get-info 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) @@ -1849,9 +1933,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 @@ -1859,8 +1949,14 @@ 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* ((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) @@ -1952,14 +2048,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'."