;;; nnmail.el --- mail support functions for the Gnus mail backends
;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
(require 'timezone)
(require 'message)
(require 'custom)
+(require 'gnus-util)
(eval-and-compile
- (autoload 'gnus-error "gnus-util"))
+ (autoload 'gnus-error "gnus-util")
+ (autoload 'gnus-buffer-live-p "gnus-util")
+ (autoload 'gnus-encode-coding-string "gnus-ems"))
(defgroup nnmail nil
"Reading mail with Gnus."
;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(defcustom nnmail-crosspost t
- "*If non-nil, do crossposting if several split methods match the mail.
+ "If non-nil, do crossposting if several split methods match the mail.
If nil, the first match found will be used."
:group 'nnmail-split
:type 'boolean)
;; 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.
+ "If non-nil, nnmail will never delete/move a group's last article.
It can be marked expirable, so it will be deleted when it is no longer last.
You may need to set this variable if other programs are putting
:type 'boolean)
(defcustom nnmail-use-long-file-names nil
- "*If non-nil the mail backends will use long file and directory names.
+ "If non-nil the mail backends will use long file and directory names.
If nil, groups like \"mail.misc\" will end up in directories like
\"mail/misc/\"."
:group 'nnmail-files
:type 'boolean)
(defcustom nnmail-default-file-modes 384
- "*Set the mode bits of all new mail files to this integer."
+ "Set the mode bits of all new mail files to this integer."
:group 'nnmail-files
:type 'integer)
(const never)))
(defcustom nnmail-expiry-wait-function nil
- "*Variable that holds function to specify how old articles should be before they are expired.
+ "Variable that holds function to specify how old articles should be before they are expired.
The function will be called with the name of the group that the
expiry is to be performed in, and it should return an integer that
says how many days an article can be stored before it is considered
(function :format "%v" nnmail-)))
(defcustom nnmail-cache-accepted-message-ids nil
- "*If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
+ "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
:group 'nnmail
:type 'boolean)
:type 'file)
(defcustom nnmail-crash-box "~/.gnus-crash-box"
- "*File where Gnus will store mail while processing it."
+ "File where Gnus will store mail while processing it."
:group 'nnmail-files
:type 'file)
:type 'boolean)
(defcustom nnmail-delete-file-function 'delete-file
- "*Function called to delete files in some mail backends."
+ "Function called to delete files in some mail backends."
:group 'nnmail-files
:type 'function)
(defcustom nnmail-crosspost-link-function
- (if (string-match "windows-nt\\|emx" (format "%s" system-type))
+ (if (string-match "windows-nt\\|emx" (symbol-name system-type))
'copy-file
'add-name-to-file)
"*Function called to create a copy of a file.
;; Suggested by Erik Selberg <speed@cs.washington.edu>.
(defcustom nnmail-prepare-incoming-hook nil
- "*Hook called before treating incoming mail.
+ "Hook called before treating incoming mail.
The hook is run in a buffer with all the new, incoming mail."
:group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-prepare-incoming-header-hook nil
- "*Hook called narrowed to the headers of each message.
+ "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."
:group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-prepare-incoming-message-hook nil
- "*Hook called narrowed to each message."
+ "Hook called narrowed to each message."
:group 'nnmail-prepare
:type 'hook)
(defcustom nnmail-list-identifiers nil
- "*Regexp that matches list identifiers to be removed.
+ "Regexp that matches list identifiers to be removed.
This can also be a list of regexps."
:group 'nnmail-prepare
:type '(choice (const :tag "none" nil)
(repeat :value (".*") regexp)))
(defcustom nnmail-pre-get-new-mail-hook nil
- "*Hook called just before starting to handle new incoming mail."
+ "Hook called just before starting to handle new incoming mail."
:group 'nnmail-retrieve
:type 'hook)
(defcustom nnmail-post-get-new-mail-hook nil
- "*Hook called just after finishing handling new incoming mail."
+ "Hook called just after finishing handling new incoming mail."
:group 'nnmail-retrieve
:type 'hook)
(defcustom nnmail-split-hook nil
- "*Hook called before deciding where to split an article.
+ "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."
:type 'integer)
(defcustom nnmail-split-fancy "mail.misc"
- "*Incoming mail can be split according to this fancy variable.
+ "Incoming mail can be split according to this fancy variable.
To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
-The format is this variable is SPLIT, where SPLIT can be one of
+The format of this variable is SPLIT, where SPLIT can be one of
the following:
GROUP: Mail will be stored in GROUP (a string).
:group 'nnmail-split
:type '(repeat (cons :format "%v" symbol regexp)))
-(defcustom nnmail-delete-incoming nil
+(defcustom nnmail-delete-incoming t
"*If non-nil, the mail backends will delete incoming files after
splitting."
:group 'nnmail-retrieve
(defvar nnmail-internal-password nil)
+(defvar nnmail-split-tracing nil)
+(defvar nnmail-split-trace nil)
+
\f
(defconst nnmail-version "nnmail 1.0"
"Convert DAYS into time."
(let* ((seconds (* 1.0 days 60 60 24))
(rest (expt 2 16))
- (ms (condition-case nil (round (/ seconds rest))
+ (ms (condition-case nil (floor (/ seconds rest))
(range-error (expt 2 16)))))
(list ms (condition-case nil (round (- seconds (* ms rest)))
(range-error (expt 2 16))))))
(nnmail-read-passwd
(format "Password for %s: "
(substring inbox (+ popmail 3))))))
- (message "Getting mail from the post office..."))
+ (nnheader-message 5 "Getting mail from the post office..."))
(when (or (and (file-exists-p tofile)
(/= 0 (nnheader-file-size tofile)))
(and (file-exists-p inbox)
(/= 0 (nnheader-file-size inbox))))
- (message "Getting mail from %s..." inbox)))
+ (nnheader-message 5 "Getting mail from %s..." inbox)))
;; Set TOFILE if have not already done so, and
;; rename or copy the file INBOX to TOFILE if and as appropriate.
(cond
nil errors nil inbox tofile)
(when nnmail-internal-password
(list nnmail-internal-password)))))))
+ (push inbox nnmail-moved-inboxes)
(if (and (not (buffer-modified-p errors))
(zerop result))
;; No output => movemail won
(progn
(unless popmail
(when (file-exists-p tofile)
- (set-file-modes tofile nnmail-default-file-modes)))
- (push inbox nnmail-moved-inboxes))
+ (set-file-modes tofile nnmail-default-file-modes))))
(set-buffer errors)
;; There may be a warning about older revisions. We
;; ignore those.
(progn
(unless popmail
(when (file-exists-p tofile)
- (set-file-modes tofile nnmail-default-file-modes)))
- (push inbox nnmail-moved-inboxes))
+ (set-file-modes
+ tofile nnmail-default-file-modes))))
;; Probably a real error.
+ ;; We nix out the password in case the error
+ ;; was because of a wrong password being given.
+ (setq nnmail-internal-password nil)
(subst-char-in-region (point-min) (point-max) ?\n ?\ )
(goto-char (point-max))
(skip-chars-backward " \t")
(buffer-string) result))
(error "%s" (buffer-string)))
(setq tofile nil)))))))
- (message "Getting mail from %s...done" inbox)
+ (nnheader-message 5 "Getting mail from %s...done" inbox)
(and errors
(buffer-name errors)
(kill-buffer errors))
group-assoc)))
group-assoc))
-(defvar nnmail-active-file-coding-system
- 'iso-8859-1
+(defvar nnmail-active-file-coding-system 'binary
"*Coding system for active file.")
(defun nnmail-save-active (group-assoc file-name)
is a spool. If not using procmail, return GROUP."
(if (or (eq nnmail-spool-file 'procmail)
nnmail-use-procmail)
- (if (string-match (concat "^" (expand-file-name
- (file-name-as-directory
- nnmail-procmail-directory))
- "\\([^/]*\\)" nnmail-procmail-suffix "$")
+ (if (string-match (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory
+ nnmail-procmail-directory)))
+ "\\([^/]*\\)"
+ nnmail-procmail-suffix "$")
(expand-file-name file))
(let ((procmail-group (substring (expand-file-name file)
(match-beginning 1)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
(progn
- (pop-to-buffer (find-file-noselect nnmail-current-spool))
+ (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))
(forward-line 1)))
;; Possibly wrong format?
(progn
- (pop-to-buffer (find-file-noselect nnmail-current-spool))
+ (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))
(funcall exit-func))
(kill-buffer (current-buffer)))))
-(defun nnmail-article-group (func)
+(defun nnmail-article-group (func &optional trace)
"Look at the headers and return an alist of groups that match.
FUNC will be called with the group name to determine the article number."
(let ((methods nnmail-split-methods)
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(replace-match " " t t))
+ ;; Nuke pathologically long headers. Since Gnus applies
+ ;; pathologically complex regexps to the buffer, lines
+ ;; that are looong will take longer than the Universe's
+ ;; existence to process.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (end-of-line)
+ (if (> (current-column) 1024)
+ (gnus-delete-line)
+ (forward-line 1)))
;; Allow washing.
+ (goto-char (point-min))
(run-hooks 'nnmail-split-hook)
+ (when (setq nnmail-split-tracing trace)
+ (setq nnmail-split-trace nil))
(if (and (symbolp nnmail-split-methods)
(fboundp nnmail-split-methods))
(let ((split
(or (funcall nnmail-split-methods)
'("bogus"))
(error
- (message
+ (nnheader-message 5
"Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1)
'("bogus")))))
- (setq split (remove-duplicates split :test 'equal))
+ (setq split (gnus-remove-duplicates split))
;; The article may be "cross-posted" to `junk'. What
;; to do? Just remove the `junk' spec. Don't really
;; see anything else to do...
(setq group-art
(list (cons (car method)
(funcall func (car method)))))))))
+ ;; Produce a trace if non-empty.
+ (when (and trace nnmail-split-trace)
+ (let ((trace (nreverse nnmail-split-trace))
+ (restore (current-buffer)))
+ (nnheader-set-temp-buffer "*Split Trace*")
+ (gnus-add-current-to-buffer-list)
+ (while trace
+ (insert (car trace) "\n")
+ (setq trace (cdr trace)))
+ (goto-char (point-min))
+ (gnus-configure-windows 'split-trace)
+ (set-buffer restore)))
;; See whether the split methods returned `junk'.
(if (equal group-art '(junk))
nil
(defun nnmail-split-it (split)
;; Return a list of groups matching SPLIT.
- (cond
- ;; nil split
- ((null split)
- nil)
-
- ;; A group name. Do the \& and \N subs into the string.
- ((stringp split)
- (list (nnmail-expand-newtext split)))
-
- ;; Junk the message.
- ((eq split 'junk)
- (list 'junk))
-
- ;; Builtin & operation.
- ((eq (car split) '&)
- (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
-
- ;; Builtin | operation.
- ((eq (car split) '|)
- (let (done)
- (while (and (not done) (cdr split))
- (setq split (cdr split)
- done (nnmail-split-it (car split))))
- done))
-
- ;; Builtin : operation.
- ((eq (car split) ':)
- (nnmail-split-it (save-excursion (eval (cdr split)))))
-
- ;; Check the cache for the regexp for this split.
- ;; FIX FIX FIX could avoid calling assq twice here
- ((assq split nnmail-split-cache)
- (goto-char (point-max))
- ;; FIX FIX FIX problem with re-search-backward is that if you have
- ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
- ;; and someone mails a message with 'To: foo-bar@gnus.org' and
- ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
- ;; if the cc line is a later header, even though the other choice
- ;; is probably better. Also, this routine won't do a crosspost
- ;; when there are two different matches.
- ;; I guess you could just make this more determined, and it could
- ;; look for still more matches prior to this one, and recurse
- ;; on each of the multiple matches hit. Of course, then you'd
- ;; want to make sure that nnmail-article-group or nnmail-split-fancy
- ;; removed duplicates, since there might be more of those.
- ;; I guess we could also remove duplicates in the & split case, since
- ;; that's the only thing that can introduce them.
- (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
- ;; Someone might want to do a \N sub on this match, so get the
- ;; correct match positions.
- (goto-char (match-end 0))
- (let ((value (nth 1 split)))
- (re-search-backward (if (symbolp value)
- (cdr (assq value nnmail-split-abbrev-alist))
- value)
- (match-end 1)))
- (nnmail-split-it (nth 2 split))))
-
- ;; Not in cache, compute a regexp for the field/value pair.
- (t
- (let* ((field (nth 0 split))
- (value (nth 1 split))
- (regexp (concat "^\\(\\("
- (if (symbolp field)
- (cdr (assq field nnmail-split-abbrev-alist))
- field)
- "\\):.*\\)\\<\\("
- (if (symbolp value)
- (cdr (assq value nnmail-split-abbrev-alist))
- value)
- "\\)\\>")))
- (push (cons split regexp) nnmail-split-cache)
- ;; Now that it's in the cache, just call nnmail-split-it again
- ;; on the same split, which will find it immediately in the cache.
- (nnmail-split-it split)))))
+ (let (cached-pair)
+ (cond
+ ;; nil split
+ ((null split)
+ nil)
+
+ ;; A group name. Do the \& and \N subs into the string.
+ ((stringp split)
+ (when nnmail-split-tracing
+ (push (format "\"%s\"" split) nnmail-split-trace))
+ (list (nnmail-expand-newtext split)))
+
+ ;; Junk the message.
+ ((eq split 'junk)
+ (when nnmail-split-tracing
+ (push "junk" nnmail-split-trace))
+ (list 'junk))
+
+ ;; Builtin & operation.
+ ((eq (car split) '&)
+ (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
+
+ ;; Builtin | operation.
+ ((eq (car split) '|)
+ (let (done)
+ (while (and (not done) (cdr split))
+ (setq split (cdr split)
+ done (nnmail-split-it (car split))))
+ done))
+
+ ;; Builtin : operation.
+ ((eq (car split) ':)
+ (nnmail-split-it (save-excursion (eval (cdr split)))))
+
+ ;; Check the cache for the regexp for this split.
+ ((setq cached-pair (assq split nnmail-split-cache))
+ (goto-char (point-max))
+ ;; FIX FIX FIX problem with re-search-backward is that if you have
+ ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
+ ;; and someone mails a message with 'To: foo-bar@gnus.org' and
+ ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
+ ;; if the cc line is a later header, even though the other choice
+ ;; is probably better. Also, this routine won't do a crosspost
+ ;; when there are two different matches.
+ ;; I guess you could just make this more determined, and it could
+ ;; look for still more matches prior to this one, and recurse
+ ;; on each of the multiple matches hit. Of course, then you'd
+ ;; want to make sure that nnmail-article-group or nnmail-split-fancy
+ ;; removed duplicates, since there might be more of those.
+ ;; I guess we could also remove duplicates in the & split case, since
+ ;; that's the only thing that can introduce them.
+ (when (re-search-backward (cdr cached-pair) nil t)
+ (when nnmail-split-tracing
+ (push (cdr cached-pair) nnmail-split-trace))
+ ;; Someone might want to do a \N sub on this match, so get the
+ ;; correct match positions.
+ (goto-char (match-end 0))
+ (let ((value (nth 1 split)))
+ (re-search-backward (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ (match-end 1)))
+ (nnmail-split-it (nth 2 split))))
+
+ ;; Not in cache, compute a regexp for the field/value pair.
+ (t
+ (let* ((field (nth 0 split))
+ (value (nth 1 split))
+ (regexp (concat "^\\(\\("
+ (if (symbolp field)
+ (cdr (assq field nnmail-split-abbrev-alist))
+ field)
+ "\\):.*\\)\\<\\("
+ (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ "\\)\\>")))
+ (push (cons split regexp) nnmail-split-cache)
+ ;; Now that it's in the cache, just call nnmail-split-it again
+ ;; on the same split, which will find it immediately in the cache.
+ (nnmail-split-it split))))))
(defun nnmail-expand-newtext (newtext)
(let ((len (length newtext))
(unless (= beg pos)
(push (substring newtext beg pos) expanded))
(when (< pos len)
- ;; we hit a \, expand it.
- (setq did-expand t)
- (setq pos (1+ pos))
- (setq c (aref newtext pos))
+ ;; We hit a \; expand it.
+ (setq did-expand t
+ pos (1+ pos)
+ c (aref newtext pos))
(if (not (or (= c ?\&)
(and (>= c ?1)
(<= c ?9))))
- ;; \ followed by some character we don't expand
+ ;; \ followed by some character we don't expand.
(push (char-to-string c) expanded)
;; \& or \N
(if (= c ?\&)
(defun nnmail-purge-split-history (group)
"Remove all instances of GROUP from `nnmail-split-history'."
- (let ((history nnmail-split-history)
- prev)
+ (let ((history nnmail-split-history))
(while history
- (setcar history (delete-if (lambda (e) (string= (car e) group))
- (car history)))
+ (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
+ (car history)))
(pop history))
(setq nnmail-split-history (delq nil nnmail-split-history))))
(substring inbox (match-end (string-match "^po:" inbox)))))
(pop3-movemail crashbox)))
+(defun nnmail-within-headers-p ()
+ "Check to see if point is within the headers of a unix mail message.
+Doesn't change point."
+ (let ((pos (point)))
+ (save-excursion
+ (and (nnmail-search-unix-mail-delim-backward)
+ (not (search-forward "\n\n" pos t))))))
+
(run-hooks 'nnmail-load-hook)
(provide 'nnmail)
projects / gnus / blobdiff