X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=f56495010c495764c14d25328aec4fe9f1ce88c4;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=54b25ada39904cc6fca8446cdf2916959bca1202;hpb=7554e4249c821770633b5aea99298d92bf1e5b5d;p=elisp%2Fgnus.git- diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 54b25ad..f564950 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,5 +1,6 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -35,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." @@ -84,8 +86,8 @@ else, you could do something like this: (setq nnmail-split-methods '((\"mail.4ad\" \"From:.*4ad\") - (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") - (\"mail.misc\" \"\"))) + (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") + (\"mail.misc\" \"\"))) As you can see, this variable is a list of lists, where the first element in each \"rule\" is the name of the group (which, by the way, @@ -113,6 +115,14 @@ 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))) + ;; 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. @@ -143,7 +153,7 @@ number of days) -- this doesn't have to be an integer. This variable can also be `immediate' and `never'." :group 'nnmail-expire :type '(choice (const immediate) - (integer :tag "days") + (number :tag "days") (const never))) (defcustom nnmail-expiry-wait-function nil @@ -157,23 +167,71 @@ Eg.: \(setq nnmail-expiry-wait-function (lambda (newsgroup) - (cond ((string-match \"private\" newsgroup) 31) - ((string-match \"junk\" newsgroup) 1) + (cond ((string-match \"private\" newsgroup) 31) + ((string-match \"junk\" newsgroup) 1) ((string-match \"important\" newsgroup) 'never) (t 7))))" :group 'nnmail-expire :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) +(defcustom nnmail-expiry-target 'delete + "*Variable that says where expired messages should end up. +The default value is `delete' (which says to delete the messages), +but it can also be a string or a function. If it is a string, expired +messages end up in that group. If it is a function, the function is +called in a buffer narrowed to the message in question. The function +receives one argument, the name of the group the message comes from. +The return value should be `delete' or a group name (a string)." + :version "21.1" + :group 'nnmail-expire + :type '(choice (const delete) + (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, put Message-IDs of Gcc'd articles into the duplicate cache. +If non-nil, also update the cache when copy or move articles." :group 'nnmail :type 'boolean) (defcustom nnmail-spool-file '((file)) "*Where the mail backends will look for incoming mail. This variable is a list of mail source specifiers. -If this variable is nil, no mail backends will read incoming mail." +This variable is obsolete; `mail-sources' should be used instead." :group 'nnmail-files :type 'sexp) @@ -182,6 +240,13 @@ If this variable is nil, no mail backends will read incoming mail." :group 'nnmail-procmail :type 'boolean) +(defcustom nnmail-scan-directory-mail-source-once nil + "*If non-nil, scan all incoming procmail sorted mails once. +It scans low-level sorted spools even when not required." + :version "21.1" + :group 'nnmail-procmail + :type 'boolean) + (defcustom nnmail-delete-file-function 'delete-file "Function called to delete files in some mail backends." :group 'nnmail-files @@ -205,7 +270,7 @@ links, you could set this variable to `copy-file' instead." '(nnheader-ms-strip-cr) nil) "*Hook that will be run after the incoming mail has been transferred. -The incoming mail is moved from `nnmail-spool-file' (which normally is +The incoming mail is moved from the specified spool file (which normally is something like \"/usr/spool/mail/$user\") to the user's home directory. This hook is called after the incoming mail box has been emptied, and can be used to call any mail box programs you have @@ -214,9 +279,9 @@ running (\"xwatch\", etc.) Eg. \(add-hook 'nnmail-read-incoming-hook - (lambda () - (start-process \"mailsend\" nil - \"/local/bin/mailsend\" \"read\" \"mbox\"))) + (lambda () + (call-process \"/local/bin/mailsend\" nil nil nil + \"read\" nnmail-spool-file))) If you have xwatch running, this will alert it that mail has been read. @@ -292,8 +357,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 @@ -305,6 +374,16 @@ 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. + +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. @@ -332,6 +411,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. @@ -382,21 +468,24 @@ parameter. It should return nil, `warn' or `delete'." (defcustom nnmail-extra-headers nil "*Extra headers to parse." + :version "21.1" :group 'nnmail :type '(repeat symbol)) (defcustom nnmail-split-header-length-limit 512 "Header lines longer than this limit are excluded from the split function." + :version "21.1" :group 'nnmail :type 'integer) ;;; Internal variables. +(defvar nnmail-article-buffer " *nnmail incoming*" + "The buffer used for splitting incoming mails.") + (defvar nnmail-split-history nil "List of group/article elements that say where the previous split put messages.") -(defvar nnmail-current-spool nil) - (defvar nnmail-split-fancy-syntax-table nil "Syntax table used by `nnmail-split-fancy'.") (unless (syntax-table-p nnmail-split-fancy-syntax-table) @@ -421,75 +510,93 @@ 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 + nnheader-text-coding-system "Coding system used in reading inbox") +(defvar nnmail-pathname-coding-system nil + "*Coding system for pathname.") + (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (delete-region (point-min) (point-max)) (let ((format-alist nil) - (after-insert-file-functions nil)) + (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)) - (insert-file-contents file) + (let ((auto-mode-alist (nnheader-auto-mode-alist)) + (file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (insert-file-contents-as-coding-system + nnmail-file-coding-system 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 - (file-directory-p (concat dir group))) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) - "/"))) + (file-name-as-directory + (if (or nnmail-use-long-file-names + (file-directory-p (concat dir group))) + (expand-file-name group dir) + ;; If not, we translate dots into slashes. + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + dir)))) (or file ""))) (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) - ;; We create an alist with `(GROUP (LOW . HIGH))' elements. - (push (list (match-string 1) - (cons (string-to-int (match-string 3)) - (string-to-int (match-string 2)))) - group-assoc))) + ;; Go through all groups from the active list. + (save-excursion + (set-buffer nntp-server-buffer) + (nnmail-parse-active))) + +(defun nnmail-parse-active () + "Parse the active file in the current buffer and return an alist." + (goto-char (point-min)) + (unless (re-search-forward "[\\\"]" nil t) + (goto-char (point-max)) + (while (re-search-backward "[][';?()#]" nil t) + (insert ?\\))) + (goto-char (point-min)) + (let ((buffer (current-buffer)) + group-assoc group max min) + (while (not (eobp)) + (condition-case err + (progn + (narrow-to-region (point) (gnus-point-at-eol)) + (setq group (read buffer)) + (unless (stringp group) + (setq group (symbol-name group))) + (if (and (numberp (setq max (read buffer))) + (numberp (setq min (read buffer)))) + (push (list group (cons min max)) + group-assoc))) + (error nil)) + (widen) + (forward-line 1)) 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) "Save GROUP-ASSOC in ACTIVE-FILE." - (let ((coding-system-for-write nnmail-active-file-coding-system)) + (let ((coding-system-for-write nnmail-active-file-coding-system) + (output-coding-system nnmail-active-file-coding-system)) (when file-name (with-temp-file file-name (nnmail-generate-active group-assoc))))) @@ -499,8 +606,11 @@ nn*-request-list should have been called before calling this function." (erase-buffer) (let (group) (while (setq group (pop alist)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) - (caadr group)))))) + (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group) + (caadr group)))) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1)))) (defun nnmail-get-split-group (file source) "Find out whether this FILE is to be split into GROUP only. @@ -515,6 +625,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-process-babyl-mail-format (func artnum-func) (let ((case-fold-search t) + (count 0) start message-id content-length do-search end) (while (not (eobp)) (goto-char (point-min)) @@ -586,8 +697,10 @@ If SOURCE is a directory spec, try to return the group name component." (narrow-to-region start (point)) (goto-char (point-min)) (nnmail-check-duplication message-id func artnum-func) + (incf count) (setq end (point-max)))) - (goto-char end)))) + (goto-char end)) + count)) (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." @@ -649,14 +762,13 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-process-unix-mail-format (func artnum-func) (let ((case-fold-search t) + (count 0) start message-id content-length end skip head-end) (goto-char (point-min)) (if (not (and (re-search-forward "^From " nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? - (progn - (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool)) - (error "Error, unknown mail format! (Possibly corrupted.)")) + (error "Error, unknown mail format! (Possibly corrupted.)") ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point) @@ -729,21 +841,22 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) + (incf count) (nnmail-check-duplication message-id func artnum-func) (setq end (point-max)))) - (goto-char end))))) + (goto-char end))) + count)) (defun nnmail-process-mmdf-mail-format (func artnum-func) (let ((delim "^\^A\^A\^A\^A$") (case-fold-search t) + (count 0) start message-id end) (goto-char (point-min)) (if (not (and (re-search-forward delim nil t) (forward-line 1))) ;; Possibly wrong format? - (progn - (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool)) - (error "Error, unknown mail format! (Possibly corrupted.)")) + (error "Error, unknown mail format! (Possibly corrupted.)") ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point)) @@ -781,13 +894,15 @@ If SOURCE is a directory spec, try to return the group name component." (save-restriction (narrow-to-region start (point)) (goto-char (point-min)) + (incf count) (nnmail-check-duplication message-id func artnum-func) (setq end (point-max)))) (goto-char end) - (forward-line 2))))) + (forward-line 2))) + count)) (defun nnmail-process-maildir-mail-format (func artnum-func) -; In a maildir, every file contains exactly one mail + ;; In a maildir, every file contains exactly one mail. (let ((case-fold-search t) message-id) (goto-char (point-min)) @@ -800,15 +915,15 @@ 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) (setq message-id (match-string 1)) ;; There is no Message-ID here, so we create one. (save-excursion - (when (re-search-backward "^Message-ID[ \t]*:" nil t) + (when (re-search-backward "^Message-ID[ \t]*:" nil t) (beginning-of-line) (insert "Original-"))) (forward-line 1) @@ -817,8 +932,9 @@ If SOURCE is a directory spec, try to return the group name component." ;; Allow the backend to save the article. (widen) (save-excursion - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func)))) + (goto-char (point-min)) + (nnmail-check-duplication message-id func artnum-func)) + 1)) (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) @@ -832,28 +948,30 @@ FUNC will be called with the buffer narrowed to each mail." nnmail-split-methods))) (save-excursion ;; Insert the incoming file. - (set-buffer (get-buffer-create " *nnmail incoming*")) + (set-buffer (get-buffer-create nnmail-article-buffer)) (erase-buffer) (let ((nnheader-file-coding-system nnmail-incoming-coding-system)) (nnheader-insert-file-contents incoming)) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) - ;; Handle both babyl, MMDF and unix mail formats, since movemail will - ;; use the former when fetching from a mailbox, the latter when - ;; fetching from a file. - (cond ((or (looking-at "\^L") - (looking-at "BABYL OPTIONS:")) - (nnmail-process-babyl-mail-format func artnum-func)) - ((looking-at "\^A\^A\^A\^A") - (nnmail-process-mmdf-mail-format func artnum-func)) - ((looking-at "Return-Path:") - (nnmail-process-maildir-mail-format func artnum-func)) - (t - (nnmail-process-unix-mail-format func artnum-func)))) - (when exit-func - (funcall exit-func)) - (kill-buffer (current-buffer))))) + (prog1 + (if (zerop (buffer-size)) + 0 + (goto-char (point-min)) + (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) + ;; Handle both babyl, MMDF and unix mail formats, since + ;; movemail will use the former when fetching from a + ;; mailbox, the latter when fetching from a file. + (cond ((or (looking-at "\^L") + (looking-at "BABYL OPTIONS:")) + (nnmail-process-babyl-mail-format func artnum-func)) + ((looking-at "\^A\^A\^A\^A") + (nnmail-process-mmdf-mail-format func artnum-func)) + ((looking-at "Return-Path:") + (nnmail-process-maildir-mail-format func artnum-func)) + (t + (nnmail-process-unix-mail-format func artnum-func)))) + (when exit-func + (funcall exit-func)) + (kill-buffer (current-buffer)))))) (defun nnmail-article-group (func &optional trace) "Look at the headers and return an alist of groups that match. @@ -861,7 +979,7 @@ FUNC will be called with the group name to determine the article number." (let ((methods nnmail-split-methods) (obuf (current-buffer)) (beg (point-min)) - end group-art method regrepp) + end group-art method grp) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we @@ -907,7 +1025,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)) @@ -928,25 +1046,24 @@ FUNC will be called with the group name to determine the article number." (not group-art))) (goto-char (point-max)) (setq method (pop methods) - regrepp nil) + grp (car method)) (if (or methods (not (equal "" (nth 1 method)))) (when (and (ignore-errors (if (stringp (nth 1 method)) - (progn - (setq regrepp - (string-match "\\\\[0-9&]" (car method))) - (re-search-backward (cadr method) nil t)) + (let ((expand (string-match "\\\\[0-9&]" grp)) + (pos (re-search-backward (cadr method) + nil t))) + (and expand + (setq grp (nnmail-expand-newtext grp))) + pos) ;; Function to say whether this is a match. - (funcall (nth 1 method) (car method)))) + (funcall (nth 1 method) grp))) ;; Don't enter the article into the same ;; group twice. - (not (assoc (car method) group-art))) - (push (cons (if regrepp - (nnmail-expand-newtext (car method)) - (car method)) - (funcall func (car method))) + (not (assoc grp group-art))) + (push (cons grp (funcall func grp)) group-art)) ;; This is the final group, which is used as a ;; catch-all. @@ -983,35 +1100,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" + (encode-coding-string + (caar group-alist) + nnmail-pathname-coding-system) + (cdar group-alist))) + (setq group-alist (cdr group-alist))) + (insert "\n"))) ;;; Message washing functions @@ -1023,14 +1144,20 @@ 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 "\\|")))) + (let ((regexp + (if (consp nnmail-list-identifiers) + (mapconcat 'identity nnmail-list-identifiers " *\\|") + nnmail-list-identifiers))) (when regexp (goto-char (point-min)) - (when (re-search-forward - (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *") - nil t) - (delete-region (match-beginning 2) (match-end 0)))))) + (while (re-search-forward + (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") + nil t) + (delete-region (match-beginning 2) (match-end 0)) + (beginning-of-line)) + (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) + (delete-region (match-beginning 1) (match-end 1)) + (beginning-of-line))))) (defun nnmail-remove-tabs () "Translate TAB characters into SPACE characters." @@ -1043,13 +1170,38 @@ Return the number of characters in the body." (goto-char (point-min)) (when (re-search-forward "^References:" nil t) (beginning-of-line) - (insert "X-Gnus-Broken-Eudora-")))) + (insert "X-Gnus-Broken-Eudora-")) + (goto-char (point-min)) + (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) + (replace-match "\\1" t)))) (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-fix-eudora-headers) ;;; Utility functions +(defun nnmail-do-request-post (accept-func &optional server) + "Utility function to directly post a message to an nnmail-derived group. +Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article') +to actually put the message in the right group." + (let ((success t)) + (dolist (mbx (message-unquote-tokens + (message-tokenize-header + (message-fetch-field "Newsgroups") ", ")) success) + (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) + (or (gnus-active to-newsgroup) + (gnus-activate-group to-newsgroup) + (if (gnus-y-or-n-p (format "No such group: %s. Create it? " + to-newsgroup)) + (or (and (gnus-request-create-group + to-newsgroup gnus-command-method) + (gnus-activate-group to-newsgroup nil nil + gnus-command-method)) + (error "Couldn't create group %s" to-newsgroup))) + (error "No such group: %s" to-newsgroup)) + (unless (funcall accept-func mbx (nth 1 gnus-command-method)) + (setq success nil)))))) + (defun nnmail-split-fancy () "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation." @@ -1099,49 +1251,85 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((eq (car split) ':) (nnmail-split-it (save-excursion (eval (cdr split))))) + ;; Builtin ! operation. + ((eq (car split) '!) + (funcall (cadr split) (nnmail-split-it (caddr split)))) + ;; 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 (concat "\\<" 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-front regexp + partial-rear 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-front "")) + ;; Same trick for the rear of the regexp + (if (and (>= (length value) 2) + (string= ".*" (substring value -2))) + (setq value (substring value 0 -2) + partial-rear "")) + (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-front "\\<") + "\\(" + value + "\\)" + (or partial-rear "\\>"))) (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. @@ -1229,6 +1417,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) @@ -1257,14 +1446,100 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq nnmail-cache-buffer nil) (kill-buffer (current-buffer))))) +;; Compiler directives. +(defvar group) +(defvar group-art-list) +(defvar group-art) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) + ;; 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")))))) + +(defun nnmail-cache-primary-mail-backend () + (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) + (be nil) + (res 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 res be))) + res)) + +;; Fetch the group name corresponding to the message id stored in the +;; cache. +(defun nnmail-cache-fetch-group (id) + (when (and nnmail-treat-duplicates nnmail-cache-buffer) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) - (insert id "\n")))) + (when (search-backward id nil t) + (beginning-of-line) + (skip-chars-forward "^\n\r\t") + (unless (eolp) + (forward-char 1) + (buffer-substring (point) + (progn (end-of-line) (point)))))))) + +;; 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) +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 +see which group that message was put in. This group is returned. + +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) + (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 (or (string= "drafts" res) + (and regexp res (string-match regexp res))) + (setq res nil))) + references) + res))) (defun nnmail-cache-id-exists-p (id) (when nnmail-treat-duplicates @@ -1338,21 +1613,17 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) "Read new incoming mail." - (let* ((sources (if (listp nnmail-spool-file) nnmail-spool-file - (list nnmail-spool-file))) + (let* ((sources (or mail-sources + (if (listp nnmail-spool-file) nnmail-spool-file + (list nnmail-spool-file)))) + fetching-sources (group-in group) (i 0) - nnmail-current-spool incoming incomings source) + (new 0) + (total 0) + 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. + sources) (while (setq source (pop sources)) ;; Be compatible with old values. (cond @@ -1370,36 +1641,60 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nil)) ;; 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) - (setq source (append source - (list :predicate - `(lambda (file) - (string-match ,(regexp-quote group) - file)))))) + (mail-source-bind (directory source) + (setq source (append source + (list + :predicate + (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) - (push source nnmail-fetched-sources))) - (when source - (nnheader-message 4 "%s: Reading incoming mail from %s..." - method (car source)) - (when (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 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 + (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. - (unless (zerop i) + (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)) (when exit-func (funcall exit-func)) (run-hooks 'nnmail-read-incoming-hook) - (nnheader-message 4 "%s: Reading incoming mail...done" method)) + (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method + total)) ;; Close the message-id cache. (nnmail-cache-close) ;; Allow the user to hook. @@ -1428,6 +1723,42 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; Compare the time with the current time. (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)))) + +(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 @@ -1438,9 +1769,10 @@ 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)) - (write-region start end filename append visit lockname) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-coding-system + nnmail-file-coding-system start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes))) ;;; @@ -1508,6 +1840,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (unless nnmail-split-history (error "No current split history")) (with-output-to-temp-buffer "*nnmail split history*" + (with-current-buffer standard-output + (fundamental-mode)) ; for Emacs 20.4+ (let ((history nnmail-split-history) elem) (while (setq elem (pop history)) @@ -1536,6 +1870,16 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." his nil))) found)) +(defun nnmail-new-mail-numbers (group) + "Say how many articles has been incorporated to GROUP." + (let ((his (apply 'append nnmail-split-history)) + numbers) + (while his + (when (string= group (caar his)) + (push (cdar his) numbers)) + (setq his (cdr his))) + numbers)) + (defun nnmail-within-headers-p () "Check to see if point is within the headers of a unix mail message. Doesn't change point."