;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(eval-when-compile (require 'cl))
+(require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'nnheader)
(require 'message)
-(require 'custom)
(require 'gnus-util)
(require 'mail-source)
(require 'mm-util)
(eval-and-compile
- (autoload 'gnus-error "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util")
- (autoload 'gnus-add-buffer "gnus"))
+ (autoload 'gnus-add-buffer "gnus")
+ (autoload 'gnus-kill-buffer "gnus"))
(defgroup nnmail nil
"Reading mail with Gnus."
:group 'nnmail)
(defgroup nnmail-prepare nil
- "Preparing (or mangling) new mail after retrival."
+ "Preparing (or mangling) new mail after retrieval."
:group 'nnmail)
(defgroup nnmail-duplicate nil
:group 'nnmail)
(defgroup nnmail-split nil
- "Organizing the incomming mail in folders."
+ "Organizing the incoming mail in folders."
:group 'nnmail)
(defgroup nnmail-files nil
"Various mail options."
:group 'nnmail)
-(defcustom nnmail-split-methods
- '(("mail.misc" ""))
+(defcustom nnmail-split-methods '(("mail.misc" ""))
"*Incoming mail will be split according to this variable.
If you'd like, for instance, one mail group for mail from the
This variable can also have a function as its value."
:group 'nnmail-split
- :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
+ :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
+ (choice regexp function)))
(function-item nnmail-split-fancy)
(function :tag "Other")))
:type 'boolean)
(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
- "Regexp that matches group names to be ignored when applying
-`nnmail-split-fancy-with-parent'. This can also be a list of regexps."
+ "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
+This can also be a list of regexps."
+ :version "22.1"
+ :group 'nnmail-split
+ :type '(choice (const :tag "none" nil)
+ (regexp :value ".*")
+ (repeat :value (".*") regexp)))
+
+(defcustom nnmail-cache-ignore-groups nil
+ "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
+This can also be a list of regexps."
+ :version "22.1"
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
(defcustom nnmail-expiry-wait-function nil
"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
-\"old\". It can also return the values `never' and `immediate'.
+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 \"old\".
+It can also return the values `never' and `immediate'.
Eg.:
(function :format "%v" nnmail-)
string))
+(defcustom nnmail-fancy-expiry-targets nil
+ "Determine expiry target based on articles using fancy techniques.
+
+This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
+`nnmail-expiry-target' is set to the function
+`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
+the message will be expired to a group determined by invoking
+`format-time-string' with TARGET used as the format string and the
+time extracted from the articles' Date header (if missing the current
+time is used).
+
+In the special cases that HEADER is the symbol `to-from', the regexp
+will try to match against both the From and the To header.
+
+Example:
+
+\(setq nnmail-fancy-expiry-targets
+ '((to-from \"boss\" \"nnfolder:Work\")
+ (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
+ (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
+
+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
+be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
+everything else will be expired to \"nnfolder:Archive-YYYY\"."
+ :version "22.1"
+ :group 'nnmail-expire
+ :type '(repeat (list (choice :tag "Match against"
+ (string :tag "Header")
+ (const to-from))
+ regexp
+ (string :tag "Target group format string"))))
+
(defcustom nnmail-cache-accepted-message-ids nil
"If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
If non-nil, also update the cache when copy or move articles."
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.")
+;; revision 5.29 / p0-85 / Gnus 5.9
(defcustom nnmail-resplit-incoming nil
"*If non-nil, re-split incoming procmail sorted mail."
:group 'nnmail-split
:type 'hook)
+(defcustom nnmail-spool-hook nil
+ "*A hook called when a new article is spooled."
+ :version "22.1"
+ :group 'nnmail
+ :type 'hook)
+
(defcustom nnmail-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
+ "*The number of articles which indicates a large newsgroup or nil.
+If the number of articles is greater than the value, verbose
messages will be shown to indicate the current status."
:group 'nnmail-various
- :type 'integer)
+ :type '(choice (const :tag "infinite" nil)
+ (number :tag "count")))
+
+(define-widget 'nnmail-lazy 'default
+ "Base widget for recursive datastructures.
+
+This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
+ :format "%{%t%}: %v"
+ :convert-widget 'widget-value-convert-widget
+ :value-create (lambda (widget)
+ (let ((value (widget-get widget :value))
+ (type (widget-get widget :type)))
+ (widget-put widget :children
+ (list (widget-create-child-value
+ widget (widget-convert type) value)))))
+ :value-delete 'widget-children-value-delete
+ :value-get (lambda (widget)
+ (widget-value (car (widget-get widget :children))))
+ :value-inline (lambda (widget)
+ (widget-apply (car (widget-get widget :children))
+ :value-inline))
+ :default-get (lambda (widget)
+ (widget-default-get
+ (widget-convert (widget-get widget :type))))
+ :match (lambda (widget value)
+ (widget-apply (widget-convert (widget-get widget :type))
+ :match value))
+ :validate (lambda (widget)
+ (widget-apply (car (widget-get widget :children)) :validate)))
+
+(define-widget 'nnmail-split-fancy 'nnmail-lazy
+ "Widget for customizing splits in the variable of the same name."
+ :tag "Split"
+ :type '(menu-choice :value (any ".*value.*" "misc")
+ :tag "Type"
+ (string :tag "Destination")
+ (list :tag "Use first match (|)" :value (|)
+ (const :format "" |)
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Use all matches (&)" :value (&)
+ (const :format "" &)
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Function with fixed arguments (:)"
+ :value (:)
+ (const :format "" :value :)
+ function
+ (editable-list :inline t (sexp :tag "Arg"))
+ )
+ (list :tag "Function with split arguments (!)"
+ :value (!)
+ (const :format "" !)
+ function
+ (editable-list :inline t nnmail-split-fancy))
+ (list :tag "Field match"
+ (choice :tag "Field"
+ regexp symbol)
+ (choice :tag "Match"
+ regexp
+ (symbol :value mail))
+ (repeat :inline t
+ :tag "Restrictions"
+ (group :inline t
+ (const :format "" -)
+ regexp))
+ nnmail-split-fancy)
+ (const :tag "Junk (delete mail)" junk)))
(defcustom nnmail-split-fancy "mail.misc"
"Incoming mail can be split according to this fancy variable.
\(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
field FIELD (a regexp) contains VALUE (a regexp), store the messages
as specified by SPLIT. If RESTRICT (a regexp) matches some string
- after FIELD and before the end of the matched VALUE, return NIL,
+ after FIELD and before the end of the matched VALUE, return nil,
otherwise process SPLIT. Multiple RESTRICTs add up, further
restricting the possibility of processing SPLIT.
junk: Mail will be deleted. Use with care! Do not submerge in water!
Example:
(setq nnmail-split-fancy
- '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
- ...other.rules.omitted...))
+ '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
+ ...other.rules.omitted...))
FIELD must match a complete field name. VALUE must match a complete
word according to the `nnmail-split-fancy-syntax-table' syntax table.
You can use \".*\" in the regexps to match partial field names or words.
-FIELD and VALUE can also be lisp symbols, in that case they are expanded
+FIELD and VALUE can also be Lisp symbols, in that case they are expanded
as specified in `nnmail-split-abbrev-alist'.
GROUP can contain \\& and \\N which will substitute from matching
;; Unmatched mail goes to the catch all group.
\"misc.misc\"))"
:group 'nnmail-split
- ;; Sigh!
- :type 'sexp)
+ :type 'nnmail-split-fancy)
(defcustom nnmail-split-abbrev-alist
'((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
(const warn)
(const delete)))
-(defcustom nnmail-extra-headers nil
+(defcustom nnmail-extra-headers '(To Newsgroups)
"*Extra headers to parse."
:version "21.1"
:group 'nnmail
:type '(repeat symbol))
-(defcustom nnmail-split-header-length-limit 512
+(defcustom nnmail-split-header-length-limit 2048
"Header lines longer than this limit are excluded from the split function."
:version "21.1"
:group 'nnmail
:type 'integer)
+(defcustom nnmail-mail-splitting-charset nil
+ "Default charset to be used when splitting incoming mail."
+ :version "22.1"
+ :group 'nnmail
+ :type 'symbol)
+
+(defcustom nnmail-mail-splitting-decodes nil
+ "Whether the nnmail splitting functionality should MIME decode headers."
+ :version "22.1"
+ :group 'nnmail
+ :type 'boolean)
+
+(defcustom nnmail-split-fancy-match-partial-words nil
+ "Whether to match partial words when fancy splitting.
+Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
+by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
+ surrounded
+by anything."
+ :version "22.1"
+ :group 'nnmail
+ :type 'boolean)
+
+(defcustom nnmail-split-lowercase-expanded t
+ "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
+This avoids the creation of multiple groups when users send to an address
+using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
+ :version "22.1"
+ :group 'nnmail
+ :type 'boolean)
+
;;; Internal variables.
(defvar nnmail-article-buffer " *nnmail incoming*"
(defvar nnmail-split-history nil
"List of group/article elements that say where the previous split put messages.")
-(defvar nnmail-split-fancy-syntax-table nil
+(defvar nnmail-split-fancy-syntax-table
+ (let ((table (make-syntax-table)))
+ ;; support the %-hack
+ (modify-syntax-entry ?\% "." table)
+ table)
"Syntax table used by `nnmail-split-fancy'.")
-(unless (syntax-table-p nnmail-split-fancy-syntax-table)
- (setq nnmail-split-fancy-syntax-table
- (copy-syntax-table (standard-syntax-table)))
- ;; support the %-hack
- (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
(defvar nnmail-prepare-save-mail-hook nil
"Hook called before saving mail.")
\f
-(defconst nnmail-version "nnmail 1.0"
- "nnmail version.")
-
-\f
-
(defun nnmail-request-post (&optional server)
(mail-send-and-exit nil))
"Coding system used in reading inbox")
(defvar nnmail-pathname-coding-system nil
- "*Coding system for pathname.")
+ "*Coding system for file name.")
(defun nnmail-find-file (file)
"Insert FILE in server buffer safely."
(file-error nil))))
(defun nnmail-group-pathname (group dir &optional file)
- "Make pathname for GROUP."
+ "Make file name for GROUP."
(concat
(let ((dir (file-name-as-directory (expand-file-name dir))))
(setq group (nnheader-replace-duplicate-chars-in-string
(expand-file-name group dir)
;; If not, we translate dots into slashes.
(expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)
+ (nnheader-replace-chars-in-string group ?. ?/)
dir))))
(or file "")))
(while (not (eobp))
(condition-case err
(progn
- (narrow-to-region (point) (gnus-point-at-eol))
+ (narrow-to-region (point) (point-at-eol))
(setq group (read buffer))
(unless (stringp group)
(setq group (symbol-name group)))
(if (not (save-excursion
(and (re-search-backward
"^Content-Length:[ \t]*\\([0-9]+\\)" start t)
- (setq content-length (string-to-int
+ (setq content-length (string-to-number
(buffer-substring
(match-beginning 1)
(match-end 1))))
(defsubst nnmail-search-unix-mail-delim ()
"Put point at the beginning of the next Unix mbox message."
- ;; Algorithm used to find the the next article in the
+ ;; Algorithm used to find the next article in the
;; brain-dead Unix mbox format:
;;
;; 1) Search for "^From ".
(defun nnmail-search-unix-mail-delim-backward ()
"Put point at the beginning of the current Unix mbox message."
- ;; Algorithm used to find the the next article in the
+ ;; Algorithm used to find the next article in the
;; brain-dead Unix mbox format:
;;
;; 1) Search for "^From ".
(if (not (and (re-search-forward "^From " nil t)
(goto-char (match-beginning 0))))
;; Possibly wrong format?
- (error "Error, unknown mail format! (Possibly corrupted.)")
+ (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
+ (if (buffer-file-name) "file" "buffer")
+ (or (buffer-file-name) (buffer-name)))
;; Carry on until the bitter end.
(while (not (eobp))
(setq start (point)
start
(if (search-forward "\n\n" nil t)
(1- (point))
- ;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
(while (and (looking-at "From \\|[^ \t]+:")
(not (eobp)))
(forward-line 1))
(if (not (re-search-forward
"^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
(setq content-length nil)
- (setq content-length (string-to-int (match-string 1)))
+ (setq content-length (string-to-number (match-string 1)))
;; We destroy the header, since none of the backends ever
;; use it, and we do not want to confuse other mailers by
;; having a (possibly) faulty header.
(goto-char (point-max))
(widen)
(setq head-end (point))
- ;; We try the Content-Length value. The idea: skip over the header
- ;; separator, then check what happens content-length bytes into the
- ;; message body. This should be either the end ot the buffer, the
- ;; message separator or a blank line followed by the separator.
- ;; The blank line should probably be deleted. If neither of the
- ;; three is met, the content-length header is probably invalid.
+ ;; We try the Content-Length value. The idea: skip over the header
+ ;; separator, then check what happens content-length bytes into the
+ ;; message body. This should be either the end of the buffer, the
+ ;; message separator or a blank line followed by the separator.
+ ;; The blank line should probably be deleted. If neither of the
+ ;; three is met, the content-length header is probably invalid.
(when content-length
(forward-line 1)
(setq skip (+ (point) content-length))
start
(if (search-forward "\n\n" nil t)
(1- (point))
- ;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
(while (and (looking-at "From \\|[^ \t]+:")
(not (eobp)))
(forward-line 1))
(if (search-forward "\n\n" nil t)
(1- (point))
;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
+ ;; if there is no head-body delimiter, we search a bit manually.
(while (and (looking-at "From \\|[^ \t]+:")
(not (eobp)))
(forward-line 1))
(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.
(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))
(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)
+ (let ((methods (or nnmail-split-methods '(("bogus" ""))))
(obuf (current-buffer))
- (beg (point-min))
- end group-art method grp)
+ group-art method grp)
(if (and (sequencep methods)
(= (length methods) 1))
;; If there is only just one group to put everything in, we
(list (cons (caar methods) (funcall func (caar methods)))))
;; We do actual comparison.
(save-excursion
- ;; Find headers.
- (goto-char beg)
- (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
+ ;; Copy the article into the work buffer.
(set-buffer nntp-server-buffer)
(erase-buffer)
- ;; Copy the headers into the work buffer.
- (insert-buffer-substring obuf beg end)
+ (insert-buffer-substring obuf)
+ ;; Narrow to headers.
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (point)
+ (point-max)))
+ (goto-char (point-min))
+ ;; Decode MIME headers and charsets.
+ (when nnmail-mail-splitting-decodes
+ (let ((mail-parse-charset nnmail-mail-splitting-charset))
+ (mail-decode-encoded-word-region (point-min) (point-max))))
;; Fold continuation lines.
(goto-char (point-min))
(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
(while (not (eobp))
(unless (< (move-to-column nnmail-split-header-length-limit)
nnmail-split-header-length-limit)
- (delete-region (point) (progn (end-of-line) (point))))
+ (delete-region (point) (point-at-eol)))
(forward-line 1))
;; Allow washing.
(goto-char (point-min))
(if (and (symbolp nnmail-split-methods)
(fboundp nnmail-split-methods))
(let ((split
- (condition-case nil
+ (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")
+ (nnheader-message
+ 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
(sit-for 1)
'("bogus")))))
- (setq split (gnus-remove-duplicates split))
+ (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...
(unless group-art
(setq group-art
(list (cons (car method)
- (funcall func (car method)))))))))
+ (funcall func (car method))))))))
+ ;; Fall back on "bogus" if all else fails.
+ (unless group-art
+ (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
;; Produce a trace if non-empty.
(when (and trace nnmail-split-trace)
- (let ((trace (nreverse nnmail-split-trace))
- (restore (current-buffer)))
+ (let ((restore (current-buffer)))
(nnheader-set-temp-buffer "*Split Trace*")
(gnus-add-buffer)
- (while trace
- (insert (car trace) "\n")
- (setq trace (cdr trace)))
+ (dolist (trace (nreverse nnmail-split-trace))
+ (prin1 trace (current-buffer))
+ (insert "\n"))
(goto-char (point-min))
(gnus-configure-windows 'split-trace)
(set-buffer restore)))
+ (widen)
;; See whether the split methods returned `junk'.
(if (equal group-art '(junk))
nil
(progn (forward-line 1) (point))))
(insert (format "Xref: %s" (system-name)))
(while group-alist
- (insert (format " %s:%d"
- (mm-encode-coding-string
- (caar group-alist)
- nnmail-pathname-coding-system)
- (cdar group-alist)))
+ (insert (if (mm-multibyte-p)
+ (mm-string-as-multibyte
+ (format " %s:%d" (caar group-alist) (cdar group-alist)))
+ (mm-string-as-unibyte
+ (format " %s:%d" (caar group-alist) (cdar group-alist)))))
(setq group-alist (cdr group-alist)))
(insert "\n")))
nil t)
(delete-region (match-beginning 2) (match-end 0))
(beginning-of-line))
- (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t)
+ (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
+ nil t)
(delete-region (match-beginning 1) (match-end 1))
(beginning-of-line)))))
"Translate TAB characters into SPACE characters."
(subst-char-in-region (point-min) (point-max) ?\t ? t))
-(defun nnmail-fix-eudora-headers ()
- "Eudora has a broken References line, but an OK In-Reply-To."
+(defcustom nnmail-broken-references-mailers
+ "^X-Mailer:.*\\(Eudora\\|Pegasus\\)"
+ "Header line matching mailer producing bogus References lines.
+See `nnmail-ignore-broken-references'."
+ :group 'nnmail-prepare
+ :version "23.0" ;; No Gnus
+ :type 'regexp)
+
+(defun nnmail-ignore-broken-references ()
+ "Ignore the References line and use In-Reply-To
+
+Eudora has a broken References line, but an OK In-Reply-To."
(goto-char (point-min))
- (when (re-search-forward "^X-Mailer:.*Eudora" nil t)
+ (when (re-search-forward nnmail-broken-references-mailers nil t)
(goto-char (point-min))
(when (re-search-forward "^References:" nil t)
(beginning-of-line)
(when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
(replace-match "\\1" t))))
+(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
+
(custom-add-option 'nnmail-prepare-incoming-header-hook
- 'nnmail-fix-eudora-headers)
+ 'nnmail-ignore-broken-references)
;;; Utility functions
(defun nnmail-split-fancy ()
"Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for documentation."
- (let ((syntab (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table nnmail-split-fancy-syntax-table)
- (nnmail-split-it nnmail-split-fancy))
- (set-syntax-table syntab))))
+See the documentation for the variable `nnmail-split-fancy' for details."
+ (with-syntax-table nnmail-split-fancy-syntax-table
+ (nnmail-split-it nnmail-split-fancy)))
(defvar nnmail-split-cache nil)
;; Alist of split expressions their equivalent regexps.
;; A group name. Do the \& and \N subs into the string.
((stringp split)
(when nnmail-split-tracing
- (push (format "\"%s\"" split) nnmail-split-trace))
+ (push split nnmail-split-trace))
(list (nnmail-expand-newtext split)))
;; Junk the message.
;; Builtin : operation.
((eq (car split) ':)
+ (when nnmail-split-tracing
+ (push split nnmail-split-trace))
(nnmail-split-it (save-excursion (eval (cdr split)))))
;; Builtin ! operation.
(while (and (goto-char end-point)
(re-search-backward (cdr cached-pair) nil t))
(when nnmail-split-tracing
- (push (cdr cached-pair) nnmail-split-trace))
+ (push split nnmail-split-trace))
(let ((split-rest (cddr split))
(end (match-end 0))
- ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\). So,
- ;; start-of-value is the the point just before the
- ;; beginning of the value, whereas after-header-name is
- ;; the point just after the field name.
+ ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
+ ;; So, start-of-value is the point just before the
+ ;; beginning of the value, whereas after-header-name
+ ;; is the point just after the field name.
(start-of-value (match-end 1))
(after-header-name (match-end 2)))
;; Start the next search just before the beginning of the
(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
+ ;; Someone might want to do a \N sub on this match, so get the
;; correct match positions.
(re-search-backward value start-of-value))
(dolist (sp (nnmail-split-it (car split-rest)))
- (unless (memq sp split-result)
+ (unless (member sp split-result)
(push sp split-result))))))
split-result))
;; Not in cache, compute a regexp for the field/value pair.
(t
- (let* ((field (nth 0 split))
- (value (nth 1 split))
- partial-front regexp
- partial-rear regexp)
+ (let ((field (nth 0 split))
+ (value (nth 1 split))
+ (split-rest (cddr split))
+ partial-front
+ partial-rear
+ regexp)
(if (symbolp value)
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
(if (and (>= (length value) 2)
(string= ".*" (substring value -2)))
(setq value (substring value 0 -2)
partial-rear ""))
+ ;; Invert the match-partial-words behavior if the optional
+ ;; last element is specified.
+ (while (eq (car split-rest) '-)
+ (setq split-rest (cddr split-rest)))
+ (when (if (cadr split-rest)
+ (not nnmail-split-fancy-match-partial-words)
+ nnmail-split-fancy-match-partial-words)
+ (setq partial-front ""
+ partial-rear ""))
(setq regexp (concat "^\\(\\("
(if (symbolp field)
(cdr (assq field nnmail-split-abbrev-alist))
(or partial-rear "\\>")))
(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.
+ ;; on the same split, which will find it immediately in the cache.
(nnmail-split-it split))))))
(defun nnmail-expand-newtext (newtext)
(setq N 0)
(setq N (- c ?0)))
(when (match-beginning N)
- (push (buffer-substring (match-beginning N) (match-end N))
+ (push (if nnmail-split-lowercase-expanded
+ (downcase (buffer-substring (match-beginning N)
+ (match-end N)))
+ (buffer-substring (match-beginning N) (match-end N)))
expanded))))
(setq pos (1+ pos)))
(if did-expand
nnmail-message-id-cache-file nil 'silent)
(set-buffer-modified-p nil)
(setq nnmail-cache-buffer nil)
- (kill-buffer (current-buffer)))))
+ (gnus-kill-buffer (current-buffer)))))
;; Compiler directives.
(defvar group)
(defvar group-art-list)
(defvar group-art)
-(defun nnmail-cache-insert (id)
- (when nnmail-treat-duplicates
- ;; Store some information about the group this message is written
- ;; to. This function might have been called from various places.
- ;; Sometimes, a function up in the calling sequence has an
- ;; argument GROUP which is bound to a string, the group name. At
- ;; other times, there is a function up in the calling sequence
- ;; which has an argument GROUP-ART which is a list of pairs, and
- ;; the car of a pair is a group name. Should we check that the
- ;; length of the list is equal to 1? -- kai
- (let ((g nil))
- (cond ((and (boundp 'group) group)
- (setq g group))
- ((and (boundp 'group-art-list) group-art-list
- (listp group-art-list))
- (setq g (caar group-art-list)))
- ((and (boundp 'group-art) group-art (listp group-art))
- (setq g (caar group-art)))
- (t (setq g "")))
+(defun nnmail-cache-insert (id grp &optional subject sender)
+ (when (stringp id)
+ ;; this will handle cases like `B r' where the group is nil
+ (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
+ (run-hook-with-args 'nnmail-spool-hook
+ id grp subject sender))
+ (when nnmail-treat-duplicates
+ ;; Store some information about the group this message is written
+ ;; to. This is passed in as the grp argument -- all locations this
+ ;; has been called from have been checked and the group is available.
+ ;; The only ambiguous case is nnmail-check-duplication which will only
+ ;; 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)
(goto-char (point-max))
- (if (and g (not (string= "" g))
+ (if (and grp (not (string= "" grp))
(gnus-methods-equal-p gnus-command-method
(nnmail-cache-primary-mail-backend)))
- (insert id "\t" g "\n")
+ (let ((regexp (if (consp nnmail-cache-ignore-groups)
+ (mapconcat 'identity nnmail-cache-ignore-groups
+ "\\|")
+ nnmail-cache-ignore-groups)))
+ (unless (and regexp (string-match regexp grp))
+ (insert id "\t" grp "\n")))
(insert id "\n"))))))
(defun nnmail-cache-primary-mail-backend ()
(let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
(be nil)
- (res nil))
+ (res nil)
+ (get-new-mail nil))
(while (and (null res) be-list)
(setq be (car be-list))
(setq be-list (cdr be-list))
(when (and (gnus-method-option-p be 'respool)
- (eval (intern (format "%s-get-new-mail" (car be)))))
+ (setq get-new-mail
+ (intern (format "%s-get-new-mail" (car be))))
+ (boundp get-new-mail)
+ (symbol-value get-new-mail))
(setq res be)))
res))
(when (search-backward id nil t)
(beginning-of-line)
(skip-chars-forward "^\n\r\t")
- (unless (eolp)
+ (unless (looking-at "[\r\n]")
(forward-char 1)
- (buffer-substring (point)
- (progn (end-of-line) (point))))))))
+ (buffer-substring (point) (point-at-eol)))))))
;; Function for nnmail-split-fancy: look up all references in the
;; cache and if a match is found, return that group.
(defun nnmail-split-fancy-with-parent ()
"Split this message into the same group as its parent.
This function can be used as an entry in `nnmail-split-fancy', for
-example like this: (: nnmail-split-fancy)
+example like this: (: nnmail-split-fancy-with-parent)
For a message to be split, it looks for the parent message in the
References or In-Reply-To header and then looks in the message id
cache file (given by the variable `nnmail-message-id-cache-file') to
(nnmail-cache-open))
(mapcar (lambda (x)
(setq res (or (nnmail-cache-fetch-group x) res))
- (when (or (string= "drafts" res)
+ (when (or (member res '("delayed" "drafts" "queue"))
(and regexp res (string-match regexp res)))
(setq res nil)))
references)
(cond
((memq nnmail-treat-duplicates '(warn delete))
nnmail-treat-duplicates)
- ((nnheader-functionp nnmail-treat-duplicates)
+ ((functionp nnmail-treat-duplicates)
(funcall nnmail-treat-duplicates message-id))
(t
nnmail-treat-duplicates))))
((not duplication)
(funcall func (setq group-art
(nreverse (nnmail-article-group artnum-func))))
- (nnmail-cache-insert message-id))
+ (nnmail-cache-insert message-id (caar group-art)))
((eq action 'delete)
(setq group-art nil))
((eq action 'warn)
&optional group spool-func)
"Read new incoming mail."
(let* ((sources (or mail-sources
- (if (listp nnmail-spool-file) nnmail-spool-file
+ (if (listp nnmail-spool-file)
+ nnmail-spool-file
(list nnmail-spool-file))))
fetching-sources
(group-in group)
(ignore-errors (time-less-p days (time-since time))))))))
(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.
(let (nnmail-cache-accepted-message-ids)
;; Don't enter Message-IDs into cache.
;; Let users hack it in TARGET function.
- (when (nnheader-functionp target)
+ (when (functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (gnus-request-accept-article target nil nil t))))
+ (when (or (gnus-request-group target)
+ (gnus-request-create-group target))
+ (let ((group-art (gnus-request-accept-article target nil nil t)))
+ (when (consp group-art)
+ (gnus-group-mark-article-read target (cdr group-art))))))))
+
+(defun nnmail-fancy-expiry-target (group)
+ "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
+ (let* (header
+ (case-fold-search nil)
+ (from (or (message-fetch-field "from") ""))
+ (to (or (message-fetch-field "to") ""))
+ (date (message-fetch-field "date"))
+ (target 'delete))
+ (setq date (if date
+ (condition-case err
+ (date-to-time date)
+ (error
+ (message "%s" (error-message-string err))
+ (current-time)))
+ (current-time)))
+ (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
+ (setq header (car regexp-target-pair))
+ (cond
+ ;; If the header is to-from then match against the
+ ;; 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))))
+ (setq target (format-time-string (caddr regexp-target-pair) date)))
+ ((and (not (equal header 'to-from))
+ (string-match (cadr regexp-target-pair)
+ (or
+ (message-fetch-field header)
+ "")))
+ (setq target
+ (format-time-string (caddr regexp-target-pair) date)))))))
(defun nnmail-check-syntax ()
"Check (and modify) the syntax of the message in the current buffer."
(with-output-to-temp-buffer "*nnmail split history*"
(with-current-buffer standard-output
(fundamental-mode)) ; for Emacs 20.4+
- (let ((history nnmail-split-history)
- elem)
- (while (setq elem (pop history))
+ (dolist (elem nnmail-split-history)
(princ (mapconcat (lambda (ga)
(concat (car ga) ":" (int-to-string (cdr ga))))
elem
", "))
- (princ "\n")))))
+ (princ "\n"))))
(defun nnmail-purge-split-history (group)
"Remove all instances of GROUP from `nnmail-split-history'."
(let ((history nnmail-split-history))
(while history
- (setcar history (gnus-delete-if (lambda (e) (string= (car e) group))
+ (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
(car history)))
(pop history))
(setq nnmail-split-history (delq nil nnmail-split-history))))
(provide 'nnmail)
+;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
;;; nnmail.el ends here
projects / gnus / blobdiff