X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=54843beaded791b2929b4f85fc78be7f977993bf;hb=765340d4c018a2ca390f73df146718390e97ad7c;hp=0bc2be6f318a85561fbf47f3c657ed6484f3d6d3;hpb=babe54cf5412efcfc7159935a3fb6d766ddf21f1;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 0bc2be6f3..54843bead 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, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,8 +36,7 @@ (require 'mm-util) (eval-and-compile - (autoload 'gnus-error "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) + (autoload 'gnus-add-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -56,7 +55,7 @@ :group 'nnmail) (defgroup nnmail-split nil - "Organizing the incomming mail in folders." + "Organizing the incoming mail in folders." :group 'nnmail) (defgroup nnmail-files nil @@ -76,8 +75,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 @@ -104,7 +102,8 @@ The last element should always have \"\" as the regexp. This variable can also have a function as its value." :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) + :type '(choice (repeat :tag "Alist" (group (string :tag "Name") + (choice regexp function))) (function-item nnmail-split-fancy) (function :tag "Other"))) @@ -115,6 +114,22 @@ If nil, the first match found will be used." :group 'nnmail-split :type 'boolean) +(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." + :group 'nnmail-split + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + +(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." + :group 'nnmail-split + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil "If non-nil, nnmail will never delete/move a group's last article. @@ -150,10 +165,10 @@ can also be `immediate' and `never'." (defcustom nnmail-expiry-wait-function nil "Variable that holds function to specify how old articles should be before they are expired. - The function will be called with the name of the group that the -expiry 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'. +The function will be called with the name of the group that the expiry +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.: @@ -181,6 +196,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." @@ -301,11 +349,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. @@ -319,7 +368,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. @@ -337,6 +386,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. @@ -419,7 +474,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 @@ -431,6 +486,16 @@ 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) + +(defcustom nnmail-mail-splitting-decodes nil + "Whether the nnmail splitting functionality should MIME decode headers." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -470,8 +535,8 @@ parameter. It should return nil, `warn' or `delete'." mm-text-coding-system "Coding system used in reading inbox") -(defvar nnmail-pathname-coding-system 'iso-8859-1 - "*Coding system for pathname.") +(defvar nnmail-pathname-coding-system nil + "*Coding system for file name.") (defun nnmail-find-file (file) "Insert FILE in server buffer safely." @@ -488,7 +553,7 @@ parameter. It should return nil, `warn' or `delete'." (file-error nil)))) (defun nnmail-group-pathname (group dir &optional file) - "Make pathname for GROUP." + "Make file name for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) (setq group (nnheader-replace-duplicate-chars-in-string @@ -533,8 +598,8 @@ nn*-request-list should have been called before calling this function." (setq group (read buffer)) (unless (stringp group) (setq group (symbol-name group))) - (if (and (numberp (setq max (read nntp-server-buffer))) - (numberp (setq min (read nntp-server-buffer)))) + (if (and (numberp (setq max (read buffer))) + (numberp (setq min (read buffer)))) (push (list group (cons min max)) group-assoc))) (error nil)) @@ -655,7 +720,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 ". @@ -684,7 +749,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 ". @@ -719,7 +784,9 @@ If SOURCE is a directory spec, try to return the group name component." (if (not (and (re-search-forward "^From " nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)" + (if (buffer-file-name) "file" "buffer") + (or (buffer-file-name) (buffer-name))) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point) @@ -729,8 +796,8 @@ If SOURCE is a directory spec, try to return the group name component." start (if (search-forward "\n\n" nil t) (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. + ;; This will never happen, but just to be on the safe side -- + ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) (forward-line 1)) @@ -762,12 +829,12 @@ If SOURCE is a directory spec, try to return the group name component." (goto-char (point-max)) (widen) (setq head-end (point)) - ;; We try the Content-Length value. The idea: skip over the header - ;; separator, then check what happens content-length bytes into the - ;; message body. This should be either the end ot the buffer, the - ;; message separator or a blank line followed by the separator. - ;; The blank line should probably be deleted. If neither of the - ;; three is met, the content-length header is probably invalid. + ;; We try the Content-Length value. The idea: skip over the header + ;; separator, then check what happens content-length bytes into the + ;; message body. This should be either the end of the buffer, the + ;; message separator or a blank line followed by the separator. + ;; The blank line should probably be deleted. If neither of the + ;; three is met, the content-length header is probably invalid. (when content-length (forward-line 1) (setq skip (+ (point) content-length)) @@ -927,10 +994,9 @@ 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) + group-art method grp) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we @@ -939,13 +1005,21 @@ FUNC will be called with the group name to determine the article number." (list (cons (caar methods) (funcall func (caar methods))))) ;; We do actual comparison. (save-excursion - ;; Find headers. - (goto-char beg) - (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) + ;; Copy the article into the work buffer. (set-buffer nntp-server-buffer) (erase-buffer) - ;; Copy the headers into the work buffer. - (insert-buffer-substring obuf beg end) + (insert-buffer-substring obuf) + ;; Narrow to headers. + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (point) + (point-max))) + (goto-char (point-min)) + ;; Decode MIME headers and charsets. + (when nnmail-mail-splitting-decodes + (let ((mail-parse-charset nnmail-mail-splitting-charset)) + (mail-decode-encoded-word-region (point-min) (point-max)))) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -975,8 +1049,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)) @@ -1024,16 +1098,16 @@ 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))) + (widen) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil @@ -1155,7 +1229,7 @@ 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 documentation." +See the documentation for the variable `nnmail-split-fancy' for details." (let ((syntab (syntax-table))) (unwind-protect (progn @@ -1177,7 +1251,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. @@ -1200,6 +1274,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Builtin : operation. ((eq (car split) ':) + (when nnmail-split-tracing + (push split nnmail-split-trace)) (nnmail-split-it (save-excursion (eval (cdr split))))) ;; Builtin ! operation. @@ -1216,13 +1292,13 @@ 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, - ;; start-of-value is the the point just before the - ;; beginning of the value, whereas after-header-name is - ;; the point just after the field name. + ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). + ;; So, start-of-value is the point just before the + ;; beginning of the value, whereas after-header-name + ;; is the point just after the field name. (start-of-value (match-end 1)) (after-header-name (match-end 2))) ;; Start the next search just before the beginning of the @@ -1246,7 +1322,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (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 + ;; Someone might want to do a \N sub on this match, so get the ;; correct match positions. (re-search-backward value start-of-value)) (dolist (sp (nnmail-split-it (car split-rest))) @@ -1368,6 +1444,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) @@ -1394,41 +1471,34 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) - (kill-buffer (current-buffer))))) + (gnus-kill-buffer (current-buffer))))) ;; Compiler directives. (defvar group) (defvar group-art-list) (defvar group-art) -(defun nnmail-cache-insert (id) +(defun nnmail-cache-insert (id grp) (when nnmail-treat-duplicates ;; Store some information about the group this message is written - ;; to. This function might have been called from various places. - ;; Sometimes, a function up in the calling sequence has an - ;; argument GROUP which is bound to a string, the group name. At - ;; other times, there is a function up in the calling sequence - ;; which has an argument GROUP-ART which is a list of pairs, and - ;; the car of a pair is a group name. Should we check that the - ;; length of the list is equal to 1? -- kai - (let ((g nil)) - (cond ((and (boundp 'group) group) - (setq g group)) - ((and (boundp 'group-art-list) group-art-list - (listp group-art-list)) - (setq g (caar group-art-list))) - ((and (boundp 'group-art) group-art (listp group-art)) - (setq g (caar group-art))) - (t (setq g ""))) - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (if (and g (not (string= "" g)) - (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend))) - (insert id "\t" g "\n") - (insert id "\n")))))) + ;; to. This is passed in as the grp argument -- all locations this + ;; has been called from have been checked and the group is available. + ;; The only ambiguous case is nnmail-check-duplication which will only + ;; 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) + (goto-char (point-max)) + (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)) + (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)) @@ -1452,7 +1522,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (when (search-backward id nil t) (beginning-of-line) (skip-chars-forward "^\n\r\t") - (unless (eolp) + (unless (looking-at "[\r\n]") (forward-char 1) (buffer-substring (point) (progn (end-of-line) (point)))))))) @@ -1472,14 +1542,21 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (let* ((refstr (or (message-fetch-field "references") (message-fetch-field "in-reply-to"))) (references nil) - (res nil)) + (res nil) + (regexp (if (consp 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))) (unless (gnus-buffer-live-p nnmail-cache-buffer) (nnmail-cache-open)) (mapcar (lambda (x) (setq res (or (nnmail-cache-fetch-group x) res)) - (when (string= "drafts" res) + (when (or (member res '("delayed" "drafts" "queue")) + (and regexp res (string-match regexp res))) (setq res nil))) references) res))) @@ -1523,7 +1600,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ((not duplication) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))) - (nnmail-cache-insert message-id)) + (nnmail-cache-insert message-id (caar group-art))) ((eq action 'delete) (setq group-art nil)) ((eq action 'warn) @@ -1582,7 +1659,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ((eq source 'procmail) (message "Invalid value for nnmail-spool-file: `procmail'") nil)) - ;; Hack to only fetch the contents of a single group's spool file. + ;; 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) group) @@ -1590,10 +1667,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (setq source (append source (list :predicate - `(lambda (file) - (string-equal - ,(concat group suffix) - (file-name-nondirectory file)))))))) + (gnus-byte-compile + `(lambda (file) + (string-equal + ,(concat group suffix) + (file-name-nondirectory file))))))))) (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) (setq source nil) @@ -1614,14 +1692,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (setq new (mail-source-fetch source - `(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)))))) + (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))))))) (incf total new) (incf i))) ;; If we did indeed read any incoming spools, we save all info. @@ -1665,13 +1744,46 @@ 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. (when (nnheader-functionp target) (setq target (funcall target group))) (unless (eq target 'delete) - (gnus-request-accept-article target nil nil t)))) + (when (or (gnus-request-group target) + (gnus-request-create-group target)) + (let ((group-art (gnus-request-accept-article target nil nil t))) + (when (consp group-art) + (gnus-group-mark-article-read target (cdr group-art)))))))) + +(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) + (or + (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."