Mercurial > emacs
changeset 110779:9d935b7bf464
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Wed, 06 Oct 2010 01:09:32 +0000 |
| parents | 5a595f515d1c |
| children | 1d132c3c1987 |
| files | 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 |
| diffstat | 6 files changed, 75 insertions(+), 24 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/ChangeLog Wed Oct 06 01:09:32 2010 +0000 @@ -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.
--- a/lisp/gnus/gnus-art.el Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/gnus-art.el Wed Oct 06 01:09:32 2010 +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)
--- a/lisp/gnus/gnus-group.el Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/gnus-group.el Wed Oct 06 01:09:32 2010 +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)))))
--- a/lisp/gnus/gnus-score.el Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/gnus-score.el Wed Oct 06 01:09:32 2010 +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)
--- a/lisp/gnus/gnus-sum.el Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/gnus-sum.el Wed Oct 06 01:09:32 2010 +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
--- a/lisp/gnus/gnus-util.el Tue Oct 05 23:42:01 2010 +0000 +++ b/lisp/gnus/gnus-util.el Wed Oct 06 01:09:32 2010 +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." +(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)