;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-;; For Emacs < 22.2.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'mm-util)
(require 'gnus-int)
-(eval-and-compile
- (autoload 'gnus-add-buffer "gnus")
- (autoload 'gnus-kill-buffer "gnus"))
+(autoload 'gnus-add-buffer "gnus")
+(autoload 'gnus-kill-buffer "gnus")
+(autoload 'mail-send-and-exit "sendmail" nil t)
(defgroup nnmail nil
"Reading mail with Gnus."
The last element should always have \"\" as the regexp.
-This variable can also have a function as its value."
+This variable can also have a function as its value, and it can
+also have a fancy split method as its value. See
+`nnmail-split-fancy' for an explanation of that syntax."
:group 'nnmail-split
:type '(choice (repeat :tag "Alist" (group (string :tag "Name")
(choice regexp function)))
many days an article can be stored before it is considered \"old\".
It can also return the values `never' and `immediate'.
-Eg.:
+E.g.:
\(setq nnmail-expiry-wait-function
(lambda (newsgroup)
:version "21.1"
:group 'nnmail-expire
:type '(choice (const delete)
- (function :format "%v" nnmail-)
+ function
string))
(defcustom nnmail-fancy-expiry-targets nil
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
+articles containing the string \"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\"."
:version "22.1"
:group 'nnmail
:type 'boolean)
-(make-obsolete-variable 'nnmail-spool-file
- "This option is obsolete in Gnus 5.9. \
-Use `mail-sources' instead.")
+(make-obsolete-variable 'nnmail-spool-file 'mail-sources
+ "Gnus 5.9 (Emacs 22.1)")
;; revision 5.29 / p0-85 / Gnus 5.9
;; Variable removed in No Gnus v0.7
:type 'function)
(defcustom nnmail-crosspost-link-function
- (if (string-match "windows-nt\\|emx" (symbol-name system-type))
+ (if (string-match "windows-nt" (symbol-name system-type))
'copy-file
'add-name-to-file)
"*Function called to create a copy of a file.
emptied, and can be used to call any mail box programs you have
running (\"xwatch\", etc.)
-Eg.
+E.g.:
-\(add-hook 'nnmail-read-incoming-hook
+\(add-hook \\='nnmail-read-incoming-hook
(lambda ()
(call-process \"/local/bin/mailsend\" nil nil nil
\"read\"
If you use `display-time', you could use something like this:
-\(add-hook 'nnmail-read-incoming-hook
+\(add-hook \\='nnmail-read-incoming-hook
(lambda ()
;; Update the displayed time, since that will clear out
;; the flag that says you have mail.
- (when (eq (process-status \"display-time\") 'run)
+ (when (eq (process-status \"display-time\") \\='run)
(display-time-filter display-time-process \"\"))))"
:group 'nnmail-prepare
:type 'hook)
(number :tag "count")))
(define-widget 'nnmail-lazy 'default
- "Base widget for recursive datastructures.
+ "Base widget for recursive data structures.
This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
:format "%{%t%}: %v"
Example:
-\(setq nnmail-split-methods 'nnmail-split-fancy
+\(setq nnmail-split-methods \\='nnmail-split-fancy
nnmail-split-fancy
;; 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\")
+ \\='(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
\"mail.misc\"))
;; Non-error messages are crossposted to all relevant
;; groups, but we don't crosspost between the group for the
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers '(To Newsgroups)
- "*Extra headers to parse."
- :version "21.1"
+(defcustom nnmail-extra-headers '(To Newsgroups Cc)
+ "Extra headers to parse.
+In addition to the standard headers, these extra headers will be
+included in NOV headers (and the like) when backends parse headers."
+ :version "24.3"
:group 'nnmail
:type '(repeat symbol))
(defvar nnmail-split-tracing nil)
(defvar nnmail-split-trace nil)
+(defvar nnmail-inhibit-default-split-group nil)
\f
mm-text-coding-system
"Coding system used in reading inbox")
-(defvar nnmail-pathname-coding-system nil
+(defvar nnmail-pathname-coding-system
+ ;; This causes Emacs 22.2 and 22.3 to issue a useless warning.
+ ;;(if (and (featurep 'xemacs) (featurep 'file-coding))
+ (if (featurep 'xemacs)
+ (if (featurep 'file-coding)
+ ;; Work around a bug in many XEmacs 21.5 betas.
+ ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134
+ (setq file-name-coding-system (coding-system-aliasee 'file-name))))
"*Coding system for file name.")
(defun nnmail-find-file (file)
"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)
+ (with-current-buffer nntp-server-buffer
(nnmail-parse-active)))
(defun nnmail-parse-active ()
(goto-char end)))
count))
-(defun nnmail-process-mmdf-mail-format (func artnum-func)
+(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
(let ((delim "^\^A\^A\^A\^A$")
(case-fold-search t)
(count 0)
(narrow-to-region start (point))
(goto-char (point-min))
(incf count)
- (nnmail-check-duplication message-id func artnum-func)
+ (nnmail-check-duplication message-id func artnum-func junk-func)
(setq end (point-max))))
(goto-char end)
(forward-line 2)))
"Non-nil means group names are not encoded.")
(defun nnmail-split-incoming (incoming func &optional exit-func
- group artnum-func)
+ group artnum-func junk-func)
"Go through the entire INCOMING file and pick out each individual mail.
-FUNC will be called with the buffer narrowed to each mail."
+FUNC will be called with the buffer narrowed to each mail.
+INCOMING can also be a buffer object. In that case, the mail
+will be copied over from that buffer."
(let ( ;; If this is a group-specific split, we bind the split
;; methods to just this group.
(nnmail-split-methods (if (and group
(list (list group ""))
nnmail-split-methods))
(nnmail-group-names-not-encoded-p t))
- (save-excursion
- ;; Insert the incoming file.
- (set-buffer (get-buffer-create nnmail-article-buffer))
+ ;; Insert the incoming file.
+ (with-current-buffer (get-buffer-create nnmail-article-buffer)
(erase-buffer)
- (let ((coding-system-for-read nnmail-incoming-coding-system))
- (mm-insert-file-contents incoming))
+ (if (bufferp incoming)
+ (insert-buffer-substring incoming)
+ (let ((coding-system-for-read nnmail-incoming-coding-system))
+ (mm-insert-file-contents incoming)))
(prog1
(if (zerop (buffer-size))
0
(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))
+ (nnmail-process-mmdf-mail-format
+ func artnum-func junk-func))
((looking-at "Return-Path:")
(nnmail-process-maildir-mail-format func artnum-func))
(t
(funcall exit-func))
(kill-buffer (current-buffer))))))
-(defun nnmail-article-group (func &optional trace)
+(defun nnmail-article-group (func &optional trace junk-func)
"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" ""))))
(obuf (current-buffer))
group-art method grp)
(if (and (sequencep methods)
- (= (length methods) 1))
+ (= (length methods) 1)
+ (not nnmail-inhibit-default-split-group))
;; 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 (caar methods) (funcall func (caar methods)))))
;; We do actual comparison.
- (save-excursion
- ;; Copy the article into the work buffer.
- (set-buffer nntp-server-buffer)
+ ;; Copy the article into the work buffer.
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring obuf)
;; Narrow to headers.
(run-hooks 'nnmail-split-hook)
(when (setq nnmail-split-tracing trace)
(setq nnmail-split-trace nil))
- (if (and (symbolp nnmail-split-methods)
- (fboundp nnmail-split-methods))
- (let ((split
- (condition-case error-info
- ;; `nnmail-split-methods' is a function, so we
- ;; just call this function here and use the
- ;; result.
- (or (funcall nnmail-split-methods)
- '("bogus"))
- (error
- (nnheader-message
- 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
- (sit-for 1)
- '("bogus")))))
+ (if (or (and (symbolp nnmail-split-methods)
+ (fboundp nnmail-split-methods))
+ (not (consp (car-safe nnmail-split-methods)))
+ (and (listp nnmail-split-methods)
+ ;; Not a regular split method, so it has to be a
+ ;; fancy one.
+ (not (let ((top-element (car-safe nnmail-split-methods)))
+ (and (= 2 (length top-element))
+ (stringp (nth 0 top-element))
+ (stringp (nth 1 top-element)))))))
+ (let* ((method-function
+ (if (and (symbolp nnmail-split-methods)
+ (fboundp nnmail-split-methods))
+ nnmail-split-methods
+ 'nnmail-split-fancy))
+ (split
+ (condition-case error-info
+ ;; `nnmail-split-methods' is a function, so we
+ ;; just call this function here and use the
+ ;; result.
+ (or (funcall method-function)
+ (and (not nnmail-inhibit-default-split-group)
+ '("bogus")))
+ (error
+ (nnheader-message
+ 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
+ (sit-for 1)
+ '("bogus")))))
(setq split (mm-delete-duplicates split))
;; The article may be "cross-posted" to `junk'. What
;; to do? Just remove the `junk' spec. Don't really
;; see anything else to do...
- (let (elem)
- (while (setq elem (car (memq 'junk split)))
- (setq split (delq elem split))))
+ (when (and (memq 'junk split)
+ junk-func)
+ (funcall junk-func 'junk))
+ (setq split (delq 'junk split))
(when split
(setq group-art
(mapcar
group-art))
;; This is the final group, which is used as a
;; catch-all.
- (unless group-art
+ (when (and (not group-art)
+ (or (equal "" (nth 1 method))
+ (not nnmail-inhibit-default-split-group)))
(setq group-art
(list (cons (car method)
(funcall func (car method))))))))
;; Fall back on "bogus" if all else fails.
- (unless group-art
+ (when (and (not group-art)
+ (not nnmail-inhibit-default-split-group))
(setq group-art (list (cons "bogus" (funcall func "bogus"))))))
;; Produce a trace if non-empty.
(when (and trace nnmail-split-trace)
"Header line matching mailer producing bogus References lines.
See `nnmail-ignore-broken-references'."
:group 'nnmail-prepare
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type 'regexp)
(defun nnmail-ignore-broken-references ()
(replace-match "\\1" t))))
(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
-(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1")
(custom-add-option 'nnmail-prepare-incoming-header-hook
'nnmail-ignore-broken-references)
;;; Utility functions
(declare-function gnus-activate-group "gnus-start"
- (group &optional scan dont-check method))
+ (group &optional scan dont-check method dont-sub-check))
(defun nnmail-do-request-post (accept-func &optional server)
"Utility function to directly post a message to an nnmail-derived group.
((stringp split)
(when nnmail-split-tracing
(push split nnmail-split-trace))
- (list (nnmail-expand-newtext split)))
+ (list (nnmail-expand-newtext split t)))
;; Junk the message.
((eq split 'junk)
;; Check the cache for the regexp for this split.
((setq cached-pair (assq split nnmail-split-cache))
(let (split-result
+ match-data
(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))
+ (setq match-data (match-data))
(when nnmail-split-tracing
(push split nnmail-split-trace))
(let ((split-rest (cddr split))
(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))
+ ;; Someone might want to do a \N sub on this match, so
+ ;; restore the match data.
+ (set-match-data match-data)
(dolist (sp (nnmail-split-it (car split-rest)))
(unless (member sp split-result)
(push sp split-result))))))
;; on the same split, which will find it immediately in the cache.
(nnmail-split-it split))))))
-(defun nnmail-expand-newtext (newtext)
+(defun nnmail-expand-newtext (newtext &optional fancyp)
(let ((len (length newtext))
(pos 0)
c expanded beg N did-expand)
(if (= c ?\&)
(setq N 0)
(setq N (- c ?0)))
+ ;; We wrapped the searches in parentheses, so we have to
+ ;; add some parentheses here...
+ (when fancyp
+ (setq N (+ N 3)))
(when (match-beginning N)
(push (if nnmail-split-lowercase-expanded
(downcase (buffer-substring (match-beginning N)
(and nnmail-cache-buffer
(buffer-name nnmail-cache-buffer)))
() ; The buffer is open.
- (save-excursion
- (set-buffer
+ (with-current-buffer
(setq nnmail-cache-buffer
- (get-buffer-create " *nnmail message-id cache*")))
+ (get-buffer-create " *nnmail message-id cache*"))
(gnus-add-buffer)
(when (file-exists-p nnmail-message-id-cache-file)
(nnheader-insert-file-contents nnmail-message-id-cache-file))
nnmail-treat-duplicates
(buffer-name nnmail-cache-buffer)
(buffer-modified-p nnmail-cache-buffer))
- (save-excursion
- (set-buffer nnmail-cache-buffer)
+ (with-current-buffer nnmail-cache-buffer
;; Weed out the excess number of Message-IDs.
(goto-char (point-max))
(when (search-backward "\n" nil t nnmail-message-id-cache-length)
(setq nnmail-cache-buffer nil)
(gnus-kill-buffer (current-buffer)))))
-;; Compiler directives.
-(defvar group)
-(defvar group-art-list)
-(defvar group-art)
(defun nnmail-cache-insert (id grp &optional subject sender)
(when (stringp id)
;; this will handle cases like `B r' where the group is nil
;; 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)
+ (with-current-buffer nnmail-cache-buffer
(goto-char (point-max))
(if (and grp (not (string= "" grp))
(gnus-methods-equal-p gnus-command-method
;; cache.
(defun nnmail-cache-fetch-group (id)
(when (and nnmail-treat-duplicates nnmail-cache-buffer)
- (save-excursion
- (set-buffer nnmail-cache-buffer)
+ (with-current-buffer nnmail-cache-buffer
(goto-char (point-max))
(when (search-backward id nil t)
(beginning-of-line)
(defun nnmail-cache-id-exists-p (id)
(when nnmail-treat-duplicates
- (save-excursion
- (set-buffer nnmail-cache-buffer)
+ (with-current-buffer nnmail-cache-buffer
(goto-char (point-max))
(search-backward id nil t))))
(message-narrow-to-head)
(message-fetch-field header))))
-(defun nnmail-check-duplication (message-id func artnum-func)
+(defun nnmail-check-duplication (message-id func artnum-func
+ &optional junk-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))
(cond
((not duplication)
(funcall func (setq group-art
- (nreverse (nnmail-article-group artnum-func))))
+ (nreverse (nnmail-article-group
+ artnum-func nil junk-func))))
(nnmail-cache-insert message-id (caar group-art)))
((eq action 'delete)
(setq group-art nil))
(i 0)
(new 0)
(total 0)
- incoming incomings source)
+ source)
(when (and (nnmail-get-value "%s-get-new-mail" method)
sources)
(while (setq source (pop sources))
;; 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
- (or in-group
- (if (equal file orig-file)
- nil
- (nnmail-get-split-group orig-file ',source)))
- ',(intern (format "%s-active-number" method)))))))
+ (condition-case cond
+ (mail-source-fetch
+ source
+ (gnus-byte-compile
+ `(lambda (file orig-file)
+ (nnmail-split-incoming
+ file ',(intern (format "%s-save-mail" method))
+ ',spool-func
+ (or in-group
+ (if (equal file orig-file)
+ nil
+ (nnmail-get-split-group orig-file
+ ',source)))
+ ',(intern (format "%s-active-number" method))))))
+ ((error quit)
+ (message "Mail source %s failed: %s" source cond)
+ 0)))
(incf total new)
(incf i)))
;; 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 mail-source-plugged
+ (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
+ method (car source)))
(nnmail-save-active
(nnmail-get-value "%s-group-alist" method)
(nnmail-get-value "%s-active-file" method))
(run-hooks 'nnmail-post-get-new-mail-hook))))
(defun nnmail-expired-article-p (group time force &optional inhibit)
- "Say whether an article that is TIME old in GROUP should be expired."
+ "Say whether an article that is TIME old in GROUP should be expired.
+If TIME is nil, then return the cutoff time for oldness instead."
(if force
- t
+ (if (null time)
+ (current-time)
+ t)
(let ((days (or (and nnmail-expiry-wait-function
(funcall nnmail-expiry-wait-function group))
nnmail-expiry-wait)))
nil)
((eq days 'immediate)
;; We expire all articles on sight.
- t)
+ (if (null time)
+ (current-time)
+ t))
((equal time '(0 0))
;; This is an ange-ftp group, and we don't have any dates.
nil)
((numberp days)
(setq days (days-to-time days))
;; Compare the time with the current time.
- (ignore-errors (time-less-p days (time-since time))))))))
+ (if (null time)
+ (time-subtract (current-time) days)
+ (ignore-errors (time-less-p days (time-since time)))))))))
(declare-function gnus-group-mark-article-read "gnus-group" (group article))
(when (functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (when (or (gnus-request-group target)
+ (when (or (gnus-request-group target nil nil (gnus-get-info target))
(gnus-request-create-group target))
(let ((group-art (gnus-request-accept-article target nil nil t)))
- (when (consp group-art)
+ (when (and (consp group-art)
+ (cdr group-art))
(gnus-group-mark-article-read target (cdr group-art))))))))
(defun nnmail-fancy-expiry-target (group)
((and (equal header 'to-from)
(or (string-match (cadr regexp-target-pair) from)
(and (string-match (cadr regexp-target-pair) to)
- (let ((rmail-dont-reply-to-names
- (message-dont-reply-to-names)))
- (equal (rmail-dont-reply-to from) "")))))
+ (let* ((mail-dont-reply-to-names
+ (message-dont-reply-to-names))
+ (rmail-dont-reply-to-names ; obsolete since 24.1
+ mail-dont-reply-to-names))
+ (equal (if (fboundp 'rmail-dont-reply-to)
+ (rmail-dont-reply-to from)
+ (mail-dont-reply-to from)) "")))))
(setq target (format-time-string (caddr regexp-target-pair) date)))
((and (not (equal header 'to-from))
(string-match (cadr regexp-target-pair)
(provide 'nnmail)
-;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
;;; nnmail.el ends here
projects / gnus / blobdiff