X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=95a98352f00c38b8c6d86ffb7c9d69d7b6bfcd21;hb=74a489ff1213794152d6e13f7a11e16c89f62602;hp=f0f90218aab877df59af07b9184218b2ece2b384;hpb=c358f44b1670d12d5eff5fe5a447a19afd34a252;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index f0f90218a..95a98352f 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1,17 +1,17 @@ ;;; 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. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; 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 @@ -19,9 +19,7 @@ ;; 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 . ;;; Commentary: @@ -41,9 +39,8 @@ (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." @@ -202,7 +199,7 @@ The return value should be `delete' or a group name (a string)." :version "21.1" :group 'nnmail-expire :type '(choice (const delete) - (function :format "%v" nnmail-) + function string)) (defcustom nnmail-fancy-expiry-targets nil @@ -245,9 +242,8 @@ If non-nil, also update the cache when copy or move articles." :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 @@ -269,7 +265,7 @@ It scans low-level sorted spools even when not required." :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. @@ -534,8 +530,9 @@ performed." :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) @@ -617,6 +614,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." (defvar nnmail-split-tracing nil) (defvar nnmail-split-trace nil) +(defvar nnmail-inhibit-default-split-group nil) @@ -630,7 +628,14 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." 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) @@ -670,8 +675,7 @@ using different case (i.e. mailing-list@domain vs Mailing-List@Domain)." "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 () @@ -1054,7 +1058,9 @@ If SOURCE is a directory spec, try to return the group name component." (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 @@ -1062,12 +1068,13 @@ FUNC will be called with the buffer narrowed to each mail." (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 @@ -1096,15 +1103,15 @@ FUNC will be called with the group name to determine the article number." (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. @@ -1145,7 +1152,8 @@ FUNC will be called with the group name to determine the article number." ;; 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) @@ -1190,12 +1198,14 @@ FUNC will be called with the group name to determine the article number." 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) @@ -1295,7 +1305,7 @@ Return the number of characters in the body." "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 () @@ -1313,7 +1323,7 @@ Eudora has a broken References line, but an OK In-Reply-To." (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) @@ -1568,10 +1578,9 @@ See the documentation for the variable `nnmail-split-fancy' for details." (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)) @@ -1583,8 +1592,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." 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) @@ -1619,8 +1627,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; 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 @@ -1653,8 +1660,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; 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) @@ -1698,8 +1704,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)))) @@ -1766,11 +1771,14 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (symbol-value sym)))) (defun nnmail-get-new-mail (method exit-func temp - &optional group spool-func) + &optional group spool-func) "Read new incoming mail." + (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) @@ -1778,6 +1786,16 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (and (nnmail-get-value "%s-get-new-mail" method) sources) (while (setq source (pop sources)) + ;; 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) @@ -1806,8 +1824,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; 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 @@ -1816,16 +1832,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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)) @@ -1840,9 +1858,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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))) @@ -1853,14 +1874,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 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)) @@ -2034,5 +2059,4 @@ Doesn't change point." (provide 'nnmail) -;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7 ;;; nnmail.el ends here