Synch to Oort Gnus.
authoryamaoka <yamaoka>
Thu, 6 Mar 2003 07:04:45 +0000 (07:04 +0000)
committeryamaoka <yamaoka>
Thu, 6 Mar 2003 07:04:45 +0000 (07:04 +0000)
lisp/ChangeLog
lisp/gnus-agent.el
lisp/gnus-util.el

index 81b1f55..00b6e86 100644 (file)
@@ -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.
index 275e556..1dae0e3 100644 (file)
@@ -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)))
index e7ffc74..df890d1 100644 (file)
@@ -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