X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=8e8359e94a2492e8449e9cdc4c8bbe3128a5a00a;hb=b60d3f136dbeb0dab4db1439250d1aa869c3b1e7;hp=b640ae818076a3fc0832789d2e2c959f96141da5;hpb=baa6433903e8c07f69141b65eb0281620c6916ef;p=elisp%2Fgnus.git- diff --git a/lisp/nnmail.el b/lisp/nnmail.el index b640ae8..8e8359e 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,6 +1,5 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news, mail @@ -29,16 +28,15 @@ (eval-when-compile (require 'cl)) (require 'nnheader) +(require 'timezone) (require 'message) (require 'custom) (require 'gnus-util) -(require 'mail-source) -(require 'mm-util) (eval-and-compile (autoload 'gnus-error "gnus-util") (autoload 'gnus-buffer-live-p "gnus-util") - (autoload 'gnus-add-buffer "gnus")) + (autoload 'gnus-encode-coding-string "gnus-ems")) (defgroup nnmail nil "Reading mail with Gnus." @@ -77,7 +75,8 @@ "Various mail options." :group 'nnmail) -(defcustom nnmail-split-methods '(("mail.misc" "")) +(defcustom nnmail-split-methods + '(("mail.misc" "")) "*Incoming mail will be split according to this variable. If you'd like, for instance, one mail group for mail from the @@ -86,8 +85,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, @@ -104,8 +103,7 @@ The last element should always have \"\" as the regexp. This variable can also have a function as its value." :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") - (choice regexp function))) + :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) (function-item nnmail-split-fancy) (function :tag "Other"))) @@ -116,23 +114,6 @@ 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))) - -(defcustom nnmail-cache-ignore-groups nil - "Regexp that matches group names to be ignored when inserting message -ids into the cache (`nnmail-cache-insert'). This can also be a list -of regexps." - :group 'nnmail-split - :type '(choice (const :tag "none" nil) - (regexp :value ".*") - (repeat :value (".*") regexp))) - ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil "If non-nil, nnmail will never delete/move a group's last article. @@ -163,7 +144,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) - (number :tag "days") + (integer :tag "days") (const never))) (defcustom nnmail-expiry-wait-function nil @@ -177,83 +158,59 @@ 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, also update the cache when copy or move articles." + "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." :group 'nnmail :type 'boolean) -(defcustom nnmail-spool-file '((file)) +(defcustom nnmail-spool-file + (or (getenv "MAIL") + (concat "/usr/spool/mail/" (user-login-name))) "*Where the mail backends will look for incoming mail. -This variable is a list of mail source specifiers. -This variable is obsolete; `mail-sources' should be used instead." +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 +used as incoming mailboxes. +If this variable is a directory (i. e., it's name ends with a \"/\"), +treat all files in that directory as incoming spool files." :group 'nnmail-files - :type 'sexp) + :type '(choice (file :tag "File") + (repeat :tag "Files" file))) -(defcustom nnmail-resplit-incoming nil - "*If non-nil, re-split incoming procmail sorted mail." +(defcustom nnmail-crash-box "~/.gnus-crash-box" + "File where Gnus will store mail while processing it." + :group 'nnmail-files + :type 'file) + +(defcustom nnmail-use-procmail nil + "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. +The file(s) in `nnmail-spool-file' will also be read." :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" +(defcustom nnmail-procmail-directory "~/incoming/" + "*When using procmail (and the like), incoming mail is put in this directory. +The Gnus mail backends will read the mail from this directory." + :group 'nnmail-procmail + :type 'directory) + +(defcustom nnmail-procmail-suffix "\\.spool" + "*Suffix of files created by procmail (and the like). +This variable might be a suffix-regexp to match the suffixes of +several files - eg. \".spool[0-9]*\"." + :group 'nnmail-procmail + :type 'regexp) + +(defcustom nnmail-resplit-incoming nil + "*If non-nil, re-split incoming procmail sorted mail." :group 'nnmail-procmail :type 'boolean) @@ -275,12 +232,28 @@ links, you could set this variable to `copy-file' instead." (function-item copy-file) (function :tag "Other"))) +(defcustom nnmail-movemail-program "movemail" + "*A command to be executed to move mail from the inbox. +The default is \"movemail\". + +This can also be a function. In that case, the function will be +called with two parameters -- the name of the INBOX file, and the file +to be moved to." + :group 'nnmail-files + :group 'nnmail-retrieve + :type 'string) + +(defcustom nnmail-pop-password-required nil + "*Non-nil if a password is required when reading mail using POP." + :group 'nnmail-retrieve + :type 'boolean) + (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. -The incoming mail is moved from the specified spool file (which normally is +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 emptied, and can be used to call any mail box programs you have @@ -289,9 +262,9 @@ running (\"xwatch\", etc.) Eg. \(add-hook 'nnmail-read-incoming-hook - (lambda () - (call-process \"/local/bin/mailsend\" nil nil nil - \"read\" nnmail-spool-file))) + (lambda () + (start-process \"mailsend\" nil + \"/local/bin/mailsend\" \"read\" \"mbox\"))) If you have xwatch running, this will alert it that mail has been read. @@ -307,6 +280,7 @@ If you use `display-time', you could use something like this: :group 'nnmail-prepare :type 'hook) +;; Suggested by Erik Selberg . (defcustom nnmail-prepare-incoming-hook nil "Hook called before treating incoming mail. The hook is run in a buffer with all the new, incoming mail." @@ -351,13 +325,21 @@ discarded after running the split process." :group 'nnmail-split :type 'hook) +;; Suggested by Mejia Pablo J . +(defcustom nnmail-tmp-directory nil + "*If non-nil, use this directory for temporary storage. +Used when reading incoming mail." + :group 'nnmail-files + :group 'nnmail-retrieve + :type '(choice (const :tag "default" nil) + (directory :format "%v"))) + (defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup or nil. + "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status." :group 'nnmail-various - :type '(choice (const :tag "infinite" nil) - (number :tag "count"))) + :type 'integer) (defcustom nnmail-split-fancy "mail.misc" "Incoming mail can be split according to this fancy variable. @@ -368,12 +350,8 @@ the following: GROUP: Mail will be stored in GROUP (a string). -\(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. +\(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 @@ -385,16 +363,6 @@ 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. @@ -422,13 +390,6 @@ 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. @@ -448,6 +409,12 @@ Example: :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) +(defcustom nnmail-delete-incoming t + "*If non-nil, the mail backends will delete incoming files after +splitting." + :group 'nnmail-retrieve + :type 'boolean) + (defcustom nnmail-message-id-cache-length 1000 "*The approximate number of Message-IDs nnmail will keep in its cache. If this variable is nil, no checking on duplicate messages will be @@ -464,7 +431,7 @@ performed." (defcustom nnmail-treat-duplicates 'warn "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. -Three values are valid: nil, which means that nnmail is not to keep a +Three values are legal: nil, which means that nnmail is not to keep a Message-ID cache; `warn', which means that nnmail should insert extra headers to warn the user about the duplication (this is the default); and `delete', which means that nnmail will delete duplicated mails. @@ -477,36 +444,16 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) -(defcustom nnmail-extra-headers '(To Newsgroups) - "*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) - -(defcustom nnmail-mail-splitting-charset nil - "Default charset to be used when splitting incoming mail." - :group 'nnmail - :type 'symbol) - -(defcustom nnmail-mail-splitting-decodes nil - "Whether the nnmail splitting functionality should MIME decode headers." - :group 'nnmail - :type 'boolean) - ;;; Internal variables. -(defvar nnmail-article-buffer " *nnmail incoming*" - "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-pop-password nil + "*Password to use when reading mail from a POP server, if required.") + (defvar nnmail-split-fancy-syntax-table nil "Syntax table used by `nnmail-split-fancy'.") (unless (syntax-table-p nnmail-split-fancy-syntax-table) @@ -518,6 +465,11 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-prepare-save-mail-hook nil "Hook called before saving mail.") +(defvar nnmail-moved-inboxes nil + "List of inboxes that have been moved.") + +(defvar nnmail-internal-password nil) + (defvar nnmail-split-tracing nil) (defvar nnmail-split-trace nil) @@ -534,90 +486,227 @@ parameter. It should return nil, `warn' or `delete'." (defvar nnmail-file-coding-system 'raw-text "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 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)) + (erase-buffer) (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 (mm-auto-mode-alist)) - (file-name-coding-system nnmail-pathname-coding-system)) - (insert-file-contents file) + (let ((pathname-coding-system 'binary)) + (insert-file-contents-as-coding-system + nnmail-file-coding-system 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-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. - (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 - (mm-encode-coding-string - (nnheader-replace-chars-in-string group ?. ?/) - nnmail-pathname-coding-system) - dir)))) + (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 + (gnus-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnmail-pathname-coding-system) + "/"))) (or file ""))) +(defun nnmail-date-to-time (date) + "Convert DATE into time." + (condition-case () + (let* ((d1 (timezone-parse-date date)) + (t1 (timezone-parse-time (aref d1 3)))) + (apply 'encode-time + (mapcar (lambda (el) + (and el (string-to-number el))) + (list + (aref t1 2) (aref t1 1) (aref t1 0) + (aref d1 2) (aref d1 1) (aref d1 0) + (number-to-string + (* 60 (timezone-zone-to-minute + (or (aref d1 4) (current-time-zone))))))))) + ;; If we get an error, then we just return a 0 time. + (error (list 0 0)))) + +(defun nnmail-time-less (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(defun nnmail-days-to-time (days) + "Convert DAYS into time." + (let* ((seconds (* 1.0 days 60 60 24)) + (rest (expt 2 16)) + (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)))))) + +(defun nnmail-time-since (time) + "Return the time since TIME, which is either an internal time or a date." + (when (stringp time) + ;; Convert date strings to internal time. + (setq time (nnmail-date-to-time time))) + (let* ((current (current-time)) + (rest (when (< (nth 1 current) (nth 1 time)) + (expt 2 16)))) + (list (- (+ (car current) (if rest -1 0)) (car time)) + (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) + +;; Function rewritten from rmail.el. +(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" + 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 ((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. + (when (file-directory-p inbox) + (setq inbox (expand-file-name (user-login-name) inbox)))) + (if (member inbox nnmail-moved-inboxes) + ;; We don't try to move an already moved inbox. + nil + (if popmail + (progn + (when (and nnmail-pop-password + (not nnmail-internal-password)) + (setq nnmail-internal-password nnmail-pop-password)) + (when (and nnmail-pop-password-required + (not nnmail-internal-password)) + (setq nnmail-internal-password + (nnmail-read-passwd + (format "Password for %s: " + (substring inbox (+ popmail 3)))))) + (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)))) + (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 + ((file-exists-p tofile) + ;; The crash box exists already. + t) + ((and (not popmail) + (not (file-exists-p inbox))) + ;; There is no inbox. + (setq tofile nil)) + (t + ;; If getting from mail spool directory, use movemail to move + ;; rather than just renaming, so as to interlock with the + ;; mailer. + (unwind-protect + (save-excursion + (setq errors (generate-new-buffer " *nnmail loss*")) + (buffer-disable-undo 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)))) + (set-buffer errors) + ;; There may be a warning about older revisions. We + ;; ignore those. + (goto-char (point-min)) + (if (search-forward "older revision" nil t) + (progn + (unless popmail + (when (file-exists-p tofile) + (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") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (when (looking-at "movemail: ") + (delete-region (point-min) (match-end 0))) + (unless (yes-or-no-p + (format "movemail: %s (%d return). Continue? " + (buffer-string) result)) + (error "%s" (buffer-string))) + (setq tofile nil))))))) + (nnheader-message 5 "Getting mail from %s...done" inbox) + (and errors + (buffer-name errors) + (kill-buffer errors)) + tofile)))) + (defun nnmail-get-active () "Returns an assoc of group names and active ranges. nn*-request-list should have been called before calling this function." - ;; 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)) + (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))) group-assoc)) -(defvar nnmail-active-file-coding-system 'raw-text +(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." (let ((coding-system-for-write nnmail-active-file-coding-system)) (when file-name - (with-temp-file file-name + (nnheader-temp-write file-name (nnmail-generate-active group-assoc))))) (defun nnmail-generate-active (alist) @@ -625,26 +714,37 @@ 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" (intern (car group)) (cdadr group) - (caadr group)))) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1)))) + (insert (format "%s %d %d y\n" (car group) (cdadr group) + (caadr group)))))) -(defun nnmail-get-split-group (file source) +(defun nnmail-get-split-group (file group) "Find out whether this FILE is to be split into GROUP only. -If SOURCE is a directory spec, try to return the group name component." - (if (eq (car source) 'directory) - (let ((file (file-name-nondirectory file))) - (mail-source-bind (directory source) - (if (string-match (concat (regexp-quote suffix) "$") file) - (substring file 0 (match-beginning 0)) - nil))) - nil)) +If GROUP is non-nil and we are using procmail, return the group name +only when the file is the correct procmail file. When GROUP is nil, +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 "^" (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 (string-equal group procmail-group) + group + nil) + procmail-group)) + nil) + group)) (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)) @@ -716,14 +816,12 @@ 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)) - count)) + (goto-char end)))) (defsubst nnmail-search-unix-mail-delim () "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the next article in the + ;; Algorithm used to find the the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -740,7 +838,7 @@ If SOURCE is a directory spec, try to return the group name component." (when (and (or (bobp) (save-excursion (forward-line -1) - (eq (char-after) ?\n))) + (= (following-char) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -752,7 +850,7 @@ If SOURCE is a directory spec, try to return the group name component." (defun nnmail-search-unix-mail-delim-backward () "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the next article in the + ;; Algorithm used to find the the next article in the ;; brain-dead Unix mbox format: ;; ;; 1) Search for "^From ". @@ -769,7 +867,7 @@ If SOURCE is a directory spec, try to return the group name component." (when (and (or (bobp) (save-excursion (forward-line -1) - (eq (char-after) ?\n))) + (= (following-char) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -781,13 +879,14 @@ 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? - (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) @@ -860,22 +959,21 @@ 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))) - count)) + (goto-char end))))) (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? - (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)) @@ -884,8 +982,8 @@ If SOURCE is a directory spec, try to return the group name component." start (if (search-forward "\n\n" nil t) (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. + ;; This will never happen, but just to be on the safe side -- + ;; if there is no head-body delimiter, we search a bit manually. (while (and (looking-at "From \\|[^ \t]+:") (not (eobp))) (forward-line 1)) @@ -913,92 +1011,53 @@ 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))) - count)) - -(defun nnmail-process-maildir-mail-format (func artnum-func) - ;; In a maildir, every file contains exactly one mail. - (let ((case-fold-search t) - message-id) - (goto-char (point-min)) - ;; Find the end of the head. - (narrow-to-region - (point-min) - (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))) - ;; 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) - (beginning-of-line) - (insert "Original-"))) - (forward-line 1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) - (run-hooks 'nnmail-prepare-incoming-header-hook) - ;; Allow the backend to save the article. - (widen) - (save-excursion - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func)) - 1)) + (forward-line 2))))) (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail." - (let ( ;; If this is a group-specific split, we bind the split + (let (;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group + (or (eq nnmail-spool-file 'procmail) + nnmail-use-procmail) (not nnmail-resplit-incoming)) (list (list group "")) nnmail-split-methods))) (save-excursion ;; Insert the incoming file. - (set-buffer (get-buffer-create nnmail-article-buffer)) + (set-buffer (get-buffer-create " *nnmail incoming*")) + (buffer-disable-undo (current-buffer)) (erase-buffer) - (let ((coding-system-for-read nnmail-incoming-coding-system)) - (mm-insert-file-contents incoming)) - (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)))))) + (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)) + (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. FUNC will be called with the group name to determine the article number." - (let ((methods (or nnmail-split-methods '(("bogus" "")))) + (let ((methods nnmail-split-methods) (obuf (current-buffer)) (beg (point-min)) - end group-art method grp) + end group-art method regrepp) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we @@ -1014,10 +1073,6 @@ FUNC will be called with the group name to determine the article number." (erase-buffer) ;; Copy the headers into the work buffer. (insert-buffer-substring obuf beg end) - ;; Decode MIME headers and charsets. - (when nnmail-mail-splitting-decodes - (let ((mail-parse-charset nnmail-mail-splitting-charset)) - (mail-decode-encoded-word-region (point-min) (point-max)))) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) @@ -1028,10 +1083,10 @@ FUNC will be called with the group name to determine the article number." ;; existence to process. (goto-char (point-min)) (while (not (eobp)) - (unless (< (move-to-column nnmail-split-header-length-limit) - nnmail-split-header-length-limit) - (delete-region (point) (progn (end-of-line) (point)))) - (forward-line 1)) + (end-of-line) + (if (> (current-column) 1024) + (gnus-delete-line) + (forward-line 1))) ;; Allow washing. (goto-char (point-min)) (run-hooks 'nnmail-split-hook) @@ -1047,8 +1102,8 @@ FUNC will be called with the group name to determine the article number." (or (funcall nnmail-split-methods) '("bogus")) (error - (nnheader-message - 5 "Error in `nnmail-split-methods'; using `bogus' mail group") + (nnheader-message 5 + "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (setq split (gnus-remove-duplicates split)) @@ -1069,24 +1124,25 @@ FUNC will be called with the group name to determine the article number." (not group-art))) (goto-char (point-max)) (setq method (pop methods) - grp (car method)) + regrepp nil) (if (or methods (not (equal "" (nth 1 method)))) (when (and (ignore-errors (if (stringp (nth 1 method)) - (let ((expand (string-match "\\\\[0-9&]" grp)) - (pos (re-search-backward (cadr method) - nil t))) - (and expand - (setq grp (nnmail-expand-newtext grp))) - pos) + (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) grp))) + (funcall (nth 1 method) (car method)))) ;; Don't enter the article into the same ;; group twice. - (not (assoc grp group-art))) - (push (cons grp (funcall func grp)) + (not (assoc (car method) group-art))) + (push (cons (if regrepp + (nnmail-expand-newtext (car method)) + (car method)) + (funcall func (car method))) group-art)) ;; This is the final group, which is used as a ;; catch-all. @@ -1096,12 +1152,13 @@ FUNC will be called with the group name to determine the article number." (funcall func (car method))))))))) ;; Produce a trace if non-empty. (when (and trace nnmail-split-trace) - (let ((restore (current-buffer))) + (let ((trace (nreverse nnmail-split-trace)) + (restore (current-buffer))) (nnheader-set-temp-buffer "*Split Trace*") (gnus-add-buffer) - (dolist (trace (nreverse nnmail-split-trace)) - (prin1 trace (current-buffer)) - (insert "\n")) + (while trace + (insert (car trace) "\n") + (setq trace (cdr trace))) (goto-char (point-min)) (gnus-configure-windows 'split-trace) (set-buffer restore))) @@ -1122,39 +1179,34 @@ Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) - (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))) + (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)))) (defun nnmail-insert-xref (group-alist) "Insert an Xref line based on the (group . article) alist." (save-excursion (goto-char (point-min)) - (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"))) + (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" + (gnus-encode-coding-string (caar group-alist) + nnmail-pathname-coding-system) + (cdar group-alist))) + (setq group-alist (cdr group-alist))) + (insert "\n")))) ;;; Message washing functions @@ -1166,63 +1218,30 @@ Return the number of characters in the body." (defun nnmail-remove-list-identifiers () "Remove list identifiers from Subject headers." - (let ((regexp - (if (consp nnmail-list-identifiers) - (mapconcat 'identity nnmail-list-identifiers " *\\|") - nnmail-list-identifiers))) + (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers + (mapconcat 'identity nnmail-list-identifiers "\\|")))) (when regexp (goto-char (point-min)) - (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))))) + (when (re-search-forward + (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *") + nil t) + (delete-region (match-beginning 2) (match-end 0)))))) (defun nnmail-remove-tabs () "Translate TAB characters into SPACE characters." (subst-char-in-region (point-min) (point-max) ?\t ? t)) -(defun nnmail-fix-eudora-headers () - "Eudora has a broken References line, but an OK In-Reply-To." - (goto-char (point-min)) - (when (re-search-forward "^X-Mailer:.*Eudora" nil t) - (goto-char (point-min)) - (when (re-search-forward "^References:" nil t) - (beginning-of-line) - (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-make-complex-temp-name (prefix) + (let ((newname (make-temp-name prefix)) + (newprefix prefix)) + (while (file-exists-p newname) + (setq newprefix (concat newprefix "x")) + (setq newname (make-temp-name newprefix))) + newname)) + +;; Written by Per Abrahamsen . (defun nnmail-split-fancy () "Fancy splitting method. @@ -1248,7 +1267,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; A group name. Do the \& and \N subs into the string. ((stringp split) (when nnmail-split-tracing - (push split nnmail-split-trace)) + (push (format "\"%s\"" split) nnmail-split-trace)) (list (nnmail-expand-newtext split))) ;; Junk the message. @@ -1273,88 +1292,52 @@ 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)) - (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 split nnmail-split-trace)) - (let ((split-rest (cddr split)) - (end (match-end 0)) - ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). - ;; So, start-of-value is the 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)) + (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)) - 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 "^\\(\\(" + (regexp (concat "^\\(\\(" (if (symbolp field) (cdr (assq field nnmail-split-abbrev-alist)) field) - "\\):.*\\)" - (or partial-front "\\<") - "\\(" - value - "\\)" - (or partial-rear "\\>"))) + "\\):.*\\)\\<\\(" + (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. + ;; on the same split, which will find it immediately in the cache. (nnmail-split-it split)))))) (defun nnmail-expand-newtext (newtext) @@ -1390,6 +1373,68 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." (apply 'concat (nreverse expanded)) newtext))) +;; Get a list of spool files to read. +(defun nnmail-get-spool-files (&optional group) + (if (null nnmail-spool-file) + ;; No spool file whatsoever. + nil + (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 "^" (regexp-quote group)) "") + nnmail-procmail-suffix "$")))) + (p procmails) + (crash (when (and (file-exists-p nnmail-crash-box) + (> (nnheader-file-size + (file-truename nnmail-crash-box)) + 0)) + (list nnmail-crash-box)))) + ;; Remove any directories that inadvertently match the procmail + ;; 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 + crash + (cond ((and group + (or (eq nnmail-spool-file 'procmail) + nnmail-use-procmail) + procmails) + procmails) + ((and group + (eq nnmail-spool-file 'procmail)) + nil) + ((listp nnmail-spool-file) + (nconc + (apply + 'nconc + (mapcar + (lambda (file) + (if (and (not (string-match "^po:" file)) + (file-directory-p file)) + (nnheader-directory-regular-files file) + (list file))) + nnmail-spool-file)) + procmails)) + ((stringp nnmail-spool-file) + (if (and (not (string-match "^po:" nnmail-spool-file)) + (file-directory-p nnmail-spool-file)) + (nconc + (nnheader-directory-regular-files nnmail-spool-file) + procmails) + (cons nnmail-spool-file procmails))) + ((eq nnmail-spool-file 'pop) + (cons (format "po:%s" (user-login-name)) procmails)) + (t + procmails)))))) + ;; Activate a backend only if it isn't already activated. ;; If FORCE, re-read the active file even if the backend is ;; already activated. @@ -1439,7 +1484,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) + (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) (nnheader-insert-file-contents nnmail-message-id-cache-file)) (set-buffer-modified-p nil) @@ -1468,93 +1513,14 @@ 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 grp) +(defun nnmail-cache-insert (id) (when nnmail-treat-duplicates - ;; Store some information about the group this message is written - ;; to. This is passed in as the grp argument -- all locations this - ;; has been called from have been checked and the group is available. - ;; The only ambiguous case is nnmail-check-duplication which will only - ;; pass the first (of possibly >1) group which matches. -Josh (unless (gnus-buffer-live-p nnmail-cache-buffer) (nnmail-cache-open)) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) - (if (and grp (not (string= "" grp)) - (gnus-methods-equal-p gnus-command-method - (nnmail-cache-primary-mail-backend))) - (let ((regexp (if (consp nnmail-cache-ignore-groups) - (mapconcat 'identity nnmail-cache-ignore-groups - "\\|") - nnmail-cache-ignore-groups))) - (unless (and regexp (string-match regexp grp)) - (insert id "\t" grp "\n"))) - (insert id "\n"))))) - -(defun nnmail-cache-primary-mail-backend () - (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) - (be nil) - (res nil)) - (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)) - (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))) + (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) (when nnmail-treat-duplicates @@ -1583,19 +1549,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (t nnmail-treat-duplicates)))) group-art) - ;; We insert a line that says what the mail source is. - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "^message-id[ \t]*:" nil t) - (beginning-of-line) - (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string))) - ;; Let the backend save the article (or not). (cond ((not duplication) + (nnmail-cache-insert message-id) (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func)))) - (nnmail-cache-insert message-id (caar group-art))) + (nreverse (nnmail-article-group artnum-func))))) ((eq action 'delete) (setq group-art nil)) ((eq action 'warn) @@ -1618,8 +1577,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;; Get new mail. -(defvar nnmail-fetched-sources nil) - (defun nnmail-get-value (&rest args) (let ((sym (intern (apply 'format args)))) (when (boundp sym) @@ -1628,92 +1585,72 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun nnmail-get-new-mail (method exit-func temp &optional group spool-func) "Read new incoming mail." - (let* ((sources (or mail-sources - (if (listp nnmail-spool-file) nnmail-spool-file - (list nnmail-spool-file)))) - fetching-sources + (let* ((spools (nnmail-get-spool-files group)) (group-in group) - (i 0) - (new 0) - (total 0) - incoming incomings source) + nnmail-current-spool incoming incomings spool) (when (and (nnmail-get-value "%s-get-new-mail" method) - sources) - (while (setq source (pop sources)) - ;; Be compatible with old values. - (cond - ((stringp source) - (setq source - (cond - ((string-match "^po:" source) - (list 'pop :user (substring source (match-end 0)))) - ((file-directory-p source) - (list 'directory :path source)) - (t - (list 'file :path source))))) - ((eq source 'procmail) - (message "Invalid value for nnmail-spool-file: `procmail'") - 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) - (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) - (push source fetching-sources))))) - (when fetching-sources + 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 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))) + ;; The we go through all the existing spool files and split the + ;; mail from each. + (while spools + (setq spool (pop spools)) + ;; We read each spool file if either the spool is a POP-mail + ;; spool, or the file exists. We can't check for the + ;; existence of POPped mail. + (when (or (string-match "^po:" spool) + (and (file-exists-p (file-truename spool)) + (> (nnheader-file-size (file-truename spool)) 0))) + (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-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. + (setq incoming + (nnmail-make-complex-temp-name + (expand-file-name + (if nnmail-tmp-directory + (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 (zerop total) - (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" - method (car source)) + (when incomings (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 (%d new)...done" method - total)) + (nnheader-message 3 "%s: Reading incoming mail...done" method)) ;; Close the message-id cache. (nnmail-cache-close) ;; Allow the user to hook. - (run-hooks 'nnmail-post-get-new-mail-hook)))) + (run-hooks 'nnmail-post-get-new-mail-hook) + ;; Delete all the temporary files. + (while incomings + (setq incoming (pop incomings)) + (and nnmail-delete-incoming + (file-exists-p incoming) + (file-writable-p incoming) + (delete-file incoming)))))) (defun nnmail-expired-article-p (group time force &optional inhibit) "Say whether an article that is TIME old in GROUP should be expired." @@ -1731,50 +1668,30 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; We expire all articles on sight. t) ((equal time '(0 0)) - ;; This is an ange-ftp group, and we don't have any dates. + ;; This is an ange-ftp group, and we don't have any dates. nil) ((numberp days) - (setq days (days-to-time days)) + (setq days (nnmail-days-to-time days)) ;; 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) - (or - (message-fetch-field header) - ""))) - (setq target - (format-time-string (caddr regexp-target-pair) date))))))) + (nnmail-time-less days (nnmail-time-since time))))))) + +(defvar nnmail-read-passwd nil) +(defun nnmail-read-passwd (prompt &rest args) + "Read a password using PROMPT. +If ARGS, PROMPT is used as an argument to `format'." + (let ((prompt + (if args + (apply 'format prompt args) + prompt))) + (unless nnmail-read-passwd + (if (functionp 'read-passwd) + (setq nnmail-read-passwd 'read-passwd) + (if (load "passwd" t) + (setq nnmail-read-passwd 'read-passwd) + (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))) (defun nnmail-check-syntax () "Check (and modify) the syntax of the message in the current buffer." @@ -1786,9 +1703,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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) - (file-name-coding-system nnmail-pathname-coding-system)) - (write-region start end filename append visit lockname) + (let ((pathname-coding-system 'binary)) + (write-region-as-coding-system + nnmail-file-coding-system start end filename append visit lockname) (set-file-modes filename nnmail-default-file-modes))) ;;; @@ -1823,11 +1740,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (goto-char (point-min)) (while (re-search-forward "[^ \t=]+" nil t) (setq name (match-string 0)) - (if (not (eq (char-after) ?=)) + (if (not (= (following-char) ?=)) ;; Implied "yes". (setq value "yes") (forward-char 1) - (if (not (eq (char-after) ?\")) + (if (not (= (following-char) ?\")) (if (not (looking-at "[^ \t]")) ;; Implied "no". (setq value "no") @@ -1856,8 +1773,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) @@ -1886,6 +1801,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 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." + (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."