procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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.
This commit is contained in:
Katsumi Yamaoka 2010-10-06 01:09:32 +00:00
parent a0ec382af2
commit 61c47336fe
6 changed files with 75 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lisp/gnus/ChangeLog
View file

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

2
lisp/gnus/gnus-art.el
View file

@ -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)

38
lisp/gnus/gnus-group.el
View file

@ -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)))))

2
lisp/gnus/gnus-score.el
View file

@ -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)

5
lisp/gnus/gnus-sum.el
View file

@ -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

39
lisp/gnus/gnus-util.el
View file

@ -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)