From 1760029b092724271f9527543dbd9830b377704f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 5 Apr 2021 01:13:54 +0200 Subject: [PATCH] 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. --- lisp/doc-view.el | 13 +++++++------ lisp/gnus/gnus-art.el | 5 +++-- lisp/gnus/gnus-range.el | 8 ++------ lisp/gnus/gnus-uu.el | 2 +- lisp/gnus/nndiary.el | 2 +- lisp/htmlfontify.el | 20 ++++++++++---------- lisp/loadhist.el | 15 ++++++++------- lisp/mail/smtpmail.el | 18 +++++++++--------- lisp/mpc.el | 14 ++++++-------- lisp/net/newst-backend.el | 1 + lisp/url/url-dav.el | 17 ++++------------- 11 files changed, 52 insertions(+), 63 deletions(-) diff --git a/lisp/doc-view.el b/lisp/doc-view.el index cef09009d95..0ae22934b2c 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1802,11 +1802,6 @@ If BACKWARD is non-nil, jump to the previous match." (remove-overlays (point-min) (point-max) 'doc-view t) (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 () "Figure out the current document type (`doc-view-doc-type')." (let ((name-types @@ -1841,7 +1836,7 @@ If BACKWARD is non-nil, jump to the previous match." ((looking-at "AT&TFORM") '(djvu)))))) (setq-local 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) (error "Conflicting types: name says %s but content says %s" 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) (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) ;; Local Variables: diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c1071c1c68c..d989a4d5bb5 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6648,9 +6648,10 @@ not have a face in `gnus-article-boring-faces'." (catch 'only-boring (while (re-search-forward "\\b\\w\\w" nil t) (forward-char -1) - (when (not (gnus-intersection + (when (not (seq-intersection (gnus-faces-at (point)) - (symbol-value 'gnus-article-boring-faces))) + (symbol-value 'gnus-article-boring-faces) + #'eq)) (throw 'only-boring nil))) (throw 'only-boring t)))))) diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 6cc60cb49b3..456209f3d9a 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -179,12 +179,8 @@ Both lists have to be sorted over <." ;;;###autoload (defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (when (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) + (declare (obsolete seq-intersection "28.1")) + (nreverse (seq-intersection list1 list2 #'eq))) ;;;###autoload (defun gnus-sorted-intersection (list1 list2) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index bd9a1a33ec3..5cbe8495d31 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -578,7 +578,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-new-processable (unmarkp articles) (if unmarkp - (gnus-intersection gnus-newsgroup-processable articles) + (nreverse (seq-intersection gnus-newsgroup-processable articles #'eq)) (gnus-set-difference articles gnus-newsgroup-processable))) (defun gnus-uu-mark-by-regexp (regexp &optional unmark) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 15003fabcd2..adf4427523f 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -558,7 +558,7 @@ all. This may very well take some time.") (nnmail-activate 'nndiary) ;; Articles not listed in active-articles are already gone, ;; 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 (setq article (nndiary-article-to-file (setq number (pop articles)))) (if (and (nndiary-deletable-article-p group number) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 550083d0e28..b453061388f 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -528,15 +528,6 @@ therefore no longer care about) will be invalid at any time.\n (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) "Where COLOR is a color name or #XXXXXX style triplet, return a 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")) ((not (cdr (assq key face-class))) ;Neither good nor bad. 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))) (ignore "intersection")) (t ;; nope. @@ -2352,6 +2345,13 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." (let ((file (hfy-initfile))) (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) ;;; htmlfontify.el ends here diff --git a/lisp/loadhist.el b/lisp/loadhist.el index a60d6b29095..59c002d3078 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -82,12 +82,6 @@ A library name is equivalent to the file name that `load-library' would load." (when (eq (car-safe x) 'require) (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) "Return the list of loaded libraries that depend on FILE. 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)) (dolist (x load-history dependents) (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))))) (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. 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) ;;; loadhist.el ends here diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index ac5e8c3b6fb..ab58aa455e9 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -489,13 +489,6 @@ for `smtpmail-try-auth-method'.") recipient (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) (let (ret) (smtpmail-send-command process string) @@ -512,9 +505,10 @@ for `smtpmail-try-auth-method'.") (if port (format "%s" port) "smtp")) - (let* ((mechs (smtpmail-intersection + (let* ((mechs (seq-intersection + smtpmail-auth-supported (cdr-safe (assoc 'auth supported-extensions)) - smtpmail-auth-supported)) + #'eq)) (auth-source-creation-prompts '((user . "SMTP user name for %h: ") (secret . "SMTP password for %u@%h: "))) @@ -1087,6 +1081,12 @@ many continuation lines." (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (replace-match "")))))) +;; Obsolete. + +(defun smtpmail-intersection (list1 list2) + (declare (obsolete seq-intersection "28.1")) + (seq-intersection list2 list1 #'eq)) + (provide 'smtpmail) ;;; smtpmail.el ends here diff --git a/lisp/mpc.el b/lisp/mpc.el index 827f8aacdd6..315d8c0626d 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -129,12 +129,10 @@ "Return L1 after removing all elements not found in L2. If SELECTFUN is non-nil, elements aren't compared directly, but instead they are passed through SELECTFUN before comparison." - (let ((res ())) - (if selectfun (setq l2 (mapcar selectfun l2))) - (dolist (elem l1) - (when (member (if selectfun (funcall selectfun elem) elem) l2) - (push elem res))) - (nreverse res))) + (when selectfun + (setq l1 (mapcar selectfun l1)) + (setq l2 (mapcar selectfun l2))) + (seq-intersection l1 l2)) (defun mpc-event-set-point (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)) (ofiles (mpc-assq-all 'file (apply 'append osongs))) (plfiles (mpc-assq-all 'file (apply 'append plsongs)))) - (when (mpc-intersection plfiles ofiles) + (when (seq-intersection plfiles ofiles) (push pl pls))))))) pls)) @@ -1669,7 +1667,7 @@ Return non-nil if a selection was deactivated." (mpc-cmd-list mpc-tag (car cst) val)) (cdr cst))))) (setq active - (if (listp active) (mpc-intersection active vals) vals)))) + (if (listp active) (seq-intersection active vals) vals)))) (when (listp active) ;; Remove the selections if they are all in conflict with diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 1d3a5e0f7da..e623dab26df 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -1680,6 +1680,7 @@ Sat, 07 Sep 2002 00:00:01 GMT nil)))) nil)) +;; FIXME: Can this be replaced by seq-intersection? (defun newsticker--lists-intersect-p (list1 list2) "Return t if LIST1 and LIST2 share elements." (let ((result nil)) diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index edb1c1de9fc..192b1ac4f41 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -43,22 +43,11 @@ (defvar url-http-response-status) (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 (defun url-dav-supported-p (url) "Return WebDAV protocol version supported by URL. 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))) (defun url-dav-node-text (node) @@ -910,7 +899,9 @@ Returns nil if URL contains no name starting with FILE." t))) -;;; Miscellaneous stuff. +;;; Obsolete. + +(define-obsolete-function-alias 'url-intersection #'seq-intersection "28.1") (provide 'url-dav) -- 2.39.2