Replace local intersection functions with seq-intersection

* lisp/doc-view.el (doc-view-intersection):
* lisp/gnus/gnus-range.el (gnus-intersection):
* lisp/htmlfontify.el (hfy-interq):
* lisp/loadhist.el (file-set-intersect):
* lisp/mail/smtpmail.el (smtpmail-intersection): Make obsolete in
favor of seq-intersection.  Update all callers.

* lisp/url/url-dav.el (url-intersection): Redefine as obsolete
function alias for seq-intersection.  Update callers.

* lisp/mpc.el (mpc-intersection, mpc-cmd-list, mpc-reorder):
Use seq-intersection.
This commit is contained in:
Stefan Kangas 2021-04-05 01:13:54 +02:00
parent 46b8d7087c
commit 1760029b09
11 changed files with 52 additions and 63 deletions

View file

@ -1802,11 +1802,6 @@ If BACKWARD is non-nil, jump to the previous match."
(remove-overlays (point-min) (point-max) 'doc-view t) (remove-overlays (point-min) (point-max) 'doc-view t)
(if (consp image-mode-winprops-alist) (setq image-mode-winprops-alist nil))) (if (consp image-mode-winprops-alist) (setq image-mode-winprops-alist nil)))
(defun doc-view-intersection (l1 l2)
(let ((l ()))
(dolist (x l1) (if (memq x l2) (push x l)))
l))
(defun doc-view-set-doc-type () (defun doc-view-set-doc-type ()
"Figure out the current document type (`doc-view-doc-type')." "Figure out the current document type (`doc-view-doc-type')."
(let ((name-types (let ((name-types
@ -1841,7 +1836,7 @@ If BACKWARD is non-nil, jump to the previous match."
((looking-at "AT&TFORM") '(djvu)))))) ((looking-at "AT&TFORM") '(djvu))))))
(setq-local (setq-local
doc-view-doc-type doc-view-doc-type
(car (or (doc-view-intersection name-types content-types) (car (or (nreverse (seq-intersection name-types content-types #'eq))
(when (and name-types content-types) (when (and name-types content-types)
(error "Conflicting types: name says %s but content says %s" (error "Conflicting types: name says %s but content says %s"
name-types content-types)) name-types content-types))
@ -2146,6 +2141,12 @@ See the command `doc-view-mode' for more information on this mode."
(add-hook 'bookmark-after-jump-hook show-fn-sym) (add-hook 'bookmark-after-jump-hook show-fn-sym)
(bookmark-default-handler bmk))) (bookmark-default-handler bmk)))
;; Obsolete.
(defun doc-view-intersection (l1 l2)
(declare (obsolete seq-intersection "28.1"))
(nreverse (seq-intersection l1 l2 #'eq)))
(provide 'doc-view) (provide 'doc-view)
;; Local Variables: ;; Local Variables:

View file

@ -6648,9 +6648,10 @@ not have a face in `gnus-article-boring-faces'."
(catch 'only-boring (catch 'only-boring
(while (re-search-forward "\\b\\w\\w" nil t) (while (re-search-forward "\\b\\w\\w" nil t)
(forward-char -1) (forward-char -1)
(when (not (gnus-intersection (when (not (seq-intersection
(gnus-faces-at (point)) (gnus-faces-at (point))
(symbol-value 'gnus-article-boring-faces))) (symbol-value 'gnus-article-boring-faces)
#'eq))
(throw 'only-boring nil))) (throw 'only-boring nil)))
(throw 'only-boring t)))))) (throw 'only-boring t))))))

View file

@ -179,12 +179,8 @@ Both lists have to be sorted over <."
;;;###autoload ;;;###autoload
(defun gnus-intersection (list1 list2) (defun gnus-intersection (list1 list2)
(let ((result nil)) (declare (obsolete seq-intersection "28.1"))
(while list2 (nreverse (seq-intersection list1 list2 #'eq)))
(when (memq (car list2) list1)
(setq result (cons (car list2) result)))
(setq list2 (cdr list2)))
result))
;;;###autoload ;;;###autoload
(defun gnus-sorted-intersection (list1 list2) (defun gnus-sorted-intersection (list1 list2)

View file

@ -578,7 +578,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-new-processable (unmarkp articles) (defun gnus-new-processable (unmarkp articles)
(if unmarkp (if unmarkp
(gnus-intersection gnus-newsgroup-processable articles) (nreverse (seq-intersection gnus-newsgroup-processable articles #'eq))
(gnus-set-difference articles gnus-newsgroup-processable))) (gnus-set-difference articles gnus-newsgroup-processable)))
(defun gnus-uu-mark-by-regexp (regexp &optional unmark) (defun gnus-uu-mark-by-regexp (regexp &optional unmark)

View file

@ -558,7 +558,7 @@ all. This may very well take some time.")
(nnmail-activate 'nndiary) (nnmail-activate 'nndiary)
;; Articles not listed in active-articles are already gone, ;; Articles not listed in active-articles are already gone,
;; so don't try to expire them. ;; so don't try to expire them.
(setq articles (gnus-intersection articles active-articles)) (setq articles (nreverse (seq-intersection articles active-articles #'eq)))
(while articles (while articles
(setq article (nndiary-article-to-file (setq number (pop articles)))) (setq article (nndiary-article-to-file (setq number (pop articles))))
(if (and (nndiary-deletable-article-p group number) (if (and (nndiary-deletable-article-p group number)

View file

@ -528,15 +528,6 @@ therefore no longer care about) will be invalid at any time.\n
(group xdigit xdigit) (group xdigit xdigit)
(group xdigit xdigit))) (group xdigit xdigit)))
(defun hfy-interq (set-a set-b)
"Return the intersection (using `eq') of two lists SET-A and SET-B."
(let ((sa set-a) (interq nil) (elt nil))
(while sa
(setq elt (car sa)
sa (cdr sa))
(if (memq elt set-b) (setq interq (cons elt interq))))
interq))
(defun hfy-color-vals (color) (defun hfy-color-vals (color)
"Where COLOR is a color name or #XXXXXX style triplet, return a "Where COLOR is a color name or #XXXXXX style triplet, return a
list of three (16 bit) rgb values for said color.\n list of three (16 bit) rgb values for said color.\n
@ -884,7 +875,9 @@ See also `hfy-display-class' for details of valid values for CLASS."
(setq score 0) (ignore "t match")) (setq score 0) (ignore "t match"))
((not (cdr (assq key face-class))) ;Neither good nor bad. ((not (cdr (assq key face-class))) ;Neither good nor bad.
nil (ignore "non match, non collision")) nil (ignore "non match, non collision"))
((setq x (hfy-interq val (cdr (assq key face-class)))) ((setq x (nreverse
(seq-intersection val (cdr (assq key face-class))
#'eq)))
(setq score (+ score (length x))) (setq score (+ score (length x)))
(ignore "intersection")) (ignore "intersection"))
(t ;; nope. (t ;; nope.
@ -2352,6 +2345,13 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
(let ((file (hfy-initfile))) (let ((file (hfy-initfile)))
(load file 'NOERROR nil nil) )) (load file 'NOERROR nil nil) ))
;; Obsolete.
(defun hfy-interq (set-a set-b)
"Return the intersection (using `eq') of two lists SET-A and SET-B."
(declare (obsolete seq-intersection "28.1"))
(nreverse (seq-intersection set-a set-b #'eq)))
(provide 'htmlfontify) (provide 'htmlfontify)
;;; htmlfontify.el ends here ;;; htmlfontify.el ends here

View file

@ -82,12 +82,6 @@ A library name is equivalent to the file name that `load-library' would load."
(when (eq (car-safe x) 'require) (when (eq (car-safe x) 'require)
(push (cdr x) requires))))) (push (cdr x) requires)))))
(defsubst file-set-intersect (p q)
"Return the set intersection of two lists."
(let (ret)
(dolist (x p ret)
(when (memq x q) (push x ret)))))
(defun file-dependents (file) (defun file-dependents (file)
"Return the list of loaded libraries that depend on FILE. "Return the list of loaded libraries that depend on FILE.
This can include FILE itself. This can include FILE itself.
@ -97,7 +91,7 @@ A library name is equivalent to the file name that `load-library' would load."
(dependents nil)) (dependents nil))
(dolist (x load-history dependents) (dolist (x load-history dependents)
(when (and (stringp (car x)) (when (and (stringp (car x))
(file-set-intersect provides (file-requires (car x)))) (seq-intersection provides (file-requires (car x)) #'eq))
(push (car x) dependents))))) (push (car x) dependents)))))
(defun read-feature (prompt &optional loaded-p) (defun read-feature (prompt &optional loaded-p)
@ -322,6 +316,13 @@ something strange, such as redefining an Emacs function."
;; Don't return load-history, it is not useful. ;; Don't return load-history, it is not useful.
nil) nil)
;; Obsolete.
(defsubst file-set-intersect (p q)
"Return the set intersection of two lists."
(declare (obsolete seq-intersection "28.1"))
(nreverse (seq-intersection p q #'eq)))
(provide 'loadhist) (provide 'loadhist)
;;; loadhist.el ends here ;;; loadhist.el ends here

View file

@ -489,13 +489,6 @@ for `smtpmail-try-auth-method'.")
recipient recipient
(concat recipient "@" smtpmail-sendto-domain))) (concat recipient "@" smtpmail-sendto-domain)))
(defun smtpmail-intersection (list1 list2)
(let ((result nil))
(dolist (el2 list2)
(when (memq el2 list1)
(push el2 result)))
(nreverse result)))
(defun smtpmail-command-or-throw (process string &optional code) (defun smtpmail-command-or-throw (process string &optional code)
(let (ret) (let (ret)
(smtpmail-send-command process string) (smtpmail-send-command process string)
@ -512,9 +505,10 @@ for `smtpmail-try-auth-method'.")
(if port (if port
(format "%s" port) (format "%s" port)
"smtp")) "smtp"))
(let* ((mechs (smtpmail-intersection (let* ((mechs (seq-intersection
smtpmail-auth-supported
(cdr-safe (assoc 'auth supported-extensions)) (cdr-safe (assoc 'auth supported-extensions))
smtpmail-auth-supported)) #'eq))
(auth-source-creation-prompts (auth-source-creation-prompts
'((user . "SMTP user name for %h: ") '((user . "SMTP user name for %h: ")
(secret . "SMTP password for %u@%h: "))) (secret . "SMTP password for %u@%h: ")))
@ -1087,6 +1081,12 @@ many continuation lines."
(while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
(replace-match "")))))) (replace-match ""))))))
;; Obsolete.
(defun smtpmail-intersection (list1 list2)
(declare (obsolete seq-intersection "28.1"))
(seq-intersection list2 list1 #'eq))
(provide 'smtpmail) (provide 'smtpmail)
;;; smtpmail.el ends here ;;; smtpmail.el ends here

View file

@ -129,12 +129,10 @@
"Return L1 after removing all elements not found in L2. "Return L1 after removing all elements not found in L2.
If SELECTFUN is non-nil, elements aren't compared directly, but instead If SELECTFUN is non-nil, elements aren't compared directly, but instead
they are passed through SELECTFUN before comparison." they are passed through SELECTFUN before comparison."
(let ((res ())) (when selectfun
(if selectfun (setq l2 (mapcar selectfun l2))) (setq l1 (mapcar selectfun l1))
(dolist (elem l1) (setq l2 (mapcar selectfun l2)))
(when (member (if selectfun (funcall selectfun elem) elem) l2) (seq-intersection l1 l2))
(push elem res)))
(nreverse res)))
(defun mpc-event-set-point (event) (defun mpc-event-set-point (event)
(condition-case nil (posn-set-point (event-end event)) (condition-case nil (posn-set-point (event-end event))
@ -698,7 +696,7 @@ The songs are returned as alists."
(let* ((osongs (mpc-cmd-find other-tag value)) (let* ((osongs (mpc-cmd-find other-tag value))
(ofiles (mpc-assq-all 'file (apply 'append osongs))) (ofiles (mpc-assq-all 'file (apply 'append osongs)))
(plfiles (mpc-assq-all 'file (apply 'append plsongs)))) (plfiles (mpc-assq-all 'file (apply 'append plsongs))))
(when (mpc-intersection plfiles ofiles) (when (seq-intersection plfiles ofiles)
(push pl pls))))))) (push pl pls)))))))
pls)) pls))
@ -1669,7 +1667,7 @@ Return non-nil if a selection was deactivated."
(mpc-cmd-list mpc-tag (car cst) val)) (mpc-cmd-list mpc-tag (car cst) val))
(cdr cst))))) (cdr cst)))))
(setq active (setq active
(if (listp active) (mpc-intersection active vals) vals)))) (if (listp active) (seq-intersection active vals) vals))))
(when (listp active) (when (listp active)
;; Remove the selections if they are all in conflict with ;; Remove the selections if they are all in conflict with

View file

@ -1680,6 +1680,7 @@ Sat, 07 Sep 2002 00:00:01 GMT
nil)))) nil))))
nil)) nil))
;; FIXME: Can this be replaced by seq-intersection?
(defun newsticker--lists-intersect-p (list1 list2) (defun newsticker--lists-intersect-p (list1 list2)
"Return t if LIST1 and LIST2 share elements." "Return t if LIST1 and LIST2 share elements."
(let ((result nil)) (let ((result nil))

View file

@ -43,22 +43,11 @@
(defvar url-http-response-status) (defvar url-http-response-status)
(defvar url-http-end-of-headers) (defvar url-http-end-of-headers)
(defun url-intersection (l1 l2)
"Return a list of the elements occurring in both of the lists L1 and L2."
(if (null l2)
l2
(let (result)
(while l1
(if (member (car l1) l2)
(setq result (cons (pop l1) result))
(pop l1)))
(nreverse result))))
;;;###autoload ;;;###autoload
(defun url-dav-supported-p (url) (defun url-dav-supported-p (url)
"Return WebDAV protocol version supported by URL. "Return WebDAV protocol version supported by URL.
Returns nil if WebDAV is not supported." Returns nil if WebDAV is not supported."
(url-intersection url-dav-supported-protocols (seq-intersection url-dav-supported-protocols
(plist-get (url-http-options url) 'dav))) (plist-get (url-http-options url) 'dav)))
(defun url-dav-node-text (node) (defun url-dav-node-text (node)
@ -910,7 +899,9 @@ Returns nil if URL contains no name starting with FILE."
t))) t)))
;;; Miscellaneous stuff. ;;; Obsolete.
(define-obsolete-function-alias 'url-intersection #'seq-intersection "28.1")
(provide 'url-dav) (provide 'url-dav)