Add.
[gnus] / lisp / gnus-mlspl.el
index 7582da4..3dbc82d 100644 (file)
@@ -1,7 +1,8 @@
-;;; gnus-mlsplt.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
+;; Copyright (C) 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
-;; Author: Alexandre Oliva <oliva@dcc.unicamp.br>
+;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
 ;; Keywords: news, mail
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
 (require 'gnus)
 (require 'gnus-sum)
 (require 'gnus-group)
 (require 'nnmail)
 
-(defvar gnus-mlsplt-updated-hook nil
+(defvar gnus-group-split-updated-hook nil
   "Hook called just after nnmail-split-fancy is updated by
-gnus-mlsplt-update")
-
-(defvar gnus-mlsplt-default-catch-all-group "mail.misc"
-  "Group used by gnus-mlsplt and
-gnus-mlsplt-update as default catch-all group")
-
-(defun gnus-mlsplt-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-mlsplt-update to nnmail-pre-get-new-mail-hook."
+gnus-group-split-update.")
+
+(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-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-mlsplt-default-catch-all-group catch-all))
-  (gnus-mlsplt-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-mlsplt-update)))
+    (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-group-split-update)))
+
+;;;###autoload
+(defun gnus-group-split-update (&optional catch-all)
+  "Computes nnmail-split-fancy from group params and CATCH-ALL, by
+calling (gnus-group-split-fancy nil nil CATCH-ALL).
 
-(defun gnus-mlsplt-update (&optional catch-all)
-  "Computes nnmail-split-fancy from group params, by calling
-\(gnus-mlsplt-fancy nil nil DEFAULTGROUP)"
+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-mlsplt-fancy
-        nil nil (or catch-all gnus-mlsplt-default-catch-all-group)))
-  (run-hooks 'gnus-mlsplt-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))
 
-(defun gnus-mlsplt ()
+;;;###autoload
+(defun gnus-group-split ()
   "Uses information from group parameters in order to split mail.
-See gnus-mlsplt-fancy for more information.
+See gnus-group-split-fancy for more information.
 
-If no group is defined as catch-all, the value of
-gnus-mlsplt-default-catch-all-group is used.
-
-gnus-mlsplt is a valid value for nnmail-split-methods."
+gnus-group-split is a valid value for nnmail-split-methods."
   (let (nnmail-split-fancy)
-    (gnus-mlsplt-update
-     gnus-mlsplt-default-catch-all-group)
+    (gnus-group-split-update)
     (nnmail-split-fancy)))
 
-(defun gnus-mlsplt-fancy
+;;;###autoload
+(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
+  "Uses information from group parameters in order to split mail.  It
+can be embedded into nnmail-split-fancy lists with the SPLIT
 
-\(: gnus-mlsplt-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
@@ -85,12 +109,7 @@ if NO-CROSSPOST is ommitted 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
@@ -99,6 +118,13 @@ SPLIT-REGEXP is specified, the regexp will be extended so that it
 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:
@@ -112,13 +138,13 @@ nnml:mail.foo:
 nnml:mail.others:
 \((split-spec . catch-all))
 
-Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
+Calling (gnus-group-split-fancy nil nil \"mail.misc\") 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\")"
+           - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
+   \"mail.others\")"
   (let* ((newsrc (cdr gnus-newsrc-alist))
         split)
     (dolist (info newsrc)
@@ -130,7 +156,7 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
                       (memq group groups))
                  (and (stringp groups)
                       (string-match groups group)))
-         (let ((split-spec (cdr (assoc 'split-spec params))) group-clean)
+         (let ((split-spec (assoc 'split-spec params)) group-clean)
            ;; Remove backend from group name
            (setq group-clean (string-match ":" group))
            (setq group-clean
@@ -138,12 +164,13 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
                      (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)))
@@ -173,8 +200,9 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
                         (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)
@@ -183,7 +211,7 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
                    (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))
@@ -195,4 +223,6 @@ Calling (gnus-mlsplt-fancy nil nil \"mail.misc\") returns:
        (setq split (list '| split catch-all)))
     split))
 
-(provide 'gnus-mlsplt)
+(provide 'gnus-mlspl)
+
+;;; gnus-mlspl.el ends here