X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fnnmail.el;h=9329646441b128e24d76b567ba55d016ec8eacb2;hb=6dec94a79261794ce4ce843a2780d23a4effa334;hp=98770774eb6a44b87d0a7bbc82ef5ab3fffc79dc;hpb=5b8ecce52d86ed7352e6e5b5d768c34321a4c58d;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 98770774e..932964644 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -293,8 +293,12 @@ the following: GROUP: Mail will be stored in GROUP (a string). -\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains - VALUE (a regexp), store the messages as specified by SPLIT. +\(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, + otherwise process SPLIT. Multiple RESTRICTs add up, further + restricting the possibility of processing SPLIT. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail @@ -306,6 +310,10 @@ GROUP: Mail will be stored in GROUP (a string). the buffer containing the message headers. The return value FUNCTION should be a split, which is then recursively processed. +\(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The + return value FUNCTION should be a split, which is then recursively + processed. + 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. @@ -333,6 +341,13 @@ Example: ;; Other mailing lists... (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") + ;; Both lists below have the same suffix, so prevent + ;; cross-posting to mkpkg.list of messages posted only to + ;; the bugs- list, but allow cross-posting when the + ;; message was really cross-posted. + (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\") + (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\") + ;; ;; People... (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) ;; Unmatched mail goes to the catch all group. @@ -420,18 +435,16 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) -(defvar nnmail-file-coding-system 'binary +(defvar nnmail-file-coding-system 'raw-text "Coding system used in nnmail.") -(defvar nnmail-file-coding-system-1 - (if (string-match "nt" system-configuration) - 'raw-text-dos 'binary) - "Another coding system used in nnmail.") - (defvar nnmail-incoming-coding-system mm-text-coding-system "Coding system used in reading inbox") +(defvar nnmail-pathname-coding-system 'binary + "*Coding system for pathname.") + (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) @@ -440,19 +453,19 @@ parameter. It should return nil, `warn' or `delete'." (after-insert-file-functions nil)) (condition-case () (let ((coding-system-for-read nnmail-file-coding-system) - (auto-mode-alist (nnheader-auto-mode-alist)) - (pathname-coding-system nnmail-file-coding-system)) + (auto-mode-alist (mm-auto-mode-alist)) + (pathname-coding-system nnmail-pathname-coding-system)) (insert-file-contents file) t) (file-error nil)))) -(defvar nnmail-pathname-coding-system 'binary - "*Coding system for pathname.") - (defun nnmail-group-pathname (group dir &optional file) "Make pathname for GROUP." (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) + (setq group (nnheader-replace-duplicate-chars-in-string + (nnheader-replace-chars-in-string group ?/ ?_) + ?. ?_)) (setq group (nnheader-translate-file-chars group)) ;; If this directory exists, we use it directly. (if (or nnmail-use-long-file-names @@ -483,7 +496,7 @@ nn*-request-list should have been called before calling this function." group-assoc))) group-assoc)) -(defvar nnmail-active-file-coding-system 'binary +(defvar nnmail-active-file-coding-system 'raw-text "*Coding system for active file.") (defun nnmail-save-active (group-assoc file-name) @@ -804,8 +817,8 @@ If SOURCE is a directory spec, try to return the group name component." ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) - (forward-line 1) - (point)))) + (forward-line 1)) + (point))) ;; Find the Message-ID header. (goto-char (point-min)) (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) @@ -839,8 +852,8 @@ FUNC will be called with the buffer narrowed to each mail." ;; Insert the incoming file. (set-buffer (get-buffer-create " *nnmail incoming*")) (erase-buffer) - (let ((nnheader-file-coding-system nnmail-incoming-coding-system)) - (nnheader-insert-file-contents incoming)) + (let ((coding-system-for-read nnmail-incoming-coding-system)) + (mm-insert-file-contents incoming)) (prog1 (if (zerop (buffer-size)) 0 @@ -914,7 +927,7 @@ FUNC will be called with the group name to determine the article number." '("bogus")) (error (nnheader-message 5 - "Error in `nnmail-split-methods'; using `bogus' mail group") + "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) @@ -989,35 +1002,39 @@ Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (setq lines (count-lines (point) (point-max))) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (beginning-of-line) - (insert (format "Lines: %d\n" (max lines 0))) - chars)))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n")) + (setq chars (- (point-max) (point))) + (setq lines (count-lines (point) (point-max))) + (forward-char -1) + (save-excursion + (when (re-search-backward "^Lines: " nil t) + (delete-region (point) (progn (forward-line 1) (point))))) + (beginning-of-line) + (insert (format "Lines: %d\n" (max lines 0))) + chars))) (defun nnmail-insert-xref (group-alist) "Insert an Xref line based on the (group . article) alist." (save-excursion (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (when (re-search-backward "^Xref: " nil t) - (delete-region (match-beginning 0) - (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))) - (setq group-alist (cdr group-alist))) - (insert "\n")))) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n")) + (forward-char -1) + (when (re-search-backward "^Xref: " nil t) + (delete-region (match-beginning 0) + (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))) + (setq group-alist (cdr group-alist))) + (insert "\n"))) ;;; Message washing functions @@ -1030,11 +1047,11 @@ Return the number of characters in the body." (defun nnmail-remove-list-identifiers () "Remove list identifiers from Subject headers." (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers - (mapconcat 'identity nnmail-list-identifiers "\\|")))) + (mapconcat 'identity nnmail-list-identifiers " *\\|")))) (when regexp (goto-char (point-min)) (when (re-search-forward - (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *") + (concat "^Subject: +\\(Re: +\\)?\\(" regexp " *\\)") nil t) (delete-region (match-beginning 2) (match-end 0)))))) @@ -1111,47 +1128,72 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Check the cache for the regexp for this split. ((setq cached-pair (assq split nnmail-split-cache)) - (goto-char (point-max)) - ;; FIX FIX FIX problem with re-search-backward is that if you have - ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1") - ;; and someone mails a message with 'To: foo-bar@gnus.org' and - ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group - ;; if the cc line is a later header, even though the other choice - ;; is probably better. Also, this routine won't do a crosspost - ;; when there are two different matches. - ;; I guess you could just make this more determined, and it could - ;; look for still more matches prior to this one, and recurse - ;; on each of the multiple matches hit. Of course, then you'd - ;; want to make sure that nnmail-article-group or nnmail-split-fancy - ;; removed duplicates, since there might be more of those. - ;; I guess we could also remove duplicates in the & split case, since - ;; that's the only thing that can introduce them. - (when (re-search-backward (cdr cached-pair) nil t) - (when nnmail-split-tracing - (push (cdr cached-pair) nnmail-split-trace)) - ;; Someone might want to do a \N sub on this match, so get the - ;; correct match positions. - (goto-char (match-end 0)) - (let ((value (nth 1 split))) - (re-search-backward (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - (match-end 1))) - (nnmail-split-it (nth 2 split)))) + (let (split-result + (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)) + (when nnmail-split-tracing + (push (cdr cached-pair) 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. + (start-of-value (match-end 1)) + (after-header-name (match-end 2))) + ;; Start the next search just before the beginning of the + ;; VALUE match. + (setq end-point (1- start-of-value)) + ;; Handle - RESTRICTs + (while (eq (car split-rest) '-) + ;; RESTRICT must start after-header-name and + ;; end after start-of-value, so that, for + ;; (any "foo" - "x-foo" "foo.list") + ;; we do not exclude foo.list just because + ;; the header is: ``To: x-foo, foo'' + (goto-char end) + (if (and (re-search-backward (cadr split-rest) + after-header-name t) + (> (match-end 0) start-of-value)) + (setq split-rest nil) + (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)) + (dolist (sp (nnmail-split-it (car split-rest))) + (unless (memq sp split-result) + (push sp split-result)))))) + split-result)) ;; Not in cache, compute a regexp for the field/value pair. (t (let* ((field (nth 0 split)) (value (nth 1 split)) - (regexp (concat "^\\(\\(" + partial regexp) + (if (symbolp value) + (setq value (cdr (assq value nnmail-split-abbrev-alist)))) + (if (and (>= (length value) 2) + (string= ".*" (substring value 0 2))) + (setq value (substring value 2) + partial "")) + (setq regexp (concat "^\\(\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) field) - "\\):.*\\)\\<\\(" - (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - "\\)\\>"))) + "\\):.*\\)" + (or partial "\\<") + "\\(" + value + "\\)\\>")) (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. @@ -1351,6 +1393,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (let* ((sources (or mail-sources (if (listp nnmail-spool-file) nnmail-spool-file (list nnmail-spool-file)))) + fetching-sources (group-in group) (i 0) (new 0) @@ -1358,14 +1401,6 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." incoming incomings source) (when (and (nnmail-get-value "%s-get-new-mail" method) nnmail-spool-file) - ;; We first activate all the groups. - (nnmail-activate method) - ;; Allow the user to hook. - (run-hooks 'nnmail-pre-get-new-mail-hook) - ;; Open the message-id cache. - (nnmail-cache-open) - ;; The we go through all the existing mail source specification - ;; and fetch the mail from each. (while (setq source (pop sources)) ;; Be compatible with old values. (cond @@ -1397,23 +1432,35 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) (setq source nil) - (push source nnmail-fetched-sources))) - (when source - (nnheader-message 4 "%s: Reading incoming mail from %s..." - method (car source)) - (when (setq new - (mail-source-fetch - source - `(lambda (file orig-file) - (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func - (nnmail-get-split-group orig-file source) - ',(intern (format "%s-active-number" method)))))) - (incf total new) - (incf i)))) + (push source nnmail-fetched-sources) + (push source fetching-sources))))) + (when fetching-sources + ;; We first activate all the groups. + (nnmail-activate method) + ;; Allow the user to hook. + (run-hooks 'nnmail-pre-get-new-mail-hook) + ;; Open the message-id cache. + (nnmail-cache-open) + ;; 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 + `(lambda (file orig-file) + (nnmail-split-incoming + file ',(intern (format "%s-save-mail" method)) + ',spool-func + (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. - (unless (zerop new) + (if (zerop total) + (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)) @@ -1461,7 +1508,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." (let ((coding-system-for-write nnmail-file-coding-system) - (pathname-coding-system 'binary)) + (pathname-coding-system nnmail-pathname-coding-system)) (write-region start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes)))