;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Author: Alexandre Oliva <oliva@dcc.unicamp.br>
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
+
+;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
-;; This program is free software; you can redistribute it and/or modify
+;; This file is part of GNU Emacs.
+
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(eval-when-compile (require 'cl))
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-group)
(require 'nnmail)
-(defvar gnus-mlsplit-updated-hook nil
- "Hook called just after nnmail-split-fancy is updated by
-gnus-mlsplit-update")
+(defvar gnus-group-split-updated-hook nil
+ "Hook called just after `nnmail-split-fancy' is updated by
+`gnus-group-split-update'.")
-(defvar gnus-mlsplit-default-catch-all-group "mail.misc"
- "Group used by gnus-mlsplit and
-gnus-mlsplit-update as default catch-all group")
+(defvar gnus-group-split-default-catch-all-group "mail.misc"
+ "Group name (or arbitrary fancy split) with default splitting rules.
+Used by `gnus-group-split' and `gnus-group-split-update' as a fallback
+split, in case none of the group-based splits matches.")
;;;###autoload
-(defun gnus-mlsplit-setup (&optional auto-update catch-all)
- "Sets things up so that nnmail-split-fancy is used for mail splitting,
-and defines the variable nnmail-split-fancy according with group parameters.
-
-if AUTO-UPDATE is non-nil (prefix argument accepted, if called interactive),
-makes sure nnmail-split-fancy is re-computed before getting new mail,
-by adding gnus-mlsplit-update to nnmail-pre-get-new-mail-hook."
+(defun gnus-group-split-setup (&optional auto-update catch-all)
+ "Set up the split for `nnmail-split-fancy'.
+Sets things up so that nnmail-split-fancy is used for mail
+splitting, and defines the variable nnmail-split-fancy according with
+group parameters.
+
+If AUTO-UPDATE is non-nil (prefix argument accepted, if called
+interactively), it makes sure nnmail-split-fancy is re-computed before
+getting new mail, by adding `gnus-group-split-update' to
+`nnmail-pre-get-new-mail-hook'.
+
+A non-nil CATCH-ALL replaces the current value of
+`gnus-group-split-default-catch-all-group'. This variable is only used
+by gnus-group-split-update, and only when its CATCH-ALL argument is
+nil. This argument may contain any fancy split, that will be added as
+the last split in a `|' split produced by `gnus-group-split-fancy',
+unless overridden by any group marked as a catch-all group. Typical
+uses are as simple as the name of a default mail group, but more
+elaborate fancy splits may also be useful to split mail that doesn't
+match any of the group-specified splitting rules. See
+`gnus-group-split-fancy' for details."
(interactive "P")
(setq nnmail-split-methods 'nnmail-split-fancy)
(when catch-all
- (setq gnus-mlsplit-default-catch-all-group catch-all))
- (gnus-mlsplit-update)
+ (setq gnus-group-split-default-catch-all-group catch-all))
+ (gnus-group-split-update)
(when auto-update
- (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-mlsplit-update)))
+ (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-group-split-update)))
;;;###autoload
-(defun gnus-mlsplit-update (&optional catch-all)
- "Computes nnmail-split-fancy from group params, by calling
-\(gnus-mlsplit-fancy nil nil DEFAULTGROUP)"
+(defun gnus-group-split-update (&optional catch-all)
+ "Computes nnmail-split-fancy from group params and CATCH-ALL.
+It does this by calling by calling (gnus-group-split-fancy nil
+nil CATCH-ALL).
+
+If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used
+instead. This variable is set by `gnus-group-split-setup'."
(interactive)
(setq nnmail-split-fancy
- (gnus-mlsplit-fancy
- nil nil (or catch-all gnus-mlsplit-default-catch-all-group)))
- (run-hooks 'gnus-mlsplit-updated-hook)
- )
+ (gnus-group-split-fancy
+ nil (null nnmail-crosspost)
+ (or catch-all gnus-group-split-default-catch-all-group)))
+ (run-hooks 'gnus-group-split-updated-hook))
;;;###autoload
-(defun gnus-mlsplit ()
- "Uses information from group parameters in order to split mail.
-See gnus-mlsplit-fancy for more information.
-
-If no group is defined as catch-all, the value of
-gnus-mlsplit-default-catch-all-group is used.
+(defun gnus-group-split ()
+ "Use information from group parameters in order to split mail.
+See `gnus-group-split-fancy' for more information.
-gnus-mlsplit is a valid value for nnmail-split-methods."
+`gnus-group-split' is a valid value for `nnmail-split-methods'."
(let (nnmail-split-fancy)
- (gnus-mlsplit-update
- gnus-mlsplit-default-catch-all-group)
+ (gnus-group-split-update)
(nnmail-split-fancy)))
;;;###autoload
-(defun gnus-mlsplit-fancy
+(defun gnus-group-split-fancy
(&optional groups no-crosspost catch-all)
"Uses information from group parameters in order to split mail.
-It can be embedded into nnmail-split-fancy lists with the SPLIT
+It can be embedded into `nnmail-split-fancy' lists with the SPLIT
-\(: gnus-mlsplit-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
+\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL)
GROUPS may be a regular expression or a list of group names, that will
-be used to select candidate groups. If it is ommited or nil, all
+be used to select candidate groups. If it is omitted or nil, all
existing groups are considered.
-if NO-CROSSPOST is ommitted or nil, a & split will be returned,
+if NO-CROSSPOST is omitted or nil, a & split will be returned,
otherwise, a | split, that does not allow crossposting, will be
returned.
-if CATCH-ALL is not nil, and there is no selected group whose
-split-regexp matches the empty string, nor is there a selected group
-whose SPLIT-SPEC is 'catch-all, this group name will be appended to
-the returned SPLIT list, as the last element in a '| SPLIT.
-
-For each selected group, a SPLIT is composed like this: if split-spec
+For each selected group, a SPLIT is composed like this: if SPLIT-SPEC
is specified, this split is returned as-is (unless it is nil: in this
case, the group is ignored). Otherwise, if TO-ADDRESS, TO-LIST and/or
EXTRA-ALIASES are specified, a regexp that matches any of them is
matches this regexp too, and if SPLIT-EXCLUDE is specified, RESTRICT
clauses will be generated.
+If CATCH-ALL is nil, no catch-all handling is performed, regardless of
+catch-all marks in group parameters. Otherwise, if there is no
+selected group whose SPLIT-REGEXP matches the empty string, nor is
+there a selected group whose SPLIT-SPEC is 'catch-all, this fancy
+split (say, a group name) will be appended to the returned SPLIT list,
+as the last element of a '| SPLIT.
+
For example, given the following group parameters:
nnml:mail.bar:
nnml:mail.others:
\((split-spec . catch-all))
-Calling (gnus-mlsplit-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
- \"nnml:mail.bar\")
+ \"mail.bar\")
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- - \"bugs-foo\" - \"rambling-foo\" \"nnml:mail.foo\"))
- \"nnml:mail.others\")"
- (let* ((newsrc (cdr gnus-newsrc-alist))
- split)
- (dolist (info newsrc)
- (let ((group (gnus-info-group info))
- (params (gnus-info-params info)))
- ;; For all GROUPs that match the specified GROUPS
- (when (or (not groups)
- (and (listp groups)
- (memq group groups))
- (and (stringp groups)
- (string-match groups group)))
- (let ((split-spec (cdr (assoc 'split-spec params))) group-clean)
- ;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
+ \"mail.others\")"
+ (let ((group-names (if (and (listp groups)
+ (not (null groups)))
+ groups
+ (delete-dups
+ (delq nil
+ (mapcar
+ (lambda (info)
+ (let ((group (gnus-info-group info)))
+ (if (or (not groups)
+ (and (stringp groups)
+ (string-match groups group)))
+ group)))
+ (append gnus-newsrc-alist gnus-parameters))))))
+ split)
+ (dolist (group group-names)
+ (let ((params (gnus-group-find-parameter group)))
+ ;; Skip groups without param (or nonexistent)
+ (when (not (null params))
+ (let ((split-spec (assoc 'split-spec params)) group-clean)
+ ;; Remove backend from group name
+ (setq group-clean (string-match ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
group))
(if split-spec
- (if (eq split-spec 'catch-all)
- ;; Emit catch-all only when requested
- (when catch-all
- (setq catch-all group-clean))
- ;; Append split-spec to the main split
- (push split-spec split))
+ (when (setq split-spec (cdr split-spec))
+ (if (eq split-spec 'catch-all)
+ ;; Emit catch-all only when requested
+ (when catch-all
+ (setq catch-all group-clean))
+ ;; Append split-spec to the main split
+ (push split-spec split)))
;; Let's deduce split-spec from other params
(let ((to-address (cdr (assoc 'to-address params)))
(to-list (cdr (assoc 'to-list params)))
(list 'any split-regexp)
;; Generate RESTRICTs for SPLIT-EXCLUDEs.
(if (listp split-exclude)
- (mapcon (lambda (arg) (cons '- arg))
- split-exclude)
+ (apply #'append
+ (mapcar (lambda (arg) (list '- arg))
+ split-exclude))
(list '- split-exclude))
(list group-clean))
split)
(setq catch-all nil)))))))))
;; Add catch-all if not crossposting
(if (and catch-all no-crosspost)
- (push split catch-all))
+ (push catch-all split))
;; Move it to the tail, while arranging that SPLITs appear in the
;; same order as groups.
(setq split (reverse split))
split))
(provide 'gnus-mlspl)
+
+;;; gnus-mlspl.el ends here
projects / gnus / blobdiff