* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 81b1f55..00b6e86 100644 (file)
--- 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 3ace78f..01936d8 100644 (file)
--- a/lisp/gnus-agent.el
+++ b/lisp/gnus-agent.el
@@ -30,6 +30,7 @@
 (require 'gnus-sum)
 (require 'gnus-score)
 (require 'gnus-srvr)
+(require 'gnus-util)
 (eval-when-compile
   (if (featurep 'xemacs)
       (require 'itimer)
@@ -1869,6 +1870,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))
@@ -2115,7 +2119,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 4242d0e..519e127 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1352,4 +1352,31 @@ 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