2000-08-29 Dave Love <fx@gnu.org>
+ * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon.
+
+ * dgnushack.el (mapcon, union): Remove compiler macros.
+
+ * gnus-agent.el (gnus-agent-union): new function.
+ (gnus-agent-fetch-headers): Use it.
+
* gnus.el (gnus-group-startup-message): Specify foreground and
background for xpm image. Centre image vertically.
From Katsumi Yamaoka <yamaoka@jpl.org> with mods.
(insert "\n"))
(pop gnus-agent-group-alist))))
+(defun gnus-agent-union (l1 l2)
+ "Set union of lists L1 and L2."
+ (cond ((null l1) l2)
+ ((null l2) l1)
+ ((equal l1 l2) l1)
+ (t
+ (or (>= (length l1) (length l2))
+ (setq l1 (prog1 l2 (setq l2 l1))))
+ (while l2
+ (or (memq (car l2) l1)
+ (push (car l2) l1))
+ (pop l2))
+ l1)))
+
(defun gnus-agent-fetch-headers (group &optional force)
(let* ((articles (gnus-list-of-unread-articles group))
(len (length articles))
(setq articles (nthcdr i articles))))
;; add article with marks to list of article headers we want to fetch.
(dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (union (gnus-uncompress-sequence (cdr arts))
- articles)))
+ (setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
+ articles)))
(setq articles (sort articles '<))
;; Remove known articles.
(when (gnus-agent-load-alist group)
`(let ((seq ,seq))
(mapcar ,fn seq)
seq))))
-
- (define-compiler-macro mapcon (&whole form fn seq &rest rest)
- (if (and (fboundp 'mapcon)
- (subrp (symbol-function 'mapcon)))
- form
- (if rest
- `(let ((fn ,fn)
- res
- (args (list ,seq ,@rest))
- p)
- (while (not (memq nil args))
- (push (apply ,fn args) res)
- (setq p args)
- (while p
- (setcar p (cdr (pop p)))
- ))
- (apply (function nconc) (nreverse res)))
- `(let ((fn ,fn)
- res
- (arg ,seq))
- (while arg
- (push (funcall ,fn arg) res)
- (setq arg (cdr arg)))
- (apply (function nconc) (nreverse res))))))
-
- (define-compiler-macro union (&whole form list1 list2)
- (if (and (fboundp 'union)
- (subrp (symbol-function 'union)))
- form
- `(let ((a ,list1)
- (b ,list2))
- (cond ((null a) b)
- ((null b) a)
- ((equal a b) a)
- (t
- (or (>= (length a) (length b))
- (setq a (prog1 b (setq b a))))
- (while b
- (or (memq (car b) a)
- (push (car b) a))
- (pop b))
- a)))))
)
(provide 'gnus-clfns)
;; Boston, MA 02111-1307, USA.
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
(require 'gnus)
(require 'gnus-sum)
(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)