X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=a03c1955e59f32c0a95202ccd11065a1416fcc1d;hb=9954729d205c97242f0787c79dc23e7b051a6201;hp=8d13ab9da643541a029b5e216fda7581338af8a8;hpb=a33f199e3b1def6e577f7f169657edabe2dac351;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 8d13ab9da..a03c1955e 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,7 +1,7 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -25,11 +25,18 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'nnheader) (require 'timezone) (require 'message) -(eval-when-compile (require 'cl)) (require 'custom) +(require 'gnus-util) + +(eval-and-compile + (autoload 'gnus-error "gnus-util") + (autoload 'gnus-buffer-live-p "gnus-util") + (autoload 'gnus-encode-coding-string "gnus-ems")) (defgroup nnmail nil "Reading mail with Gnus." @@ -70,7 +77,7 @@ (defcustom nnmail-split-methods '(("mail.misc" "")) - "Incoming mail will be split according to this variable. + "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the \"4ad-l\" mailing list, one group for junk mail and one for everything @@ -109,7 +116,9 @@ If nil, the first match found will be used." ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil - "If non-nil, nnmail will never delete the last expired article in a directory. + "If non-nil, nnmail will never delete/move a group's last article. +It can be marked expirable, so it will be deleted when it is no longer last. + You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired." :group 'nnmail-procmail @@ -157,10 +166,15 @@ Eg.: :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) -(defcustom nnmail-spool-file +(defcustom nnmail-cache-accepted-message-ids nil + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." + :group 'nnmail + :type 'boolean) + +(defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) - "Where the mail backends will look for incoming mail. + "*Where the mail backends will look for incoming mail. This variable is \"/usr/spool/mail/$user\" by default. If this variable is nil, no mail backends will read incoming mail. If this variable is a list, all files mentioned in this list will be @@ -204,8 +218,11 @@ several files - eg. \".spool[0-9]*\"." :group 'nnmail-files :type 'function) -(defcustom nnmail-crosspost-link-function 'add-name-to-file - "Function called to create a copy of a file. +(defcustom nnmail-crosspost-link-function + (if (string-match "windows-nt\\|emx" (symbol-name system-type)) + 'copy-file + 'add-name-to-file) + "*Function called to create a copy of a file. This is `add-name-to-file' by default, which means that crossposts will use hard links. If your file system doesn't allow hard links, you could set this variable to `copy-file' instead." @@ -230,11 +247,11 @@ to be moved to." :group 'nnmail-retrieve :type 'boolean) -(defcustom nnmail-read-incoming-hook +(defcustom nnmail-read-incoming-hook (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) - "Hook that will be run after the incoming mail has been transferred. + "*Hook that will be run after the incoming mail has been transferred. The incoming mail is moved from `nnmail-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 @@ -243,13 +260,13 @@ running (\"xwatch\", etc.) Eg. -\(add-hook 'nnmail-read-incoming-hook +\(add-hook 'nnmail-read-incoming-hook (lambda () - (start-process \"mailsend\" nil + (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\"))) If you have xwatch running, this will alert it that mail has been -read. +read. If you use `display-time', you could use something like this: @@ -286,8 +303,8 @@ that) from the headers before splitting and saving the messages." This can also be a list of regexps." :group 'nnmail-prepare :type '(choice (const :tag "none" nil) - regexp - (repeat regexp))) + (regexp :value ".*") + (repeat :value (".*") regexp))) (defcustom nnmail-pre-get-new-mail-hook nil "Hook called just before starting to handle new incoming mail." @@ -327,17 +344,17 @@ messages will be shown to indicate the current status." "Incoming mail can be split according to this fancy variable. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. -The format is this variable is SPLIT, where SPLIT can be one of +The format of this variable is SPLIT, where SPLIT can be one of the following: -GROUP: Mail will be stored in GROUP (a string). +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. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail - message to be stored in one or more groups. + message to be stored in one or more groups. \(& SPLIT...): Process each SPLIT expression. @@ -347,7 +364,7 @@ GROUP: Mail will be stored in GROUP (a string). 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. +You can use \".*\" in the regexps to match partial field names or words. FIELD and VALUE can also be lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. @@ -382,8 +399,12 @@ Example: (defcustom nnmail-split-abbrev-alist '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") - (mail . "mailer-daemon\\|postmaster\\|uucp")) - "Alist of abbreviations allowed in `nnmail-split-fancy'." + (mail . "mailer-daemon\\|postmaster\\|uucp") + (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc") + (from . "from\\|sender\\|resent-from") + (nato . "to\\|cc\\|resent-to\\|resent-cc") + (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) + "*Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) @@ -427,6 +448,8 @@ parameter. It should return nil, `warn' or `delete'." (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-pop-password nil "*Password to use when reading mail from a POP server, if required.") @@ -446,6 +469,9 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-internal-password nil) +(defvar nnmail-split-tracing nil) +(defvar nnmail-split-trace nil) + (defconst nnmail-version "nnmail 1.0" @@ -456,6 +482,9 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-request-post (&optional server) (mail-send-and-exit nil)) +(defvar nnmail-file-coding-system 'raw-text + "Coding system used in nnmail.") + (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) @@ -463,19 +492,31 @@ parameter. It should return nil, `warn' or `delete'." (let ((format-alist nil) (after-insert-file-functions nil)) (condition-case () - (progn (insert-file-contents file) t) + (let ((coding-system-for-read nnmail-file-coding-system) + (pathname-coding-system 'binary)) + (insert-file-contents file) + t) (file-error nil)))) +(defvar nnmail-pathname-coding-system + 'iso-8859-1 + "*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-translate-file-chars group)) ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names + (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 (nnheader-replace-chars-in-string group ?. ?/) "/"))) + (concat dir + (gnus-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + "/"))) (or file ""))) (defun nnmail-date-to-time (date) @@ -504,7 +545,7 @@ parameter. It should return nil, `warn' or `delete'." "Convert DAYS into time." (let* ((seconds (* 1.0 days 60 60 24)) (rest (expt 2 16)) - (ms (condition-case nil (round (/ seconds rest)) + (ms (condition-case nil (floor (/ seconds rest)) (range-error (expt 2 16))))) (list ms (condition-case nil (round (- seconds (* ms rest))) (range-error (expt 2 16)))))) @@ -524,18 +565,17 @@ parameter. It should return nil, `warn' or `delete'." (defun nnmail-move-inbox (inbox) "Move INBOX to `nnmail-crash-box'." (if (not (file-writable-p nnmail-crash-box)) - (gnus-error 1 "Can't write to crash box %s. Not moving mail." + (gnus-error 1 "Can't write to crash box %s. Not moving mail" nnmail-crash-box) ;; If the crash box exists and is empty, we delete it. (when (and (file-exists-p nnmail-crash-box) (zerop (nnheader-file-size (file-truename nnmail-crash-box)))) (delete-file nnmail-crash-box)) - (let ((inbox (file-truename (expand-file-name inbox))) - (tofile (file-truename (expand-file-name nnmail-crash-box))) - movemail popmail errors) - (if (setq popmail (string-match - "^po:" (file-name-nondirectory inbox))) - (setq inbox (file-name-nondirectory inbox)) + (let ((tofile (file-truename (expand-file-name nnmail-crash-box))) + (popmail (string-match "^po:" inbox)) + movemail errors result) + (unless popmail + (setq inbox (file-truename (expand-file-name inbox))) (setq movemail t) ;; On some systems, /usr/spool/mail/foo is a directory ;; and the actual inbox is /usr/spool/mail/foo/foo. @@ -555,15 +595,15 @@ parameter. It should return nil, `warn' or `delete'." (nnmail-read-passwd (format "Password for %s: " (substring inbox (+ popmail 3)))))) - (message "Getting mail from post office ...")) + (nnheader-message 5 "Getting mail from the post office...")) (when (or (and (file-exists-p tofile) (/= 0 (nnheader-file-size tofile))) (and (file-exists-p inbox) (/= 0 (nnheader-file-size inbox)))) - (message "Getting mail from %s..." inbox))) + (nnheader-message 5 "Getting mail from %s..." inbox))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file INBOX to TOFILE if and as appropriate. - (cond + (cond ((file-exists-p tofile) ;; The crash box exists already. t) @@ -579,25 +619,35 @@ parameter. It should return nil, `warn' or `delete'." (save-excursion (setq errors (generate-new-buffer " *nnmail loss*")) (buffer-disable-undo errors) - (let ((default-directory "/")) - (if (nnheader-functionp nnmail-movemail-program) - (funcall nnmail-movemail-program inbox tofile) - (apply - 'call-process - (append - (list - (expand-file-name - nnmail-movemail-program exec-directory) - nil errors nil inbox tofile) - (when nnmail-internal-password - (list nnmail-internal-password)))))) - (if (not (buffer-modified-p errors)) + (if (nnheader-functionp nnmail-movemail-program) + (condition-case err + (progn + (funcall nnmail-movemail-program inbox tofile) + (setq result 0)) + (error + (save-excursion + (set-buffer errors) + (insert (prin1-to-string err)) + (setq result 255)))) + (let ((default-directory "/")) + (setq result + (apply + 'call-process + (append + (list + (expand-file-name + nnmail-movemail-program exec-directory) + nil errors nil inbox tofile) + (when nnmail-internal-password + (list nnmail-internal-password))))))) + (push inbox nnmail-moved-inboxes) + (if (and (not (buffer-modified-p errors)) + (zerop result)) ;; No output => movemail won (progn (unless popmail (when (file-exists-p tofile) - (set-file-modes tofile nnmail-default-file-modes))) - (push inbox nnmail-moved-inboxes)) + (set-file-modes tofile nnmail-default-file-modes)))) (set-buffer errors) ;; There may be a warning about older revisions. We ;; ignore those. @@ -606,9 +656,12 @@ parameter. It should return nil, `warn' or `delete'." (progn (unless popmail (when (file-exists-p tofile) - (set-file-modes tofile nnmail-default-file-modes))) - (push inbox nnmail-moved-inboxes)) + (set-file-modes + tofile nnmail-default-file-modes)))) ;; Probably a real error. + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq nnmail-internal-password nil) (subst-char-in-region (point-min) (point-max) ?\n ?\ ) (goto-char (point-max)) (skip-chars-backward " \t") @@ -617,11 +670,11 @@ parameter. It should return nil, `warn' or `delete'." (when (looking-at "movemail: ") (delete-region (point-min) (match-end 0))) (unless (yes-or-no-p - (format "movemail: %s. Continue? " - (buffer-string))) + (format "movemail: %s (%d return). Continue? " + (buffer-string) result)) (error "%s" (buffer-string))) (setq tofile nil))))))) - (message "Getting mail from %s...done" inbox) + (nnheader-message 5 "Getting mail from %s...done" inbox) (and errors (buffer-name errors) (kill-buffer errors)) @@ -635,7 +688,7 @@ nn*-request-list should have been called before calling this function." (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward + (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) @@ -644,11 +697,15 @@ nn*-request-list should have been called before calling this function." group-assoc))) group-assoc)) +(defvar nnmail-active-file-coding-system 'binary + "*Coding system for active file.") + (defun nnmail-save-active (group-assoc file-name) "Save GROUP-ASSOC in ACTIVE-FILE." - (when file-name - (nnheader-temp-write file-name - (nnmail-generate-active group-assoc)))) + (let ((coding-system-for-write nnmail-active-file-coding-system)) + (when file-name + (nnheader-temp-write file-name + (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) "Generate an active file from group-alist ALIST." @@ -666,15 +723,17 @@ return nil if FILE is a spool file or the procmail group for which it is a spool. If not using procmail, return GROUP." (if (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) - (if (string-match (concat "^" (expand-file-name - (file-name-as-directory - nnmail-procmail-directory)) - "\\([^/]*\\)" nnmail-procmail-suffix "$") + (if (string-match (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory + nnmail-procmail-directory))) + "\\([^/]*\\)" + nnmail-procmail-suffix "$") (expand-file-name file)) (let ((procmail-group (substring (expand-file-name file) (match-beginning 1) (match-end 1)))) - (if group + (if group (if (string-equal group procmail-group) group nil) @@ -685,8 +744,8 @@ is a spool. If not using procmail, return GROUP." (defun nnmail-process-babyl-mail-format (func artnum-func) (let ((case-fold-search t) start message-id content-length do-search end) - (goto-char (point-min)) (while (not (eobp)) + (goto-char (point-min)) (re-search-forward " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) (goto-char (match-end 0)) @@ -707,12 +766,13 @@ is a spool. If not using procmail, return GROUP." (goto-char (point-max)) ;; Find the Message-ID header. (save-excursion - (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) + (if (re-search-backward + "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t) (setq message-id (buffer-substring (match-beginning 1) (match-end 1))) ;; There is no Message-ID here, so we create one. (save-excursion - (when (re-search-backward "^Message-ID:" nil t) + (when (re-search-backward "^Message-ID[ \t]*:" nil t) (beginning-of-line) (insert "Original-"))) (forward-line -1) @@ -720,10 +780,10 @@ is a spool. If not using procmail, return GROUP." "\n"))) ;; Look for a Content-Length header. (if (not (save-excursion - (and (re-search-backward + (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) (setq content-length (string-to-int - (buffer-substring + (buffer-substring (match-beginning 1) (match-end 1)))) ;; We destroy the header, since none of @@ -743,7 +803,7 @@ is a spool. If not using procmail, return GROUP." (setq do-search t))) (widen) ;; Go to the beginning of the next article - or to the end - ;; of the buffer. + ;; of the buffer. (when do-search (if (re-search-forward "^" nil t) (goto-char (match-beginning 0)) @@ -757,7 +817,7 @@ is a spool. If not using procmail, return GROUP." (setq end (point-max)))) (goto-char end)))) -(defun nnmail-search-unix-mail-delim () +(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 ;; brain-dead Unix mbox format: @@ -779,9 +839,9 @@ is a spool. If not using procmail, return GROUP." (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) - (looking-at "[^ \t:]+[ \t]*:"))) + (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) (beginning-of-line) (eq found 'yes))) @@ -808,9 +868,9 @@ is a spool. If not using procmail, return GROUP." (= (following-char) ?\n))) (save-excursion (forward-line 1) - (while (looking-at ">From ") + (while (looking-at ">From \\|From ") (forward-line 1)) - (looking-at "[^ \t:]+[ \t]*:"))) + (looking-at "[^ \n\t:]+[ \n\t]*:"))) (setq found 'yes))))) (beginning-of-line) (eq found 'yes))) @@ -822,28 +882,30 @@ is a spool. If not using procmail, return GROUP." (if (not (and (re-search-forward "^From " nil t) (goto-char (match-beginning 0)))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (progn + (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool)) + (error "Error, unknown mail format! (Possibly corrupted.)")) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point) end nil) ;; Find the end of the head. (narrow-to-region - start + 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. (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) + (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) (setq message-id (match-string 1)) (save-excursion - (when (re-search-forward "^Message-ID:" nil t) + (when (re-search-forward "^Message-ID[ \t]*:" nil t) (beginning-of-line) (insert "Original-"))) ;; There is no Message-ID here, so we create one. @@ -855,7 +917,7 @@ is a spool. If not using procmail, return GROUP." "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) (setq content-length (string-to-int (match-string 1))) - ;; We destroy the header, since none of the backends ever + ;; We destroy the header, since none of the backends ever ;; use it, and we do not want to confuse other mailers by ;; having a (possibly) faulty header. (beginning-of-line) @@ -885,7 +947,7 @@ is a spool. If not using procmail, return GROUP." (t (setq end nil)))) (if end (goto-char end) - ;; No Content-Length, so we find the beginning of the next + ;; No Content-Length, so we find the beginning of the next ;; article or the end of the buffer. (goto-char head-end) (or (nnmail-search-unix-mail-delim) @@ -907,28 +969,30 @@ is a spool. If not using procmail, return GROUP." (if (not (and (re-search-forward delim nil t) (forward-line 1))) ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") + (progn + (pop-to-buffer (nnheader-find-file-noselect nnmail-current-spool)) + (error "Error, unknown mail format! (Possibly corrupted.)")) ;; Carry on until the bitter end. (while (not (eobp)) (setq start (point)) ;; Find the end of the head. (narrow-to-region - start + 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. (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) + (if (re-search-forward "^Message-ID[ \t]*:[ \n\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:" nil t) + (when (re-search-backward "^Message-ID[ \t]*:" nil t) (beginning-of-line) (insert "Original-"))) (forward-line 1) @@ -973,7 +1037,7 @@ FUNC will be called with the buffer narrowed to each mail." (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 - ;; fetches from a file. + ;; fetching from a file. (cond ((or (looking-at "\^L") (looking-at "BABYL OPTIONS:")) (nnmail-process-babyl-mail-format func artnum-func)) @@ -985,15 +1049,15 @@ FUNC will be called with the buffer narrowed to each mail." (funcall exit-func)) (kill-buffer (current-buffer))))) -;; Mail crossposts suggested by Brian Edmonds . -(defun nnmail-article-group (func) +(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) (obuf (current-buffer)) (beg (point-min)) - end group-art method) - (if (and (sequencep methods) (= (length methods) 1)) + end group-art method regrepp) + (if (and (sequencep methods) + (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. (setq group-art @@ -1011,53 +1075,102 @@ FUNC will be called with the group name to determine the article number." (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) (replace-match " " t t)) + ;; Nuke pathologically long headers. Since Gnus applies + ;; pathologically complex regexps to the buffer, lines + ;; that are looong will take longer than the Universe's + ;; existence to process. + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (if (> (current-column) 1024) + (gnus-delete-line) + (forward-line 1))) ;; Allow washing. + (goto-char (point-min)) (run-hooks 'nnmail-split-hook) + (when (setq nnmail-split-tracing trace) + (setq nnmail-split-trace nil)) (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (let ((split (condition-case nil + ;; `nnmail-split-methods' is a function, so we + ;; just call this function here and use the + ;; result. (or (funcall nnmail-split-methods) '("bogus")) (error - (message + (nnheader-message 5 "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) - (unless (equal split '(junk)) - ;; `nnmail-split-methods' is a function, so we just call - ;; this function here and use the result. + (setq split (gnus-remove-duplicates split)) + ;; The article may be "cross-posted" to `junk'. What + ;; to do? Just remove the `junk' spec. Don't really + ;; see anything else to do... + (let (elem) + (while (setq elem (car (memq 'junk split))) + (setq split (delq elem split)))) + (when split (setq group-art (mapcar (lambda (group) (cons group (funcall func group))) split)))) ;; Go through the split methods to find a match. - (while (and methods (or nnmail-crosspost (not group-art))) + (while (and methods + (or nnmail-crosspost + (not group-art))) (goto-char (point-max)) - (setq method (pop methods)) + (setq method (pop methods) + regrepp nil) (if (or methods (not (equal "" (nth 1 method)))) (when (and (ignore-errors (if (stringp (nth 1 method)) - (re-search-backward (cadr method) nil t) + (progn + (setq regrepp + (string-match "\\\\[0-9&]" (car method))) + (re-search-backward (cadr method) nil t)) ;; Function to say whether this is a match. (funcall (nth 1 method) (car method)))) - ;; Don't enter the article into the same + ;; Don't enter the article into the same ;; group twice. (not (assoc (car method) group-art))) - (push (cons (car method) (funcall func (car method))) + (push (cons (if regrepp + (replace-match + (car method) nil nil (car method)) + (car method)) + (funcall func (car method))) group-art)) - ;; This is the final group, which is used as a + ;; This is the final group, which is used as a ;; catch-all. (unless group-art - (setq group-art + (setq group-art (list (cons (car method) (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))) + (nnheader-set-temp-buffer "*Split Trace*") + (gnus-add-current-to-buffer-list) + (while trace + (insert (car trace) "\n") + (setq trace (cdr trace))) + (goto-char (point-min)) + (gnus-configure-windows 'split-trace) + (set-buffer restore))) ;; See whether the split methods returned `junk'. (if (equal group-art '(junk)) nil - (nreverse (delq 'junk group-art))))))) + ;; The article may be "cross-posted" to `junk'. What + ;; to do? Just remove the `junk' spec. Don't really + ;; see anything else to do... + (let (elem) + (while (setq elem (car (memq 'junk group-art))) + (setq group-art (delq elem group-art))) + (nreverse group-art))))))) (defun nnmail-insert-lines () "Insert how many lines there are in the body of the mail. @@ -1087,7 +1200,10 @@ Return the number of characters in the body." (progn (forward-line 1) (point)))) (insert (format "Xref: %s" (system-name))) (while group-alist - (insert (format " %s:%d" (caar group-alist) (cdar group-alist))) + (insert (format " %s:%d" + (gnus-encode-coding-string (caar group-alist) + nnmail-pathname-coding-system) + (cdar group-alist))) (setq group-alist (cdr group-alist))) (insert "\n")))) @@ -1116,7 +1232,6 @@ Return the number of characters in the body." ;;; Utility functions -;; Written by byer@mv.us.adobe.com (Scott Byer). (defun nnmail-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) (newprefix prefix)) @@ -1142,81 +1257,87 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (defun nnmail-split-it (split) ;; Return a list of groups matching SPLIT. - (cond - ;; nil split - ((null split) - nil) - - ;; A group name. Do the \& and \N subs into the string. - ((stringp split) - (list (nnmail-expand-newtext split))) - - ;; Junk the message. - ((eq split 'junk) - (list 'junk)) - - ;; Builtin & operation. - ((eq (car split) '&) - (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) - - ;; Builtin | operation. - ((eq (car split) '|) - (let (done) - (while (and (not done) (cdr split)) - (setq split (cdr split) - done (nnmail-split-it (car split)))) - done)) - - ;; Builtin : operation. - ((eq (car split) ':) - (nnmail-split-it (eval (cdr split)))) - - ;; Check the cache for the regexp for this split. - ;; FIX FIX FIX could avoid calling assq twice here - ((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 (assq split nnmail-split-cache)) nil t) - ;; 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)))) - - ;; Not in cache, compute a regexp for the field/value pair. - (t - (let* ((field (nth 0 split)) - (value (nth 1 split)) - (regexp (concat "^\\(\\(" - (if (symbolp field) - (cdr (assq field nnmail-split-abbrev-alist)) - field) - "\\):.*\\)\\<\\(" - (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - 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. - (nnmail-split-it split))))) + (let (cached-pair) + (cond + ;; nil split + ((null split) + nil) + + ;; A group name. Do the \& and \N subs into the string. + ((stringp split) + (when nnmail-split-tracing + (push (format "\"%s\"" split) nnmail-split-trace)) + (list (nnmail-expand-newtext split))) + + ;; Junk the message. + ((eq split 'junk) + (when nnmail-split-tracing + (push "junk" nnmail-split-trace)) + (list 'junk)) + + ;; Builtin & operation. + ((eq (car split) '&) + (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) + + ;; Builtin | operation. + ((eq (car split) '|) + (let (done) + (while (and (not done) (cdr split)) + (setq split (cdr split) + done (nnmail-split-it (car split)))) + done)) + + ;; Builtin : operation. + ((eq (car split) ':) + (nnmail-split-it (save-excursion (eval (cdr 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)))) + + ;; Not in cache, compute a regexp for the field/value pair. + (t + (let* ((field (nth 0 split)) + (value (nth 1 split)) + (regexp (concat "^\\(\\(" + (if (symbolp field) + (cdr (assq field nnmail-split-abbrev-alist)) + field) + "\\):.*\\)\\<\\(" + (if (symbolp value) + (cdr (assq value nnmail-split-abbrev-alist)) + 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. + (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) (let ((len (length newtext)) @@ -1230,14 +1351,14 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (unless (= beg pos) (push (substring newtext beg pos) expanded)) (when (< pos len) - ;; we hit a \, expand it. - (setq did-expand t) - (setq pos (1+ pos)) - (setq c (aref newtext pos)) + ;; We hit a \; expand it. + (setq did-expand t + pos (1+ pos) + c (aref newtext pos)) (if (not (or (= c ?\&) (and (>= c ?1) (<= c ?9)))) - ;; \ followed by some character we don't expand + ;; \ followed by some character we don't expand. (push (char-to-string c) expanded) ;; \& or \N (if (= c ?\&) @@ -1256,15 +1377,15 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (if (null nnmail-spool-file) ;; No spool file whatsoever. nil - (let* ((procmails + (let* ((procmails ;; If procmail is used to get incoming mail, the files ;; are stored in this directory. (and (file-exists-p nnmail-procmail-directory) (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) - (directory-files - nnmail-procmail-directory - t (concat (if group (concat "^" group) "") + (directory-files + nnmail-procmail-directory + t (concat (if group (concat "^" (regexp-quote group)) "") nnmail-procmail-suffix "$")))) (p procmails) (crash (when (and (file-exists-p nnmail-crash-box) @@ -1273,13 +1394,13 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." 0)) (list nnmail-crash-box)))) ;; Remove any directories that inadvertently match the procmail - ;; suffix, which might happen if the suffix is "". + ;; suffix, which might happen if the suffix is "". (while p (when (file-directory-p (car p)) (setq procmails (delete (car p) procmails))) (setq p (cdr p))) ;; Return the list of spools. - (append + (append crash (cond ((and group (or (eq nnmail-spool-file 'procmail) @@ -1291,9 +1412,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." nil) ((listp nnmail-spool-file) (nconc - (apply + (apply 'nconc - (mapcar + (mapcar (lambda (file) (if (and (not (string-match "^po:" file)) (file-directory-p file)) @@ -1304,7 +1425,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((stringp nnmail-spool-file) (if (and (not (string-match "^po:" nnmail-spool-file)) (file-directory-p nnmail-spool-file)) - (nconc + (nconc (nnheader-directory-regular-files nnmail-spool-file) procmails) (cons nnmail-spool-file procmails))) @@ -1313,22 +1434,23 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (t procmails)))))) -;; Activate a backend only if it isn't already activated. -;; If FORCE, re-read the active file even if the backend is +;; Activate a backend only if it isn't already activated. +;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) + (nnheader-init-server-buffer) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force (and (setq file (ignore-errors - (symbol-value (intern (format "%s-active-file" + (symbol-value (intern (format "%s-active-file" backend))))) (setq file-time (nth 5 (file-attributes file))) (or (not (setq timestamp (condition-case () (symbol-value (intern - (format "%s-active-timestamp" + (format "%s-active-timestamp" backend))) (error 'none)))) (not (consp timestamp)) @@ -1338,20 +1460,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (> (nth 1 file-time) (nth 1 timestamp)))))) (save-excursion (or (eq timestamp 'none) - (set (intern (format "%s-active-timestamp" backend)) -;;; dmoore@ucsd.edu 25.10.96 -;;; it's not always the case that current-time -;;; does correspond to changes in the file's time. So just compare -;;; the file's new time against its own previous time. -;;; (current-time) - file-time - )) - (funcall (intern (format "%s-request-list" backend))) -;;; dmoore@ucsd.edu 25.10.96 -;;; BACKEND-request-list already does this itself! -;;; (set (intern (format "%s-group-alist" backend)) -;;; (nnmail-get-active)) - )) + (set (intern (format "%s-active-timestamp" backend)) + file-time)) + (funcall (intern (format "%s-request-list" backend))))) t)) (defun nnmail-message-id () @@ -1369,8 +1480,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (buffer-name nnmail-cache-buffer))) () ; The buffer is open. (save-excursion - (set-buffer - (setq nnmail-cache-buffer + (set-buffer + (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) @@ -1399,11 +1510,12 @@ 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)) - ))) + (kill-buffer (current-buffer))))) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) @@ -1416,6 +1528,12 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (goto-char (point-max)) (search-backward id nil t)))) +(defun nnmail-fetch-field (header) + (save-excursion + (save-restriction + (message-narrow-to-head) + (message-fetch-field header)))) + (defun nnmail-check-duplication (message-id func artnum-func) (run-hooks 'nnmail-prepare-incoming-message-hook) ;; If this is a duplicate message, then we do not save it. @@ -1440,17 +1558,12 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (setq group-art nil)) ((eq action 'warn) ;; We insert a warning. - (let ((case-fold-search t) - (newid (nnmail-message-id))) + (let ((case-fold-search t)) (goto-char (point-min)) - (when (re-search-forward "^message-id:" nil t) - (beginning-of-line) - (insert "Original-")) + (re-search-forward "^message-id[ \t]*:" nil t) (beginning-of-line) - (insert - "Message-ID: " newid "\n" + (insert "Gnus-Warning: This is a duplicate of message " message-id "\n") - (nnmail-cache-insert newid) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))))) (t @@ -1471,12 +1584,9 @@ 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." - ;; Nix out the previous split history. - (unless group - (setq nnmail-split-history nil)) (let* ((spools (nnmail-get-spool-files group)) (group-in group) - incoming incomings spool) + nnmail-current-spool incoming incomings spool) (when (and (nnmail-get-value "%s-get-new-mail" method) nnmail-spool-file) ;; We first activate all the groups. @@ -1498,28 +1608,31 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (nnheader-message 3 "%s: Reading incoming mail..." method) (when (and (nnmail-move-inbox spool) (file-exists-p nnmail-crash-box)) + (setq nnmail-current-spool spool) ;; There is new mail. We first find out if all this mail ;; is supposed to go to some specific group. (setq group (nnmail-get-split-group spool group-in)) ;; We split the mail - (nnmail-split-incoming + (nnmail-split-incoming nnmail-crash-box (intern (format "%s-save-mail" method)) spool-func group (intern (format "%s-active-number" method))) - ;; Check whether the inbox is to be moved to the special tmp dir. + ;; Check whether the inbox is to be moved to the special tmp dir. (setq incoming - (nnmail-make-complex-temp-name - (expand-file-name + (nnmail-make-complex-temp-name + (expand-file-name (if nnmail-tmp-directory - (concat + (concat (file-name-as-directory nnmail-tmp-directory) (file-name-nondirectory (concat (file-name-as-directory temp) "Incoming"))) (concat (file-name-as-directory temp) "Incoming"))))) + (unless (file-exists-p (file-name-directory incoming)) + (make-directory (file-name-directory incoming) t)) (rename-file nnmail-crash-box incoming t) (push incoming incomings)))) - ;; If we did indeed read any incoming spools, we save all info. + ;; If we did indeed read any incoming spools, we save all info. (when incomings - (nnmail-save-active + (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) (when exit-func @@ -1572,7 +1685,8 @@ If ARGS, PROMPT is used as an argument to `format'." (unless nnmail-read-passwd (if (load "passwd" t) (setq nnmail-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") + (unless (fboundp 'ange-ftp-read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp")) (setq nnmail-read-passwd 'ange-ftp-read-passwd))) (funcall nnmail-read-passwd prompt))) @@ -1581,13 +1695,15 @@ If ARGS, PROMPT is used as an argument to `format'." (save-restriction (message-narrow-to-head) (let ((case-fold-search t)) - (unless (re-search-forward "^Message-ID:" nil t) + (unless (re-search-forward "^Message-ID[ \t]*:" nil t) (insert "Message-ID: " (nnmail-message-id) "\n"))))) (defun nnmail-write-region (start end filename &optional append visit lockname) "Do a `write-region', and then set the file modes." - (write-region start end filename append visit lockname) - (set-file-modes filename nnmail-default-file-modes)) + (let ((coding-system-for-write nnmail-file-coding-system) + (pathname-coding-system 'binary)) + (write-region start end filename append visit lockname) + (set-file-modes filename nnmail-default-file-modes))) ;;; ;;; Status functions @@ -1663,6 +1779,15 @@ If ARGS, PROMPT is used as an argument to `format'." ", ")) (princ "\n"))))) +(defun nnmail-purge-split-history (group) + "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)) + (car history))) + (pop history)) + (setq nnmail-split-history (delq nil nnmail-split-history)))) + (defun nnmail-new-mail-p (group) "Say whether GROUP has new mail." (let ((his nnmail-split-history) @@ -1673,15 +1798,25 @@ If ARGS, PROMPT is used as an argument to `format'." his nil))) found)) +(eval-and-compile + (autoload 'pop3-movemail "pop3")) + (defun nnmail-pop3-movemail (inbox crashbox) "Function to move mail from INBOX on a pop3 server to file CRASHBOX." - (require 'pop3) (let ((pop3-maildrop (substring inbox (match-end (string-match "^po:" inbox))))) (pop3-movemail crashbox))) +(defun nnmail-within-headers-p () + "Check to see if point is within the headers of a unix mail message. +Doesn't change point." + (let ((pos (point))) + (save-excursion + (and (nnmail-search-unix-mail-delim-backward) + (not (search-forward "\n\n" pos t)))))) + (run-hooks 'nnmail-load-hook) - + (provide 'nnmail) ;;; nnmail.el ends here