From: yamaoka <yamaoka>
Date: Thu, 6 Mar 2003 07:04:45 +0000 (+0000)
Subject: Synch to Oort Gnus.
X-Git-Tag: t-gnus-6_15_17-00-quimby~22
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c6ae6cd4df19f6fb18bd8b669300b3ac90d0850f;p=elisp%2Fgnus.git-

Synch to Oort Gnus.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 81b1f55..00b6e86 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2003-03-06  Kevin Greiner  <kgreiner@xpediantsolutions.com>
+
+	* gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding
+	on gnus-agent-short-article.
+	(gnus-category-read): Replaced CL function mapcar* with new macro:
+	gnus-mapcar.
+	* gnus-util.el (gnus-mapcar): New macro.  Generalizes mapcar to
+	support functions that accept multiple parameters.  A separate
+	sequence must be provided for each parameter in the function.
+	Iteration stops when the end of the shortest list is reached.
+
 2003-03-06  Jesper Harder  <harder@ifa.au.dk>
 
 	* nnimap.el (nnimap-request-accept-article): Use delete-region.
diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el
index 275e556..1dae0e3 100644
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -34,6 +34,7 @@
 (require 'gnus-sum)
 (require 'gnus-score)
 (require 'gnus-srvr)
+(require 'gnus-util)
 (eval-when-compile
   (if (featurep 'xemacs)
       (require 'itimer)
@@ -1891,6 +1892,9 @@ FILE and places the combined headers into `nntp-server-buffer'."
                                       (gnus-agent-long-article
                                        (gnus-agent-find-parameter
                                         group 'agent-long-article))
+                                      (gnus-agent-short-article
+                                       (gnus-agent-find-parameter
+                                        group 'agent-short-article))
                                       (gnus-agent-low-score
                                        (gnus-agent-find-parameter
                                         group 'agent-low-score))
@@ -2137,7 +2141,7 @@ The following commands are available:
                  (lambda (c)
                    (setcdr c
                            (delq nil
-                                 (mapcar*
+                                 (gnus-mapcar
                                   (lambda (valu symb)
                                     (if valu
                                         (cons symb valu)))
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index e7ffc74..df890d1 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1413,4 +1413,38 @@ Return nil otherwise."
 
 (provide 'gnus-util)
 
+(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
+  "Apply FUNCTION to each element of the sequences, and make a list of the results.
+If there are several sequences, FUNCTION is called with that many arguments,
+and mapping stops as soon as the shortest sequence runs out.  With just one
+sequence, this is like `mapcar'.  With several, it is like the Common Lisp
+`mapcar' function extended to arbitrary sequence types."
+
+  (if seqs2_n
+      (let* ((seqs (cons seq1 seqs2_n))
+	     (cnt 0)
+	     (heads (mapcar (lambda (seq)
+			      (make-symbol (concat "head"
+						   (int-to-string
+						    (setq cnt (1+ cnt))))))
+			    seqs))
+	     (result (make-symbol "result"))
+	     (result-tail (make-symbol "result-tail")))
+	`(let* ,(let* ((bindings (cons nil nil))
+		       (heads heads))
+		  (nconc bindings (list (list result '(cons nil nil))))
+		  (nconc bindings (list (list result-tail result)))
+		  (while heads
+		    (nconc bindings (list (list (pop heads) (pop seqs)))))
+		  (cdr bindings))
+	   (while (and ,@heads)
+	     (setcdr ,result-tail (cons (funcall ,function
+						 ,@(mapcar (lambda (h) (list 'car h))
+							   heads))
+					nil))
+	     (setq ,result-tail (cdr ,result-tail)
+		   ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads))))
+	   (cdr ,result)))
+    `(mapcar ,function ,seq1)))
+
 ;;; gnus-util.el ends here