;;; 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 <larsi@gnus.org>
;; Keywords: news, mail
(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."
:group 'nnmail)
(defgroup nnmail-split nil
- "Organizing the incoming mail in folders."
+ "Organizing the incomming mail in folders."
:group 'nnmail)
(defgroup nnmail-files nil
"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
(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,
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")))
: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.
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
\(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)
(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
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.
:group 'nnmail-prepare
:type 'hook)
+;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(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."
:group 'nnmail-split
:type 'hook)
+;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
+(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.
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
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.
;; 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.
: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
(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.
(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)
(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)
(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 file name.")
-
(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 file name for GROUP."
+ "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)
(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))
(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 ".
(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 ")
(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 ".
(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 ")
(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 %s `%s'.)"
- (if (buffer-file-name) "file" "buffer")
- (or (buffer-file-name) (buffer-name)))
+ (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)
(setq head-end (point))
;; We try the Content-Length value. The idea: skip over the header
;; separator, then check what happens content-length bytes into the
- ;; message body. This should be either the end of the buffer, the
+ ;; message body. This should be either the end ot the buffer, the
;; message separator or a blank line followed by the separator.
;; The blank line should probably be deleted. If neither of the
;; three is met, the content-length header is probably invalid.
(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))
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))
(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
(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)
;; 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)
(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))
(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.
(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)))
(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
(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 <amanda@iesd.auc.dk>.
(defun nnmail-split-fancy ()
"Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for details."
+See the documentation for the variable `nnmail-split-fancy' for documentation."
(let ((syntab (syntax-table)))
(unwind-protect
(progn
;; 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.
;; Builtin : operation.
((eq (car split) ':)
- (when nnmail-split-tracing
- (push split nnmail-split-trace))
(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)
(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.
(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)
(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 (looking-at "[\r\n]")
- (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 (member res '("delayed" "drafts" "queue"))
- (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
(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)
;;; Get new mail.
-(defvar nnmail-fetched-sources nil)
-
(defun nnmail-get-value (&rest args)
(let ((sym (intern (apply 'format args))))
(when (boundp sym)
(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."
;; 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)
- (when (or (gnus-request-group target)
- (gnus-request-create-group target))
- (let ((group-art (gnus-request-accept-article target nil nil t)))
- (when (consp group-art)
- (gnus-group-mark-article-read target (cdr group-art))))))))
-
-(defun nnmail-fancy-expiry-target (group)
- "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
- (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."
(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)))
;;;
(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")
(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))
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."
projects / elisp / gnus.git- / blobdiff