Eliminate `remove-if-not' that is a cl function.

gnus-util.el (gnus-remove-if): Allow hash table.
gnus-util.el (gnus-remove-if-not): New function.
gnus-art.el (gnus-mime-view-part-as-type): Replace remove-if-not with gnus-remove-if-not.
gnus-score.el (gnus-summary-score-effect): Replace remove-if-not with gnus-remove-if-not.
gnus-sum.el (gnus-read-move-group-name): Replace remove-if-not with gnus-remove-if-not.
gnus-group.el (gnus-group-completing-read): Regard collection as a hash table if it is not a list.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index ed6c541c4f0b04b5bf721c85830d0d9ecf64200d..cb9924415b90bb5d4aceef91d412828f7fb353d6 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,16 @@
+2010-10-06  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-util.el (gnus-remove-if): Allow hash table.
+       (gnus-remove-if-not): New function.
+
+       * gnus-art.el (gnus-mime-view-part-as-type)
+       * gnus-score.el (gnus-summary-score-effect)
+       * gnus-sum.el (gnus-read-move-group-name):
+       Replace remove-if-not with gnus-remove-if-not.
+
+       * gnus-group.el (gnus-group-completing-read):
+       Regard collection as a hash table if it is not a list.
+
 2010-10-05  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * shr.el (shr-render-td): Allow blank/missing <TD>s.

diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d7dcf9017135daf218133b00da1a38afaf912f7f..40f80f14bb1eb05f716c025c66f3c794bde151e0 100644 (file)
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -5139,7 +5139,7 @@ available media-types."
          (let ((default (gnus-mime-view-part-as-type-internal)))
            (gnus-completing-read
             "View as MIME type"
-            (remove-if-not pred (mailcap-mime-types))
+            (gnus-remove-if-not pred (mailcap-mime-types))
             nil nil nil
             (car default)))))
   (gnus-article-check-buffer)

diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index a700b5ee8cf963c90f7ee8c5fd1e300595ab48d7..1833c6048935af9659fb5d8653c7223265fc6e22 100644 (file)
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2163,23 +2163,33 @@ be permanent."
        (goto-char start)))))
 
 (defun gnus-group-completing-read (&optional prompt collection
-                                             require-match initial-input hist def)
+                                            require-match initial-input hist
+                                            def)
   "Read a group name with completion.  Non-ASCII group names are allowed.
 The arguments are the same as `completing-read' except that COLLECTION
 and HIST default to `gnus-active-hashtb' and `gnus-group-history'
-respectively if they are omitted."
-  (let* ((collection (or collection (or gnus-active-hashtb [0])))
-        (choices (mapcar (lambda (symbol)
-                            (let ((group (symbol-name symbol)))
-                              (if (string-match "[^\000-\177]" group)
-                                  (gnus-group-decoded-name group)
-                                group)))
-                          (remove-if-not 'symbolp collection)))
-         (group
-          (gnus-completing-read (or prompt "Group") choices
-                                require-match initial-input
-                                (or hist 'gnus-group-history)
-                                def)))
+respectively if they are omitted.  Regards COLLECTION as a hash table
+if it is not a list."
+  (or collection (setq collection gnus-active-hashtb))
+  (let (choices group)
+    (if (listp collection)
+       (dolist (symbol collection)
+         (setq group (symbol-name symbol))
+         (push (if (string-match "[^\000-\177]" group)
+                   (gnus-group-decoded-name group)
+                 group)
+               choices))
+      (mapatoms (lambda (symbol)
+                 (setq group (symbol-name symbol))
+                 (push (if (string-match "[^\000-\177]" group)
+                           (gnus-group-decoded-name group)
+                         group)
+                       choices))
+               collection))
+    (setq group (gnus-completing-read (or prompt "Group") (nreverse choices)
+                                     require-match initial-input
+                                     (or hist 'gnus-group-history)
+                                     def))
     (if (symbol-value (intern-soft group collection))
        group
       (mm-encode-coding-string group (gnus-group-name-charset nil group)))))

diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 26c3ca34e7b24dc3026293b5f05a8010b8762d02..a9c666e246e7472000279b02aa31c6ea4ca3b5cf 100644 (file)
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -916,7 +916,7 @@ EXTRA is the possible non-standard header."
   (interactive (list (gnus-completing-read "Header"
                                            (mapcar
                                             'car
-                                            (remove-if-not
+                                            (gnus-remove-if-not
                                              (lambda (x) (fboundp (nth 2 x)))
                                              gnus-header-index))
                                            t)

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 484837f7ff96328c1797d43325819455d1afff6e..dc6882ac086b3f02c5ac3611fd08437ecd2bec25 100644 (file)
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -11926,11 +11926,12 @@ save those articles instead."
            ((null split-name)
             (gnus-group-completing-read
              prom
-             (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
+             (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
              nil prefix nil default))
            ((= 1 (length split-name))
             (gnus-group-completing-read
-             prom (remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb)
+             prom
+            (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
              nil prefix 'gnus-group-history (car split-name)))
            (t
             (gnus-completing-read

diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 5fda600348c8809fa4414138b8af26650f565782..b3f73d71fd5a26e5e08e9af3efb46a2a1c2d6697 100644 (file)
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1307,13 +1307,40 @@ This function saves the current buffer."
        (with-current-buffer gnus-group-buffer
         (eq major-mode 'gnus-group-mode))))
 
-(defun gnus-remove-if (predicate list)
-  "Return a copy of LIST with all items satisfying PREDICATE removed."
+(defun gnus-remove-if (predicate sequence &optional hash-table-p)
+  "Return a copy of SEQUENCE with all items satisfying PREDICATE removed.
+SEQUENCE should be a list, a vector, or a string.  Returns always a list.
+If HASH-TABLE-P is non-nil, regards SEQUENCE as a hash table."
   (let (out)
-    (while list
-      (unless (funcall predicate (car list))
-       (push (car list) out))
-      (setq list (cdr list)))
+    (if hash-table-p
+       (mapatoms (lambda (symbol)
+                   (unless (funcall predicate symbol)
+                     (push symbol out)))
+                 sequence)
+      (unless (listp sequence)
+       (setq sequence (append sequence nil)))
+      (while sequence
+       (unless (funcall predicate (car sequence))
+         (push (car sequence) out))
+       (setq sequence (cdr sequence))))
+    (nreverse out)))
+
+(defun gnus-remove-if-not (predicate sequence &optional hash-table-p)
+  "Return a copy of SEQUENCE with all items not satisfying PREDICATE removed.
+SEQUENCE should be a list, a vector, or a string.  Returns always a list.
+If HASH-TABLE-P is non-nil, regards SEQUENCE as a hash table."
+  (let (out)
+    (if hash-table-p
+       (mapatoms (lambda (symbol)
+                   (when (funcall predicate symbol)
+                     (push symbol out)))
+                 sequence)
+      (unless (listp sequence)
+       (setq sequence (append sequence nil)))
+      (while sequence
+       (when (funcall predicate (car sequence))
+         (push (car sequence) out))
+       (setq sequence (cdr sequence))))
     (nreverse out)))
 
 (if (fboundp 'assq-delete-all)