X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=b640ae818076a3fc0832789d2e2c959f96141da5;hb=0fb3ca6ec4c82ed8de7880a455c20e47e6017b3a;hp=334d37f9b4465e319960d07ec8d016c2d0b741ad;hpb=1933264aa7c81ed66395bfc323b30b9993789e91;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 334d37f9b..b640ae818 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -104,7 +104,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"))) @@ -123,6 +124,15 @@ If nil, the first match found will be used." (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. @@ -189,7 +199,7 @@ The return value should be `delete' or a group name (a string)." (function :format "%v" nnmail-) string)) -(defcustom nnmail-fancy-expiry-targets nil +(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 @@ -219,8 +229,8 @@ everything else will be expired to \"nnfolder:Archive-YYYY\"." :type '(repeat (list (choice :tag "Match against" (string :tag "Header") (const to-from)) - regexp - (string :tag "Target group format string")))) + 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. @@ -342,11 +352,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. @@ -381,8 +392,8 @@ 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) - ...other.rules.omitted...)) + '(| (\"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. @@ -478,6 +489,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*" @@ -776,8 +797,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)) @@ -809,12 +830,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 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. (when content-length (forward-line 1) (setq skip (+ (point) content-length)) @@ -993,6 +1014,10 @@ 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. + (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) @@ -1022,8 +1047,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)) @@ -1075,7 +1100,8 @@ FUNC will be called with the group name to determine the article number." (nnheader-set-temp-buffer "*Split Trace*") (gnus-add-buffer) (dolist (trace (nreverse nnmail-split-trace)) - (insert trace "\n")) + (prin1 trace (current-buffer)) + (insert "\n")) (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) @@ -1222,7 +1248,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. @@ -1261,7 +1287,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\). @@ -1291,7 +1317,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))) @@ -1446,35 +1472,28 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (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)) @@ -1576,7 +1595,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) @@ -1751,7 +1770,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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))) + (or + (message-fetch-field header) + ""))) (setq target (format-time-string (caddr regexp-target-pair) date)))))))