;;; 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 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 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 'gnus-util)
(require 'mail-source)
(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")
(defgroup nnmail nil
"Reading mail with Gnus."
:version "21.1"
:group 'nnmail-expire
:type '(choice (const delete)
- (function :format "%v" nnmail-)
+ function
string))
(defcustom nnmail-fancy-expiry-targets nil
:group 'nnmail
:type 'boolean)
-(defcustom nnmail-spool-file '((file))
- "*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."
- :group 'nnmail-files
- :type 'sexp)
-(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
(defcustom nnmail-resplit-incoming nil
"*If non-nil, re-split incoming procmail sorted mail."
: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.
\(add-hook 'nnmail-read-incoming-hook
(lambda ()
(call-process \"/local/bin/mailsend\" nil nil nil
- \"read\" nnmail-spool-file)))
+ \"read\"
+ ;; The incoming mail box file.
+ (expand-file-name (user-login-name)
+ rmail-spool-directory))))
If you have xwatch running, this will alert it that mail has been
read.
:type '(choice (const :tag "disable" nil)
(integer :format "%v")))
-(defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
- "*The file name of the nnmail Message-ID cache."
+(defcustom nnmail-message-id-cache-file
+ (nnheader-concat gnus-home-directory ".nnmail-cache")
+ "The file name of the nnmail Message-ID cache."
:group 'nnmail-duplicate
:group 'nnmail-files
:type 'file)
(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 ()
(setq group (symbol-name group)))
(if (and (numberp (setq max (read buffer)))
(numberp (setq min (read buffer))))
- (push (list group (cons min max))
+ (push (list (mm-string-as-unibyte group) (cons min max))
group-assoc)))
(error nil))
(widen)
(let ((coding-system-for-write nnmail-active-file-coding-system))
(when file-name
(with-temp-file file-name
+ (mm-disable-multibyte)
(nnmail-generate-active group-assoc)))))
(defun nnmail-generate-active (alist)
(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."
+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
(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.
;; just call this function here and use the
;; result.
(or (funcall nnmail-split-methods)
- '("bogus"))
+ (and (not nnmail-inhibit-default-split-group)
+ '("bogus")))
(error
(nnheader-message
5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
group-art))
;; This is the final group, which is used as a
;; catch-all.
- (unless group-art
+ (when (and (not group-art)
+ (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))
+
(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')
(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)
;; 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)
(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)
+ (dolist (x references)
+ (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)))
res)))
(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))))
(symbol-value sym))))
(defun nnmail-get-new-mail (method exit-func temp
- &optional group spool-func)
+ &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))))
+ (nnmail-get-new-mail-1 method exit-func temp group nil spool-func))
+
+(defun nnmail-get-new-mail-1 (method exit-func temp
+ group in-group spool-func)
+ (let* ((sources mail-sources)
fetching-sources
- (group-in group)
(i 0)
(new 0)
(total 0)
(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))
+ ;; Use group's parameter
+ (when (eq (car source) 'group)
+ (let ((mail-sources
+ (list
+ (gnus-group-find-parameter
+ (concat (symbol-name method) ":" group)
+ 'mail-source t))))
+ (nnmail-get-new-mail-1 method exit-func temp
+ group group spool-func))
+ (setq source 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)
;; 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
(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))
+ (or in-group
+ (if (equal file orig-file)
+ nil
+ (nnmail-get-split-group orig-file ',source)))
',(intern (format "%s-active-number" method)))))))
(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))
;; Compare the time with the current time.
(ignore-errors (time-less-p days (time-since time))))))))
+(declare-function gnus-group-mark-article-read "gnus-group" (group article))
+
(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.
(provide 'nnmail)
-;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
;;; nnmail.el ends here
projects / gnus / blobdiff