;;; Code:
(require 'nnheader)
-(require 'rmail)
(require 'timezone)
-(require 'sendmail)
+(require 'message)
(eval-when-compile (require 'cl))
(defvar nnmail-split-methods
If nil, groups like \"mail.misc\" will end up in directories like
\"mail/misc/\".")
+(defvar nnmail-default-file-modes 384
+ "Set the mode bits of all new mail files to this integer.")
+
(defvar nnmail-expiry-wait 7
"*Expirable articles that are older than this will be expired.
This variable can either be a number (which will be interpreted as a
(lambda (newsgroup)
(cond ((string-match \"private\" newsgroup) 31)
((string-match \"junk\" newsgroup) 1)
- ((string-match \"important\" 'never))
+ ((string-match \"important\" newsgroup) 'never)
(t 7))))")
(defvar nnmail-spool-file
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.")
+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.")
(defvar nnmail-crash-box "~/.gnus-crash-box"
"*File where Gnus will store mail while processing it.")
(defvar nnmail-movemail-program "movemail"
"*A command to be executed to move mail from the inbox.
-The default is \"movemail\".")
+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.")
+
+(defvar nnmail-pop-password-required nil
+ "*Non-nil if a password is required when reading mail using POP.")
(defvar nnmail-read-incoming-hook nil
"*Hook that will be run after the incoming mail has been transferred.
The incoming mail is moved from `nnmail-spool-file' (which normally is
something like \"/usr/spool/mail/$user\") to the user's home
-directory. This hook is called after the incoming mail box has been
+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
running (\"xwatch\", etc.)
Eg.
\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
+ (lambda ()
(start-process \"mailsend\" nil
\"/local/bin/mailsend\" \"read\" \"mbox\")))
(lambda ()
;; Update the displayed time, since that will clear out
;; the flag that says you have mail.
- (if (eq (process-status \"display-time\") 'run)
- (display-time-filter display-time-process \"\"))))")
+ (when (eq (process-status \"display-time\") 'run)
+ (display-time-filter display-time-process \"\"))))")
+
+(when (eq system-type 'windows-nt)
+ (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr))
;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(defvar nnmail-prepare-incoming-hook nil
"*Hook called before treating incoming mail.
The hook is run in a buffer with all the new, incoming mail.")
+(defvar nnmail-prepare-incoming-header-hook nil
+ "*Hook called narrowed to the headers of each message.
+This can be used to remove excessive spaces (and stuff like
+that) from the headers before splitting and saving the messages.")
+
+(defvar nnmail-prepare-incoming-message-hook nil
+ "*Hook called narrowed to each message.")
+
+(defvar nnmail-list-identifiers nil
+ "Regexp that match list identifiers to be removed.
+This can also be a list of regexps.")
+
(defvar nnmail-pre-get-new-mail-hook nil
"Hook called just before starting to handle new incoming mail.")
(defvar nnmail-post-get-new-mail-hook nil
"Hook called just after finishing handling new incoming mail.")
+(defvar nnmail-split-hook nil
+ "Hook called before deciding where to split an article.
+The functions in this hook are free to modify the buffer
+contents in any way they choose -- the buffer contents are
+discarded after running the split process.")
+
;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
(defvar nnmail-tmp-directory nil
"*If non-nil, use this directory for temporary storage when reading incoming mail.")
\(& SPLIT...): Process each SPLIT expression.
FIELD must match a complete field name. VALUE must match a complete
-word according to the fundamental mode syntax table. You can use .*
-in the regexps to match partial field names or words.
+word according to the `nnmail-split-fancy-syntax-table' syntax table.
+You can use .* in the regexps to match partial field names or words.
FIELD and VALUE can also be lisp symbols, in that case they are expanded
as specified in `nnmail-split-abbrev-alist'.
\(setq nnmail-split-methods 'nnmail-split-fancy
nnmail-split-fancy
- ;; Messages from the mailer deamon are not crossposted to any of
+ ;; Messages from the mailer daemon are not crossposted to any of
;; the ordinary groups. Warnings are put in a separate group
;; from real errors.
'(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
\"misc.misc\"))")
(defvar nnmail-split-abbrev-alist
- '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
+ '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
(mail . "mailer-daemon\\|postmaster"))
"*Alist of abbreviations allowed in `nnmail-split-fancy'.")
;;; Internal variables.
+(defvar nnmail-split-history nil
+ "List of group/article elements that say where the previous split put messages.")
+
+(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)
+ (setq nnmail-split-fancy-syntax-table
+ (copy-syntax-table (standard-syntax-table)))
+ ;; support the %-hack
+ (modify-syntax-entry ?\% "." 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)
+
\f
(defconst nnmail-version "nnmail 1.0"
"Insert FILE in server buffer safely."
(set-buffer nntp-server-buffer)
(erase-buffer)
- (condition-case ()
- (progn (insert-file-contents file) t)
- (file-error nil)))
+ (let ((format-alist nil)
+ (after-insert-file-functions nil))
+ (condition-case ()
+ (progn (insert-file-contents file) t)
+ (file-error nil))))
(defun nnmail-group-pathname (group dir &optional file)
"Make pathname for GROUP."
(defun nnmail-date-to-time (date)
"Convert DATE into time."
- (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)
- (aref d1 4))))))
+ (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)
+ (aref d1 4)))))
+ ;; 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."
"Convert DAYS into time."
(let* ((seconds (* 1.0 days 60 60 24))
(rest (expt 2 16))
- (ms (condition-case nil (round (/ seconds rest))
+ (ms (condition-case nil (round (/ seconds rest))
(range-error (expt 2 16)))))
(list ms (condition-case nil (round (- seconds (* ms rest)))
(range-error (expt 2 16))))))
;; Convert date strings to internal time.
(setq time (nnmail-date-to-time time)))
(let* ((current (current-time))
- (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16))))
+ (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 taken from rmail.el.
+;; Function rewritten from rmail.el.
(defun nnmail-move-inbox (inbox)
"Move INBOX to `nnmail-crash-box'."
- (let ((inbox (file-truename
- (expand-file-name (substitute-in-file-name inbox))))
- (tofile (file-truename (expand-file-name
- (substitute-in-file-name nnmail-crash-box))))
- movemail popmail errors)
- ;; If getting from mail spool directory,
- ;; use movemail to move rather than just renaming,
- ;; so as to interlock with the mailer.
- (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
- (setq movemail t))
- (when popmail
- (setq inbox (file-name-nondirectory inbox)))
- (when (and movemail
- ;; On some systems, /usr/spool/mail/foo is a directory
- ;; and the actual inbox is /usr/spool/mail/foo/foo.
- (file-directory-p inbox))
- (setq inbox (expand-file-name (user-login-name) inbox)))
- (if popmail
- (message "Getting mail from post office ...")
- (when (or (and (file-exists-p tofile)
- (/= 0 (nth 7 (file-attributes tofile))))
- (and (file-exists-p inbox)
- (/= 0 (nth 7 (file-attributes inbox)))))
- (message "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))
- ((and (not movemail) (not popmail))
- ;; Try copying. If that fails (perhaps no space),
- ;; rename instead.
- (condition-case nil
- (copy-file inbox tofile nil)
- (error
- ;; Third arg is t so we can replace existing file TOFILE.
- (rename-file inbox tofile t)))
- ;; Make the real inbox file empty.
- ;; Leaving it deleted could cause lossage
- ;; because mailers often won't create the file.
- (condition-case ()
- (write-region (point) (point) inbox)
- (file-error nil)))
- (t
- (unwind-protect
- (save-excursion
- (setq errors (generate-new-buffer " *nnmail loss*"))
- (buffer-disable-undo errors)
- (let ((default-directory "/"))
- (call-process
- (expand-file-name nnmail-movemail-program exec-directory)
- nil errors nil inbox tofile))
- (if (not (buffer-modified-p errors))
- ;; No output => movemail won
- nil
- (set-buffer errors)
- (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))
- (if (looking-at "movemail: ")
- (delete-region (point-min) (match-end 0)))
- (beep t)
- (message (concat "movemail: "
- (buffer-substring (point-min)
- (point-max))))
- (sit-for 3)
- (setq tofile nil))))))
- (and errors
- (buffer-name errors)
- (kill-buffer errors))
- tofile))
+ (if (not (file-writable-p nnmail-crash-box))
+ (gnus-error 1 "Can't write to crash box %s. Not moving mail."
+ nnmail-crash-box)
+ (let ((inbox (file-truename (expand-file-name inbox)))
+ (tofile (file-truename (expand-file-name nnmail-crash-box)))
+ movemail popmail errors)
+ ;; If getting from mail spool directory,
+ ;; use movemail to move rather than just renaming,
+ ;; so as to interlock with the mailer.
+ (unless (setq popmail (string-match
+ "^po:" (file-name-nondirectory inbox)))
+ (setq movemail t))
+ (when popmail
+ (setq inbox (file-name-nondirectory inbox)))
+ (when (and movemail
+ ;; On some systems, /usr/spool/mail/foo is a directory
+ ;; and the actual inbox is /usr/spool/mail/foo/foo.
+ (file-directory-p inbox))
+ (setq inbox (expand-file-name (user-login-name) inbox)))
+ (if (member inbox nnmail-moved-inboxes)
+ nil
+ (if popmail
+ (progn
+ (setq nnmail-internal-password nnmail-pop-password)
+ (when (and nnmail-pop-password-required
+ (not nnmail-pop-password))
+ (setq nnmail-internal-password
+ (nnmail-read-passwd
+ (format "Password for %s: "
+ (substring inbox (+ popmail 3))))))
+ (message "Getting mail from post office ..."))
+ (when (or (and (file-exists-p tofile)
+ (/= 0 (nnheader-file-size tofile)))
+ (and (file-exists-p inbox)
+ (/= 0 (nnheader-file-size inbox))))
+ (message "Getting mail from %s..." inbox)))
+ ;; 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))
+ ((and (not movemail) (not popmail))
+ ;; Try copying. If that fails (perhaps no space),
+ ;; rename instead.
+ (condition-case nil
+ (copy-file inbox tofile nil)
+ (error
+ ;; Third arg is t so we can replace existing file TOFILE.
+ (rename-file inbox tofile t)))
+ (push inbox nnmail-moved-inboxes)
+ ;; Make the real inbox file empty.
+ ;; Leaving it deleted could cause lossage
+ ;; because mailers often won't create the file.
+ (condition-case ()
+ (write-region (point) (point) inbox)
+ (file-error nil)))
+ (t
+ ;; Use movemail.
+ (unwind-protect
+ (save-excursion
+ (setq errors (generate-new-buffer " *nnmail loss*"))
+ (buffer-disable-undo errors)
+ (let ((default-directory "/"))
+ (if (nnheader-functionp nnmail-movemail-program)
+ (funcall nnmail-movemail-program inbox tofile)
+ (apply
+ 'call-process
+ (append
+ (list
+ (expand-file-name nnmail-movemail-program
+ exec-directory)
+ nil errors nil inbox tofile)
+ (when nnmail-internal-password
+ (list nnmail-internal-password))))))
+ (if (not (buffer-modified-p errors))
+ ;; No output => movemail won
+ (progn
+ (or popmail
+ (set-file-modes tofile nnmail-default-file-modes))
+ (push inbox nnmail-moved-inboxes))
+ (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
+ (or popmail
+ (set-file-modes tofile nnmail-default-file-modes))
+ (push inbox nnmail-moved-inboxes))
+ ;; Probably a real error.
+ (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. Continue? "
+ (buffer-string)))
+ (error "%s" (buffer-string)))
+ (setq tofile nil)))))))
+ (and errors
+ (buffer-name errors)
+ (kill-buffer errors))
+ tofile))))
(defun nnmail-get-active ()
"Returns an assoc of group names and active ranges.
(defun nnmail-save-active (group-assoc file-name)
"Save GROUP-ASSOC in ACTIVE-FILE."
(when file-name
- (let (group)
- (save-excursion
- (set-buffer (get-buffer-create " *nnmail active*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (while group-assoc
- (setq group (pop group-assoc))
- (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) )
- (car (car (cdr group))))))
- (unless (file-exists-p (file-name-directory file-name))
- (make-directory (file-name-directory file-name) t))
- (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
- (kill-buffer (current-buffer))))))
+ (nnheader-temp-write file-name
+ (nnmail-generate-active group-assoc))))
+
+(defun nnmail-generate-active (alist)
+ "Generate an active file from group-alist ALIST."
+ (erase-buffer)
+ (let (group)
+ (while (setq group (pop alist))
+ (insert (format "%s %d %d y\n" (car group) (cdadr group)
+ (caadr group))))))
(defun nnmail-get-split-group (file group)
+ "Find out whether this FILE is to be split into GROUP only.
+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)
- (cond (group group)
- ((string-match (concat "^" (expand-file-name
- (file-name-as-directory
- nnmail-procmail-directory))
- "\\([^/]*\\)" nnmail-procmail-suffix "$")
- (expand-file-name file))
- (substring (expand-file-name file)
- (match-beginning 1) (match-end 1)))
- (t
- group))
+ (if (string-match (concat "^" (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)
+(defun nnmail-process-babyl-mail-format (func artnum-func)
(let ((case-fold-search t)
start message-id content-length do-search end)
(while (not (eobp))
"\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
(goto-char (match-end 0))
(delete-region (match-beginning 0) (match-end 0))
- (setq start (point))
- ;; Skip all the headers in case there are more "From "s...
- (or (search-forward "\n\n" nil t)
- (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
- (search-forward "\1f\f"))
+ (narrow-to-region
+ (setq start (point))
+ (progn
+ ;; Skip all the headers in case there are more "From "s...
+ (or (search-forward "\n\n" nil t)
+ (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
+ (search-forward "\1f\f"))
+ (point)))
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
+ (widen)
;; Find the Message-ID header.
(save-excursion
(if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
(setq do-search t)))
;; Go to the beginning of the next article - or to the end
;; of the buffer.
- (if do-search
- (if (re-search-forward "\n\1f" nil t)
- (goto-char (+ 1 (match-beginning 0)))
- (goto-char (- (point-max) 1))))
+ (when do-search
+ (if (re-search-forward "^\1f" nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (1- (point-max)))))
(delete-char 1) ; delete ^_
(save-excursion
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
- (nnmail-check-duplication message-id func)
+ (nnmail-check-duplication message-id func artnum-func)
(setq end (point-max))))
(goto-char end))))
-(defun nnmail-process-unix-mail-format (func)
- (let ((case-fold-search t)
- (delim (concat "^" rmail-unix-mail-delimiter))
+(defun nnmail-search-unix-mail-delim ()
+ "Put point at the beginning of the next Unix mbox message."
+ ;; Algorithm used to find the the next article in the
+ ;; brain-dead Unix mbox format:
+ ;;
+ ;; 1) Search for "^From ".
+ ;; 2) If we find it, then see whether the previous
+ ;; line is blank and the next line looks like a header.
+ ;; Then it's possible that this is a mail delim, and we use it.
+ (let ((case-fold-search nil)
+ found)
+ (while (not found)
+ (if (not (re-search-forward "^From " nil t))
+ (setq found 'no)
+ (beginning-of-line)
+ (when (and (or (bobp)
+ (save-excursion
+ (forward-line -1)
+ (= (following-char) ?\n)))
+ (save-excursion
+ (forward-line 1)
+ (looking-at "[^ \t:]+[ \t]*:")))
+ (setq found 'yes))))
+ (eq found 'yes)))
+
+(defun nnmail-process-unix-mail-format (func artnum-func)
+ (let ((case-fold-search nil)
start message-id content-length end skip head-end)
(goto-char (point-min))
- (if (not (and (re-search-forward delim nil t)
+ (if (not (and (re-search-forward "^From " nil t)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
(error "Error, unknown mail format! (Possibly corrupted.)")
(if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
(setq message-id (match-string 1))
(save-excursion
- (when (re-search-backward "^Message-ID:" nil t)
+ (when (re-search-forward "^Message-ID:" nil t)
(beginning-of-line)
(insert "Original-")))
;; There is no Message-ID here, so we create one.
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
;; Look for a Content-Length header.
(goto-char (point-min))
- (if (not (re-search-forward "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
+ (if (not (re-search-forward
+ "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
(setq content-length nil)
(setq content-length (string-to-int (match-string 1)))
;; We destroy the header, since none of the backends ever
;; having a (possibly) faulty header.
(beginning-of-line)
(insert "X-"))
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
;; Find the end of this article.
(goto-char (point-max))
(widen)
(setq head-end (point))
- ;; We try the Content-Length value.
+ ;; 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 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.
(when content-length
(forward-line 1)
(setq skip (+ (point) content-length))
- (when (or (= skip (point-max))
- (and (< skip (point-max))
- (goto-char skip)
- (looking-at delim)))
- (setq end skip)))
+ (goto-char skip)
+ (cond ((or (= skip (point-max))
+ (= (1+ skip) (point-max)))
+ (setq end (point-max)))
+ ((looking-at "From ")
+ (setq end skip))
+ ((looking-at "[ \t]*\n\\(From \\)")
+ (setq end (match-beginning 1)))
+ (t (setq end nil))))
(if end
(goto-char end)
;; No Content-Length, so we find the beginning of the next
;; article or the end of the buffer.
(goto-char head-end)
- (if (re-search-forward delim nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))
+ (or (nnmail-search-unix-mail-delim)
+ (goto-char (point-max))))
;; Allow the backend to save the article.
(save-excursion
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
- (nnmail-check-duplication message-id func)
+ (nnmail-check-duplication message-id func artnum-func)
(setq end (point-max))))
(goto-char end)))))
-(defun nnmail-process-mmdf-mail-format (func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func)
(let ((delim "^\^A\^A\^A\^A$")
(case-fold-search t)
start message-id end)
(insert "Original-")))
(forward-line 1)
(insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
+ (run-hooks 'nnmail-prepare-incoming-header-hook)
;; Find the end of this article.
(goto-char (point-max))
(widen)
(save-restriction
(narrow-to-region start (point))
(goto-char (point-min))
- (nnmail-check-duplication message-id func)
+ (nnmail-check-duplication message-id func artnum-func)
(setq end (point-max))))
(goto-char end)
(forward-line 2)))))
-(defun nnmail-split-incoming (incoming func &optional exit-func group)
+(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
nnmail-use-procmail)
(not nnmail-resplit-incoming))
(list (list group ""))
- nnmail-split-methods))
- start end do-search message-id)
+ nnmail-split-methods)))
(save-excursion
- ;; Open the message-id cache.
- (nnmail-cache-open)
;; Insert the incoming file.
(set-buffer (get-buffer-create " *nnmail incoming*"))
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-file-contents incoming)
- (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
- ;; fetches from a file.
- (cond ((or (looking-at "\^L")
- (looking-at "BABYL OPTIONS:"))
- (nnmail-process-babyl-mail-format func))
- ((looking-at "\^A\^A\^A\^A")
- (nnmail-process-mmdf-mail-format func))
- (t
- (nnmail-process-unix-mail-format func)))
- ;; Close the message-id cache.
- (nnmail-cache-close)
- (if exit-func (funcall exit-func))
+ (nnheader-insert-file-contents-literally 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
+ ;; fetches 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)))))
;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
;; If there is only just one group to put everything in, we
;; just return a list with just this one method in.
(setq group-art
- (list (cons (car (car methods))
- (funcall func (car (car methods))))))
+ (list (cons (caar methods) (funcall func (caar methods)))))
;; We do actual comparison.
(save-excursion
;; Find headers.
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
+ ;; Allow washing.
+ (run-hooks 'nnmail-split-hook)
(if (and (symbolp nnmail-split-methods)
(fboundp nnmail-split-methods))
;; `nnmail-split-methods' is a function, so we just call
(mapcar
(lambda (group) (cons group (funcall func group)))
(condition-case nil
- (funcall nnmail-split-methods)
+ (or (funcall nnmail-split-methods)
+ '("bogus"))
(error
(message
"Error in `nnmail-split-methods'; using `bogus' mail group")
(if (or methods
(not (equal "" (nth 1 method))))
(when (and
- (condition-case ()
+ (condition-case ()
(if (stringp (nth 1 method))
- (re-search-backward (car (cdr method)) nil t)
+ (re-search-backward (cadr method) nil t)
;; Function to say whether this is a match.
(funcall (nth 1 method) (car method)))
(error nil))
;; Don't enter the article into the same
;; group twice.
(not (assoc (car method) group-art)))
- (push (cons (car method) (funcall func (car method)))
+ (push (cons (car method) (funcall func (car method)))
group-art))
;; This is the final group, which is used as a
;; catch-all.
(unless group-art
(setq group-art
- (list (cons (car method)
+ (list (cons (car method)
(funcall func (car method)))))))))
- group-art))))
+ ;; See whether the split methods returned `junk'.
+ (if (equal group-art '(junk))
+ nil
+ (nreverse (delq 'junk group-art)))))))
(defun nnmail-insert-lines ()
"Insert how many lines there are in the body of the mail.
(let (lines chars)
(save-excursion
(goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (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))))
"Insert an Xref line based on the (group . article) alist."
(save-excursion
(goto-char (point-min))
- (when (search-forward "\n\n" nil t)
+ (when (search-forward "\n\n" nil t)
(forward-char -1)
- (if (re-search-backward "^Xref: " nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
+ (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" (car (car group-alist))
- (cdr (car group-alist))))
+ (insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
(setq group-alist (cdr group-alist)))
(insert "\n"))))
+;;; Message washing functions
+
+(defun nnmail-remove-leading-whitespace ()
+ "Remove excessive whitespace from all headers."
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
+ (replace-match "\\1" t t)))
+
+(defun nnmail-remove-list-identifiers ()
+ "Remove list identifiers from Subject headers."
+ (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
+ (mapconcat 'identity nnmail-list-identifiers "\\|"))))
+ (when regexp
+ (goto-char (point-min))
+ (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))
+
+;;; Utility functions
+
;; Written by byer@mv.us.adobe.com (Scott Byer).
(defun nnmail-make-complex-temp-name (prefix)
(let ((newname (make-temp-name prefix))
(defun nnmail-split-fancy ()
"Fancy splitting method.
See the documentation for the variable `nnmail-split-fancy' for documentation."
- (nnmail-split-it nnmail-split-fancy))
+ (let ((syntab (syntax-table)))
+ (unwind-protect
+ (progn
+ (set-syntax-table nnmail-split-fancy-syntax-table)
+ (nnmail-split-it nnmail-split-fancy))
+ (set-syntax-table syntab))))
(defvar nnmail-split-cache nil)
;; Alist of split expressions their equivalent regexps.
(defun nnmail-split-it (split)
;; Return a list of groups matching SPLIT.
- (cond ((stringp split)
- ;; A group.
- (list split))
- ((eq (car split) '&)
- (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
- ((eq (car split) '|)
- (let (done)
- (while (and (not done) (cdr split))
- (setq split (cdr split)
- done (nnmail-split-it (car split))))
- done))
- ((assq split nnmail-split-cache)
- ;; A compiled match expression.
- (goto-char (point-max))
- (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
- (nnmail-split-it (nth 2 split))))
- (t
- ;; An uncompiled match.
- (let* ((field (nth 0 split))
- (value (nth 1 split))
- (regexp (concat "^\\("
- (if (symbolp field)
- (cdr (assq field
- nnmail-split-abbrev-alist))
- field)
- "\\):.*\\<\\("
- (if (symbolp value)
- (cdr (assq value
- nnmail-split-abbrev-alist))
- value)
- "\\>\\)")))
- (setq nnmail-split-cache
- (cons (cons split regexp) nnmail-split-cache))
- (goto-char (point-max))
- (if (re-search-backward regexp nil t)
- (nnmail-split-it (nth 2 split)))))))
+ (cond
+ ((stringp split)
+ ;; A group.
+ (list split))
+ ((eq split 'junk)
+ ;; Junk this.
+ (list 'junk))
+ ((eq (car split) '&)
+ (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+ ((eq (car split) '|)
+ (let (done)
+ (while (and (not done) (cdr split))
+ (setq split (cdr split)
+ done (nnmail-split-it (car split))))
+ done))
+ ((assq split nnmail-split-cache)
+ ;; A compiled match expression.
+ (goto-char (point-max))
+ (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
+ (nnmail-split-it (nth 2 split))))
+ (t
+ ;; An uncompiled match.
+ (let* ((field (nth 0 split))
+ (value (nth 1 split))
+ (regexp (concat "^\\("
+ (if (symbolp field)
+ (cdr (assq field nnmail-split-abbrev-alist))
+ field)
+ "\\):.*\\<\\("
+ (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ "\\)\\>")))
+ (push (cons split regexp) nnmail-split-cache)
+ (goto-char (point-max))
+ (when (re-search-backward regexp nil t)
+ (nnmail-split-it (nth 2 split)))))))
;; Get a list of spool files to read.
(defun nnmail-get-spool-files (&optional group)
nnmail-use-procmail)
(directory-files
nnmail-procmail-directory
- t (concat (if group group "")
- nnmail-procmail-suffix "$") t)))
+ t (concat (if group (concat "^" group) "")
+ nnmail-procmail-suffix "$"))))
(p procmails)
(crash (when (and (file-exists-p nnmail-crash-box)
- (> (nth 7 (file-attributes
- (file-truename nnmail-crash-box))) 0))
+ (> (nnheader-file-size
+ (file-truename nnmail-crash-box))
+ 0))
(list nnmail-crash-box))))
- ;; Remove any directories that inadvertantly match the procmail
+ ;; Remove any directories that inadvertently match the procmail
;; suffix, which might happen if the suffix is "".
(while p
(when (file-directory-p (car p))
crash
(cond ((and group
(or (eq nnmail-spool-file 'procmail)
- nnmail-use-procmail))
+ nnmail-use-procmail)
+ procmails)
procmails)
+ ((and group
+ (eq nnmail-spool-file 'procmail))
+ nil)
((listp nnmail-spool-file)
- (append nnmail-spool-file procmails))
- ((stringp nnmail-spool-file)
+ (nconc
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (file)
+ (if (file-directory-p file)
+ (nnheader-directory-regular-files file)
+ (list file)))
+ nnmail-spool-file))
+ procmails))
+ ((and (stringp nnmail-spool-file)
+ (not (file-directory-p nnmail-spool-file)))
(cons nnmail-spool-file procmails))
+ ((and (stringp nnmail-spool-file)
+ (file-directory-p nnmail-spool-file))
+ (nconc
+ (nnheader-directory-regular-files nnmail-spool-file)
+ procmails))
((eq nnmail-spool-file 'pop)
(cons (format "po:%s" (user-login-name)) procmails))
(t
(save-excursion
(or (eq timestamp 'none)
(set (intern (format "%s-active-timestamp" backend))
- (current-time)))
+;;; dmoore@ucsd.edu 25.10.96
+;;; it's not always the case that current-time
+;;; does correspond to changes in the file's time. So just compare
+;;; the file's new time against its own previous time.
+;;; (current-time)
+ file-time
+ ))
(funcall (intern (format "%s-request-list" backend)))
- (set (intern (format "%s-group-alist" backend))
- (nnmail-get-active))))
+;;; dmoore@ucsd.edu 25.10.96
+;;; BACKEND-request-list already does this itself!
+;;; (set (intern (format "%s-group-alist" backend))
+;;; (nnmail-get-active))
+ ))
t))
(defun nnmail-message-id ()
- (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>"))
-
-(defvar nnmail-unique-id-char nil)
-
-(defun nnmail-number-base36 (num len)
- (if (if (< len 0) (<= num 0) (= len 0))
- ""
- (concat (nnmail-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-(defun nnmail-unique-id ()
- (setq nnmail-unique-id-char
- (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (if (fboundp 'current-time)
- (current-time) '(12191 46742 287898))))
- (concat
- (nnmail-number-base36 (+ (car tm)
- (lsh (% nnmail-unique-id-char 25) 16)) 4)
- (nnmail-number-base36 (+ (nth 1 tm)
- (lsh (/ nnmail-unique-id-char 25) 16)) 4))))
+ (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
;;;
;;; nnmail duplicate handling
(setq nnmail-cache-buffer
(get-buffer-create " *nnmail message-id cache*")))
(buffer-disable-undo (current-buffer))
- (and (file-exists-p nnmail-message-id-cache-file)
- (insert-file-contents nnmail-message-id-cache-file))
+ (when (file-exists-p nnmail-message-id-cache-file)
+ (insert-file-contents nnmail-message-id-cache-file))
+ (set-buffer-modified-p nil)
(current-buffer))))
(defun nnmail-cache-close ()
(set-buffer nnmail-cache-buffer)
;; Weed out the excess number of Message-IDs.
(goto-char (point-max))
- (and (search-backward "\n" nil t nnmail-message-id-cache-length)
- (progn
- (beginning-of-line)
- (delete-region (point-min) (point))))
+ (when (search-backward "\n" nil t nnmail-message-id-cache-length)
+ (progn
+ (beginning-of-line)
+ (delete-region (point-min) (point))))
;; Save the buffer.
(or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
(make-directory (file-name-directory nnmail-message-id-cache-file)
t))
- (write-region (point-min) (point-max)
- nnmail-message-id-cache-file nil 'silent)
- (set-buffer-modified-p nil))))
+ (nnmail-write-region (point-min) (point-max)
+ nnmail-message-id-cache-file nil 'silent)
+ (set-buffer-modified-p nil)
+ (setq nnmail-cache-buffer nil)
+ ;;(kill-buffer (current-buffer))
+ )))
(defun nnmail-cache-insert (id)
(when nnmail-treat-duplicates
(goto-char (point-max))
(search-backward id nil t))))
-(defun nnmail-check-duplication (message-id func)
+(defun nnmail-check-duplication (message-id func artnum-func)
+ (run-hooks 'nnmail-prepare-incoming-message-hook)
;; If this is a duplicate message, then we do not save it.
(let* ((duplication (nnmail-cache-id-exists-p message-id))
+ (case-fold-search t)
(action (when duplication
(cond
((memq nnmail-treat-duplicates '(warn delete))
((nnheader-functionp nnmail-treat-duplicates)
(funcall nnmail-treat-duplicates message-id))
(t
- nnmail-treat-duplicates)))))
+ nnmail-treat-duplicates))))
+ group-art)
+ ;; Let the backend save the article (or not).
(cond
((not duplication)
(nnmail-cache-insert message-id)
- (funcall func))
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func)))))
((eq action 'delete)
- (delete-region (point-min) (point-max)))
+ (setq group-art nil))
((eq action 'warn)
;; We insert a warning.
(let ((case-fold-search t)
(beginning-of-line)
(insert "Original-"))
(beginning-of-line)
- (insert "Message-ID: " newid "\n")
- (insert "Gnus-Warning: This is a duplication of message "
- message-id "\n")
+ (insert
+ "Message-ID: " newid "\n"
+ "Gnus-Warning: This is a duplicate of message " message-id "\n")
(nnmail-cache-insert newid)
- (funcall func)))
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func))))))
(t
- (funcall func)))))
+ (funcall func (setq group-art
+ (nreverse (nnmail-article-group artnum-func))))))
+ ;; Add the group-art list to the history list.
+ (if group-art
+ (push group-art nnmail-split-history)
+ (delete-region (point-min) (point-max)))))
;;; Get new mail.
(defun nnmail-get-new-mail (method exit-func temp
&optional group spool-func)
"Read new incoming mail."
+ ;; Nix out the previous split history.
+ (unless group
+ (setq nnmail-split-history nil))
(let* ((spools (nnmail-get-spool-files group))
(group-in group)
incoming incomings spool)
(nnmail-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 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
- ;; existance of POPped mail.
+ ;; existence of POPped mail.
(when (or (string-match "^po:" spool)
(and (file-exists-p spool)
- (> (nth 7 (file-attributes (file-truename spool))) 0)))
+ (> (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 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)
+ 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
(funcall exit-func))
(run-hooks 'nnmail-read-incoming-hook)
(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)
;; Delete all the temporary files.
(setq days (nnmail-days-to-time days))
;; Compare the time with the current time.
(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 (load "passwd" t)
+ (setq nnmail-read-passwd '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."
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((case-fold-search t))
+ (unless (re-search-forward "^Message-ID:" nil t)
+ (insert "Message-ID: " (nnmail-message-id) "\n")))))
+
+(defun nnmail-write-region (start end filename &optional append visit lockname)
+ "Do a `write-region', and then set the file modes."
+ (write-region start end filename append visit lockname)
+ (set-file-modes filename nnmail-default-file-modes))
+
+;;;
+;;; Status functions
+;;;
+
+(defun nnmail-replace-status (name value)
+ "Make status NAME and VALUE part of the current status line."
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((status (nnmail-decode-status)))
+ (setq status (delq (member name status) status))
+ (when value
+ (push (cons name value) status))
+ (message-remove-header "status")
+ (goto-char (point-max))
+ (insert "Status: " (nnmail-encode-status status) "\n"))))
+
+(defun nnmail-decode-status ()
+ "Return a status-value alist from STATUS."
+ (goto-char (point-min))
+ (when (re-search-forward "^Status: " nil t)
+ (let (name value status)
+ (save-restriction
+ ;; Narrow to the status.
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (1- (point))
+ (point-max)))
+ ;; Go through all elements and add them to the list.
+ (goto-char (point-min))
+ (while (re-search-forward "[^ \t=]+" nil t)
+ (setq name (match-string 0))
+ (if (not (= (following-char) ?=))
+ ;; Implied "yes".
+ (setq value "yes")
+ (forward-char 1)
+ (if (not (= (following-char) ?\"))
+ (if (not (looking-at "[^ \t]"))
+ ;; Implied "no".
+ (setq value "no")
+ ;; Unquoted value.
+ (setq value (match-string 0))
+ (goto-char (match-end 0)))
+ ;; Quoted value.
+ (setq value (read (current-buffer)))))
+ (push (cons name value) status)))
+ status)))
+
+(defun nnmail-encode-status (status)
+ "Return a status string from STATUS."
+ (mapconcat
+ (lambda (elem)
+ (concat
+ (car elem) "="
+ (if (string-match "[ \t]" (cdr elem))
+ (prin1-to-string (cdr elem))
+ (cdr elem))))
+ status " "))
+
+(defun nnmail-split-history ()
+ "Generate an overview of where the last mail split put articles."
+ (interactive)
+ (unless nnmail-split-history
+ (error "No current split history"))
+ (pop-to-buffer "*nnmail split history*")
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (let ((history nnmail-split-history)
+ elem ga)
+ (while (setq elem (pop history))
+ (insert (mapconcat (lambda (ga)
+ (concat (car ga) ":" (int-to-string (cdr ga))))
+ elem
+ ", ")
+ "\n"))
+ (goto-char (point-min))))
+
+(defun nnmail-new-mail-p (group)
+ "Say whether GROUP has new mail."
+ (let ((his nnmail-split-history)
+ found)
+ (while his
+ (when (assoc group (pop his))
+ (setq found t
+ his nil)))
+ found))
+
+(run-hooks 'nnmail-load-hook)
(provide 'nnmail)
projects / gnus / blobdiff