;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005 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:
(require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'nnheader)
(require 'message)
-(require 'custom)
(require 'gnus-util)
(require 'mail-source)
: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
(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."
+ :version "22.1"
:group 'nnmail-split
:type '(choice (const :tag "none" nil)
(regexp :value ".*")
(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 ".*")
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")
(defcustom nnmail-spool-hook nil
"*A hook called when a new article is spooled."
+ :version "22.1"
:group 'nnmail
:type 'hook)
(define-widget 'nnmail-lazy 'default
"Base widget for recursive datastructures.
-This is copy of the `lazy' widget in Emacs 21.4 provided for compatibility."
+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-put widget :children
+ (list (widget-create-child-value
widget (widget-convert type) value)))))
:value-delete 'widget-children-value-delete
:value-get (lambda (widget)
(widget-apply (car (widget-get widget :children))
:value-inline))
:default-get (lambda (widget)
- ;;(widget-default-get
- ;; (widget-convert (widget-get widget :type))))
- ;; `widget-default-get' isn't available in Mule 2.
- (let ((w (widget-convert (widget-get widget :type))))
- (or (widget-get w :value)
- (widget-apply w :default-get))))
+ (widget-default-get
+ (widget-convert (widget-get widget :type))))
:match (lambda (widget value)
(widget-apply (widget-convert (widget-get widget :type))
:match value))
(list :tag "Function with fixed arguments (:)"
:value (:)
(const :format "" :value :)
- function
+ function
(editable-list :inline t (sexp :tag "Arg"))
)
(list :tag "Function with split arguments (!)"
(const :format "" !)
function
(editable-list :inline t nnmail-split-fancy))
- (list :tag "Field match"
- (choice :tag "Field"
+ (list :tag "Field match"
+ (choice :tag "Field"
regexp symbol)
(choice :tag "Match"
- regexp
+ regexp
(symbol :value mail))
(repeat :inline t
:tag "Restrictions"
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
: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
(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 t
"Whether the nnmail splitting functionality should MIME decode headers."
+ :version "22.1"
:group 'nnmail
:type 'boolean)
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)
(after-insert-file-functions nil))
(condition-case ()
(let ((auto-mode-alist (nnheader-auto-mode-alist))
- (file-name-coding-system nnmail-pathname-coding-system)
- (pathname-coding-system nnmail-pathname-coding-system))
+ (file-name-coding-system nnmail-pathname-coding-system))
(insert-file-contents-as-coding-system
nnmail-file-coding-system file)
t)
(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)))
(defun nnmail-save-active (group-assoc file-name)
"Save GROUP-ASSOC in ACTIVE-FILE."
- (let ((coding-system-for-write nnmail-active-file-coding-system)
- (output-coding-system nnmail-active-file-coding-system))
+ (let ((coding-system-for-write nnmail-active-file-coding-system))
(when file-name
(with-temp-file file-name
(nnmail-generate-active group-assoc)))))
(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))))
(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.
(while (not (eobp))
(unless (< (move-to-column nnmail-split-header-length-limit)
nnmail-split-header-length-limit)
- (delete-region (point) (gnus-point-at-eol)))
+ (delete-region (point) (point-at-eol)))
(forward-line 1))
;; Allow washing.
(goto-char (point-min))
5 "Error in `nnmail-split-methods'; using `bogus' mail group")
(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...
(defun nnmail-split-fancy ()
"Fancy splitting method.
See the documentation for the variable `nnmail-split-fancy' for details."
- (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))))
+ (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.
(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
(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
+ (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
(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)
(skip-chars-forward "^\n\r\t")
(unless (looking-at "[\r\n]")
(forward-char 1)
- (buffer-substring (point) (gnus-point-at-eol)))))))
+ (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.
(case-fold-search nil)
(from (or (message-fetch-field "from") ""))
(to (or (message-fetch-field "to") ""))
- (date (date-to-time
- (or (message-fetch-field "date") (current-time-string))))
+ (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
(defun nnmail-write-region (start end filename &optional append visit lockname)
"Do a `write-region', and then set the file modes."
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (pathname-coding-system nnmail-pathname-coding-system))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
(write-region-as-coding-system
nnmail-file-coding-system start end filename append visit lockname)
(set-file-modes filename nnmail-default-file-modes)))
(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'."
projects / elisp / gnus.git- / blobdiff