[Emacs-diffs] /srv/bzr/emacs/trunk r101807: Eliminate `remove-if-not' that is a cl function.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 101807
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2010-10-06 01:09:32 +0000
message:
  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.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-art.el
  lisp/gnus/gnus-group.el
  lisp/gnus/gnus-score.el
  lisp/gnus/gnus-sum.el
  lisp/gnus/gnus-util.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-10-05 23:42:01 +0000
+++ b/lisp/gnus/ChangeLog       2010-10-06 01:09:32 +0000
@@ -1,3 +1,16 @@
+2010-10-06  Katsumi Yamaoka  <address@hidden>
+
+       * 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  <address@hidden>
 
        * shr.el (shr-render-td): Allow blank/missing <TD>s.

=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el     2010-10-05 22:43:06 +0000
+++ b/lisp/gnus/gnus-art.el     2010-10-06 01:09:32 +0000
@@ -5139,7 +5139,7 @@
          (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)

=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el   2010-10-05 22:43:06 +0000
+++ b/lisp/gnus/gnus-group.el   2010-10-06 01:09:32 +0000
@@ -2163,23 +2163,33 @@
        (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)))))

=== modified file 'lisp/gnus/gnus-score.el'
--- a/lisp/gnus/gnus-score.el   2010-09-30 08:39:23 +0000
+++ b/lisp/gnus/gnus-score.el   2010-10-06 01:09:32 +0000
@@ -916,7 +916,7 @@
   (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)

=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el     2010-10-05 22:43:06 +0000
+++ b/lisp/gnus/gnus-sum.el     2010-10-06 01:09:32 +0000
@@ -11926,11 +11926,12 @@
            ((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

=== modified file 'lisp/gnus/gnus-util.el'
--- a/lisp/gnus/gnus-util.el    2010-10-05 07:50:08 +0000
+++ b/lisp/gnus/gnus-util.el    2010-10-06 01:09:32 +0000
@@ -1307,13 +1307,40 @@
        (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."
-  (let (out)
-    (while list
-      (unless (funcall predicate (car list))
-       (push (car list) out))
-      (setq list (cdr list)))
+(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)
+    (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)