;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus) ; for macro gnus-kill-buffer, at least
(require 'nnheader)
(require 'message)
-(require 'custom)
(require 'gnus-util)
(require 'mail-source)
(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)
(defcustom nnmail-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup or nil.
-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 '(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 t
"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)
(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))
(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))
(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 ((restore (current-buffer)))
(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.
(t
(let* ((field (nth 0 split))
(value (nth 1 split))
- partial-front regexp
- partial-rear regexp)
+ 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 ""))
+ (when nnmail-split-fancy-match-partial-words
+ (setq partial-front ""
+ partial-rear ""))
(setq regexp (concat "^\\(\\("
(if (symbolp field)
(cdr (assq field nnmail-split-abbrev-alist))
(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)
- (run-hook-with-args 'nnmail-spool-hook
- id grp)
- (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.
(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))))
(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)
(when (or (gnus-request-group target)
(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'."