X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmail.el;h=b7d834ecd8c98ae929c3a6e2f6449c8e7e3bb8fa;hb=7cce28b2d41e11d65102b8910ee9efc361b720ca;hp=48905a38a2891e9118c69a87b82c97ab8b6472d6;hpb=7693ad423659f409f95c3faea25a601c954375e6;p=gnus diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 48905a38a..b7d834ecd 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 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 2, 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,14 +19,16 @@ ;; 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: ;;; 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 @@ -35,10 +37,10 @@ (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." @@ -197,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 @@ -240,16 +242,10 @@ If non-nil, also update the cache when copy or move articles." :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." @@ -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. @@ -297,7 +293,10 @@ Eg. \(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. @@ -531,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) @@ -627,7 +627,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) @@ -690,7 +697,7 @@ nn*-request-list should have been called before calling this function." (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) @@ -705,6 +712,7 @@ nn*-request-list should have been called before calling this function." (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) @@ -1044,6 +1052,9 @@ If SOURCE is a directory spec, try to return the group name component." (nnmail-check-duplication message-id func artnum-func)) 1)) +(defvar nnmail-group-names-not-encoded-p nil + "Non-nil means group names are not encoded.") + (defun nnmail-split-incoming (incoming func &optional exit-func group artnum-func) "Go through the entire INCOMING file and pick out each individual mail. @@ -1053,7 +1064,8 @@ FUNC will be called with the buffer narrowed to each mail." (nnmail-split-methods (if (and group (not nnmail-resplit-incoming)) (list (list group "")) - nnmail-split-methods))) + nnmail-split-methods)) + (nnmail-group-names-not-encoded-p t)) (save-excursion ;; Insert the incoming file. (set-buffer (get-buffer-create nnmail-article-buffer)) @@ -1287,7 +1299,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 () @@ -1305,13 +1317,16 @@ 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) ;;; 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') @@ -1678,12 +1693,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (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) @@ -1756,14 +1770,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." - (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) @@ -1771,20 +1785,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)) - ;; 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) @@ -1813,8 +1823,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 @@ -1823,16 +1831,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)) @@ -1869,6 +1879,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; 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. @@ -1906,8 +1918,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; To or From header ((and (equal header 'to-from) (or (string-match (cadr regexp-target-pair) from) - (and (string-match (message-dont-reply-to-names) from) - (string-match (cadr regexp-target-pair) to)))) + (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) ""))))) (setq target (format-time-string (caddr regexp-target-pair) date))) ((and (not (equal header 'to-from)) (string-match (cadr regexp-target-pair) @@ -2037,5 +2051,4 @@ Doesn't change point." (provide 'nnmail) -;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7 ;;; nnmail.el ends here