X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=32ead278feb4f1f6b2e52739eeb40b8443504bcd;hb=ef32609763d5fad13257dc11378c54a469b1b8d6;hp=8ced7d914921b434927b8f85bf550dba5dabea5c;hpb=f6059964525ddd9f9bbdb1da7b73034af70e07cb;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 8ced7d914..32ead278f 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 @@ -28,6 +28,7 @@ (eval-when-compile (require 'cl)) +(require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) (require 'custom) @@ -36,9 +37,8 @@ (require 'mm-util) (eval-and-compile - (autoload 'gnus-error "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util") - (autoload 'gnus-add-buffer "gnus")) + (autoload 'gnus-add-buffer "gnus") + (autoload 'gnus-kill-buffer "gnus")) (defgroup nnmail nil "Reading mail with Gnus." @@ -57,7 +57,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 @@ -77,8 +77,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 @@ -105,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"))) @@ -117,8 +117,16 @@ If nil, the first match found will be used." :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." + "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 ".*") @@ -159,10 +167,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.: @@ -190,7 +198,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 @@ -220,8 +228,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,12 +350,18 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) +(defcustom nnmail-spool-hook nil + "*A hook called when a new article is spooled." + :group 'nnmail + :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. @@ -382,8 +396,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. @@ -467,7 +481,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 @@ -479,6 +493,24 @@ 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) + +(defcustom nnmail-split-fancy-match-partial-words nil + "Whether to match partial words when fancy splitting. +Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded +by \"\\<...\\>\". If this is true, they are not implicitly surrounded by +anything." + :group 'nnmail + :type 'boolean) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -519,7 +551,7 @@ parameter. It should return nil, `warn' or `delete'." "Coding system used in reading inbox") (defvar nnmail-pathname-coding-system nil - "*Coding system for pathname.") + "*Coding system for file name.") (defun nnmail-find-file (file) "Insert FILE in server buffer safely." @@ -536,7 +568,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 @@ -703,7 +735,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 ". @@ -732,7 +764,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 ". @@ -767,7 +799,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) @@ -777,8 +811,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)) @@ -810,12 +844,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)) @@ -864,8 +898,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)) @@ -911,7 +945,7 @@ If SOURCE is a directory spec, try to return the group name component." (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. + ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) (forward-line 1)) @@ -975,10 +1009,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 @@ -987,13 +1020,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) @@ -1006,7 +1047,7 @@ 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) (progn (end-of-line) (point)))) + (delete-region (point) (gnus-point-at-eol))) (forward-line 1)) ;; Allow washing. (goto-char (point-min)) @@ -1023,8 +1064,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)) @@ -1072,16 +1113,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 @@ -1154,7 +1195,8 @@ Return the number of characters in the body." nil t) (delete-region (match-beginning 2) (match-end 0)) (beginning-of-line)) - (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) + (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" + nil t) (delete-region (match-beginning 1) (match-end 1)) (beginning-of-line))))) @@ -1203,7 +1245,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 @@ -1225,7 +1267,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. @@ -1248,6 +1290,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. @@ -1264,13 +1308,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 @@ -1294,11 +1338,11 @@ 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))) - (unless (memq sp split-result) + (unless (member sp split-result) (push sp split-result)))))) split-result)) @@ -1306,8 +1350,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (t (let* ((field (nth 0 split)) (value (nth 1 split)) - partial-front regexp - partial-rear regexp) + partial-front + partial-rear + regexp) (if (symbolp value) (setq value (cdr (assq value nnmail-split-abbrev-alist)))) (if (and (>= (length value) 2) @@ -1319,6 +1364,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (string= ".*" (substring value -2))) (setq value (substring value 0 -2) partial-rear "")) + (when nnmail-split-fancy-match-partial-words + (setq partial-front "" + partial-rear "")) (setq regexp (concat "^\\(\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) @@ -1443,51 +1491,50 @@ 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) + (run-hook-with-args 'nnmail-spool-hook + 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)) (be nil) - (res nil)) + (res nil) + (get-new-mail nil)) (while (and (null res) be-list) (setq be (car be-list)) (setq be-list (cdr be-list)) (when (and (gnus-method-option-p be 'respool) - (eval (intern (format "%s-get-new-mail" (car be))))) + (setq get-new-mail + (intern (format "%s-get-new-mail" (car be)))) + (boundp get-new-mail) + (symbol-value get-new-mail)) (setq res be))) res)) @@ -1501,17 +1548,16 @@ 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)))))))) + (buffer-substring (point) (gnus-point-at-eol))))))) ;; Function for nnmail-split-fancy: look up all references in the ;; cache and if a match is found, return that group. (defun nnmail-split-fancy-with-parent () "Split this message into the same group as its parent. This function can be used as an entry in `nnmail-split-fancy', for -example like this: (: nnmail-split-fancy) +example like this: (: nnmail-split-fancy-with-parent) For a message to be split, it looks for the parent message in the References or In-Reply-To header and then looks in the message id cache file (given by the variable `nnmail-message-id-cache-file') to @@ -1534,7 +1580,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (nnmail-cache-open)) (mapcar (lambda (x) (setq res (or (nnmail-cache-fetch-group x) res)) - (when (or (string= "drafts" res) + (when (or (member res '("delayed" "drafts" "queue")) (and regexp res (string-match regexp res))) (setq res nil))) references) @@ -1579,7 +1625,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) @@ -1731,7 +1777,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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'." @@ -1754,7 +1804,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))))))) @@ -1853,7 +1905,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." "Remove all instances of GROUP from `nnmail-split-history'." (let ((history nnmail-split-history)) (while history - (setcar history (gnus-delete-if (lambda (e) (string= (car e) group)) + (setcar history (gnus-remove-if (lambda (e) (string= (car e) group)) (car history))) (pop history)) (setq nnmail-split-history (delq nil nnmail-split-history))))