From: yamaoka Date: Tue, 29 Aug 2000 22:40:40 +0000 (+0000) Subject: Synch with Gnus. X-Git-Tag: t-gnus-6_14-quimby-before-installer-changed-~125 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7be3d2f29cf04a714797434aa3f4beaea9761800;p=elisp%2Fgnus.git- Synch with Gnus. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b32a269..e33455d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2000-08-29 Dave Love + * 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 with mods. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 8163f92..250f6f7 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -881,6 +881,20 @@ the actual number of articles toggled is returned." (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)) @@ -894,8 +908,8 @@ the actual number of articles toggled is returned." (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) diff --git a/lisp/gnus-clfns.el b/lisp/gnus-clfns.el index 07b0eeb..6fed527 100644 --- a/lisp/gnus-clfns.el +++ b/lisp/gnus-clfns.el @@ -70,48 +70,6 @@ `(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) diff --git a/lisp/gnus-mlspl.el b/lisp/gnus-mlspl.el index 5ddff92..0ea0967 100644 --- a/lisp/gnus-mlspl.el +++ b/lisp/gnus-mlspl.el @@ -21,7 +21,6 @@ ;; Boston, MA 02111-1307, USA. (eval-when-compile (require 'cl)) -(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-sum) @@ -182,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)