Synch with Gnus.
[elisp/gnus.git-] / lisp / gnus-mlspl.el
index 716426e..3f7d012 100644 (file)
@@ -1,7 +1,8 @@
 ;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; 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.
 
+(eval-when-compile (require 'cl))
 (require 'gnus)
 (require 'gnus-sum)
 (require 'gnus-group)
 (require 'nnmail)
 
 (defvar gnus-group-split-updated-hook nil
-  "Hook called just after nnmail-split-fancy is updated by
-gnus-group-split-update")
+  "Hook called just after nnmail-split-fancy is updated by gnus-group-split-update.")
 
 (defvar gnus-group-split-default-catch-all-group "mail.misc"
-  "Group used by gnus-group-split and gnus-group-split-update as
-default catch-all group")
+  "Group used by gnus-group-split and gnus-group-split-update as default catch-all group.")
 
 ;;;###autoload
 (defun gnus-group-split-setup (&optional auto-update catch-all)
-  "Sets things up so that nnmail-split-fancy is used for mail
+  "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.
 
@@ -52,19 +53,19 @@ nnmail-pre-get-new-mail-hook."
 
 ;;;###autoload
 (defun gnus-group-split-update (&optional catch-all)
-  "Computes nnmail-split-fancy from group params, by calling
-\(gnus-group-split-fancy nil nil DEFAULTGROUP)"
+  "Computes nnmail-split-fancy from group params.
+It does this by calling \(gnus-group-split-fancy nil CROSSPOST DEFAULTGROUP)."
   (interactive)
   (setq nnmail-split-fancy
        (gnus-group-split-fancy
-        nil nil (or catch-all gnus-group-split-default-catch-all-group)))
-  (run-hooks 'gnus-group-split-updated-hook)
-  )
+        nil (null nnmail-crosspost)
+        (or catch-all gnus-group-split-default-catch-all-group)))
+  (run-hooks 'gnus-group-split-updated-hook))
 
 ;;;###autoload
 (defun gnus-group-split ()
-  "Uses information from group parameters in order to split mail.  See
-gnus-group-split-fancy for more information.
+  "Uses information from group parameters in order to split mail.
+See gnus-group-split-fancy for more information.
 
 If no group is defined as catch-all, the value of
 gnus-group-split-default-catch-all-group is used.
@@ -136,7 +137,7 @@ Calling (gnus-group-split-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
@@ -144,12 +145,13 @@ Calling (gnus-group-split-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)))
@@ -179,8 +181,12 @@ Calling (gnus-group-split-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)
+                            (let ((seq split-exclude)
+                                  res)
+                              (while seq
+                                (push (cons '- (pop seq))
+                                      res))
+                              (apply #'nconc (nreverse res)))
                           (list '- split-exclude))
                         (list group-clean))
                        split)
@@ -189,7 +195,7 @@ Calling (gnus-group-split-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))