;;; 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)
(require 'mm-util)
: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)
: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.
To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
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")
: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 nil
"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)
(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))))
(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))
(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
(defvar group)
(defvar group-art-list)
(defvar group-art)
-(defun nnmail-cache-insert (id grp &optional subject)
- (run-hook-with-args 'nnmail-spool-hook
- id grp subject)
- (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 grp (not (string= "" grp))
- (gnus-methods-equal-p gnus-command-method
- (nnmail-cache-primary-mail-backend)))
- (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-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 grp (not (string= "" grp))
+ (gnus-methods-equal-p gnus-command-method
+ (nnmail-cache-primary-mail-backend)))
+ (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))
(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.
(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'."
(provide 'nnmail)
+;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
;;; nnmail.el ends here
projects / gnus / blobdiff