X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=dd1d67fe2da2ee66a33c152cf1976990b5e3c3d4;hb=7064878d80c116f154853a32b3851403815b054b;hp=9a6af6659036713827b5cc1c076c5fc0960d6c91;hpb=ae34184b2e852b0eaaee93b526e21ae07defafd7;p=elisp%2Fgnus.git- diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 9a6af66..dd1d67f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,7 +36,8 @@ (eval-and-compile (autoload 'gnus-error "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) + (autoload 'gnus-buffer-live-p "gnus-util") + (autoload 'gnus-add-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -75,8 +76,7 @@ "Various mail options." :group 'nnmail) -(defcustom nnmail-split-methods - '(("mail.misc" "")) +(defcustom nnmail-split-methods '(("mail.misc" "")) "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the @@ -188,6 +188,39 @@ The return value should be `delete' or a group name (a string)." (function :format "%v" nnmail-) string)) +(defcustom nnmail-fancy-expiry-targets nil + "Determine expiry target based on articles using fancy techniques. + +This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If +`nnmail-expiry-target' is set to the function +`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP, +the message will be expired to a group determined by invoking +`format-time-string' with TARGET used as the format string and the +time extracted from the articles' Date header (if missing the current +time is used). + +In the special cases that HEADER is the symbol `to-from', the regexp +will try to match against both the From and the To header. + +Example: + +\(setq nnmail-fancy-expiry-targets + '((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 +be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and +everything else will be expired to \"nnfolder:Archive-YYYY\"." + :group 'nnmail-expire + :type '(repeat (list (choice :tag "Match against" + (string :tag "Header") + (const to-from)) + regexp + (string :tag "Target group format string")))) + (defcustom nnmail-cache-accepted-message-ids nil "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache. If non-nil, also update the cache when copy or move articles." @@ -308,11 +341,12 @@ discarded after running the split process." :type 'hook) (defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. + "*The number of the articles which indicates a large newsgroup or nil. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status." :group 'nnmail-various - :type 'integer) + :type '(choice (const :tag "infinite" nil) + (number :tag "count"))) (defcustom nnmail-split-fancy "mail.misc" "Incoming mail can be split according to this fancy variable. @@ -326,7 +360,7 @@ GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. If RESTRICT (a regexp) matches some string - after FIELD and before the end of the matched VALUE, return NIL, + after FIELD and before the end of the matched VALUE, return nil, otherwise process SPLIT. Multiple RESTRICTs add up, further restricting the possibility of processing SPLIT. @@ -344,6 +378,12 @@ GROUP: Mail will be stored in GROUP (a string). return value FUNCTION should be a split, which is then recursively processed. +junk: Mail will be deleted. Use with care! Do not submerge in water! + Example: + (setq nnmail-split-fancy + '(| (\"Subject\" \"MAKE MONEY FAST\" junk) + ...other.rules.omitted...)) + 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. @@ -426,7 +466,7 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) -(defcustom nnmail-extra-headers nil +(defcustom nnmail-extra-headers '(To Newsgroups) "*Extra headers to parse." :version "21.1" :group 'nnmail @@ -438,6 +478,11 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type 'integer) +(defcustom nnmail-mail-splitting-charset nil + "Default charset to be used when splitting incoming mail." + :group 'nnmail + :type 'symbol) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -477,7 +522,7 @@ parameter. It should return nil, `warn' or `delete'." nnheader-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system 'binary +(defvar nnmail-pathname-coding-system nil "*Coding system for pathname.") (defun nnmail-find-file (file) @@ -664,7 +709,7 @@ If SOURCE is a directory spec, try to return the group name component." (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -693,7 +738,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-search-unix-mail-delim-backward () "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the the next article in the + ;; Algorithm used to find the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -936,7 +981,7 @@ FUNC will be called with the buffer narrowed to each mail." (defun nnmail-article-group (func &optional trace) "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 nnmail-split-methods) + (let ((methods (or nnmail-split-methods '(("bogus" "")))) (obuf (current-buffer)) (beg (point-min)) end group-art method grp) @@ -955,6 +1000,9 @@ FUNC will be called with the group name to determine the article number." (erase-buffer) ;; Copy the headers into the work buffer. (insert-buffer-substring obuf beg end) + ;; Decode MIME headers and charsets. + (mime-decode-header-in-region (point-min) (point-max) + nnmail-mail-splitting-charset) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -984,8 +1032,8 @@ FUNC will be called with the group name to determine the article number." (or (funcall nnmail-split-methods) '("bogus")) (error - (nnheader-message 5 - "Error in `nnmail-split-methods'; using `bogus' mail group") + (nnheader-message + 5 "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) @@ -1033,13 +1081,12 @@ FUNC will be called with the group name to determine the article number." (funcall func (car method))))))))) ;; Produce a trace if non-empty. (when (and trace nnmail-split-trace) - (let ((trace (nreverse nnmail-split-trace)) - (restore (current-buffer))) + (let ((restore (current-buffer))) (nnheader-set-temp-buffer "*Split Trace*") (gnus-add-buffer) - (while trace - (insert (car trace) "\n") - (setq trace (cdr trace))) + (dolist (trace (nreverse nnmail-split-trace)) + (prin1 trace (current-buffer)) + (insert "\n")) (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) @@ -1186,7 +1233,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; A group name. Do the \& and \N subs into the string. ((stringp split) (when nnmail-split-tracing - (push (format "\"%s\"" split) nnmail-split-trace)) + (push split nnmail-split-trace)) (list (nnmail-expand-newtext split))) ;; Junk the message. @@ -1225,7 +1272,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (while (and (goto-char end-point) (re-search-backward (cdr cached-pair) nil t)) (when nnmail-split-tracing - (push (cdr cached-pair) nnmail-split-trace)) + (push split nnmail-split-trace)) (let ((split-rest (cddr split)) (end (match-end 0)) ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So, @@ -1377,6 +1424,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (set-buffer (setq nnmail-cache-buffer (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)) (set-buffer-modified-p nil) @@ -1483,7 +1531,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (references nil) (res nil) (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups) - (mapconcat 'nnmail-split-fancy-with-parent-ignore-groups " *\\|") + (mapconcat + (lambda (x) (format "\\(%s\\)" x)) + nnmail-split-fancy-with-parent-ignore-groups + "\\|") nnmail-split-fancy-with-parent-ignore-groups))) (when refstr (setq references (nreverse (gnus-split-references refstr))) @@ -1492,7 +1543,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (mapcar (lambda (x) (setq res (or (nnmail-cache-fetch-group x) res)) (when (or (string= "drafts" res) - (and regexp (string-match regexp res))) + (and regexp res (string-match regexp res))) (setq res nil))) references) res))) @@ -1680,6 +1731,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (ignore-errors (time-less-p days (time-since time)))))))) (defun nnmail-expiry-target-group (target group) + ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears + ;; that buffer if the nnfolder group isn't selected. (let (nnmail-cache-accepted-message-ids) ;; Don't enter Message-IDs into cache. ;; Let users hack it in TARGET function. @@ -1688,6 +1741,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (unless (eq target 'delete) (gnus-request-accept-article target nil nil t)))) +(defun nnmail-fancy-expiry-target (group) + "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'." + (let* (header + (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)))) + (target 'delete)) + (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target) + (setq header (car regexp-target-pair)) + (cond + ;; If the header is to-from then match against the + ;; 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)))) + (setq target (format-time-string (caddr regexp-target-pair) date))) + ((and (not (equal header 'to-from)) + (string-match (cadr regexp-target-pair) + (message-fetch-field header))) + (setq target + (format-time-string (caddr regexp-target-pair) date))))))) + (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." (save-restriction