LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - cl-seq.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 65 500 13.0 %
Date: 2017-08-30 10:12:24 Functions: 11 71 15.5 %

          Line data    Source code
       1             : ;;; cl-seq.el --- Common Lisp features, part 3  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1993, 2001-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Dave Gillespie <daveg@synaptics.com>
       6             : ;; Old-Version: 2.02
       7             : ;; Keywords: extensions
       8             : ;; Package: emacs
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; These are extensions to Emacs Lisp that provide a degree of
      28             : ;; Common Lisp compatibility, beyond what is already built-in
      29             : ;; in Emacs Lisp.
      30             : ;;
      31             : ;; This package was written by Dave Gillespie; it is a complete
      32             : ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
      33             : ;;
      34             : ;; Bug reports, comments, and suggestions are welcome!
      35             : 
      36             : ;; This file contains the Common Lisp sequence and list functions
      37             : ;; which take keyword arguments.
      38             : 
      39             : ;; See cl.el for Change Log.
      40             : 
      41             : 
      42             : ;;; Code:
      43             : 
      44             : (require 'cl-lib)
      45             : 
      46             : ;; Keyword parsing.
      47             : ;; This is special-cased here so that we can compile
      48             : ;; this file independent from cl-macs.
      49             : 
      50             : (defmacro cl--parsing-keywords (kwords other-keys &rest body)
      51             :   (declare (indent 2) (debug (sexp sexp &rest form)))
      52          24 :   `(let* ,(mapcar
      53             :            (lambda (x)
      54         119 :              (let* ((var (if (consp x) (car x) x))
      55         119 :                     (mem `(car (cdr (memq ',var cl-keys)))))
      56         119 :                (if (eq var :test-not)
      57         119 :                    (setq mem `(and ,mem (setq cl-test ,mem) t)))
      58         119 :                (if (eq var :if-not)
      59         119 :                    (setq mem `(and ,mem (setq cl-if ,mem) t)))
      60         119 :                (list (intern
      61         119 :                       (format "cl-%s" (substring (symbol-name var) 1)))
      62         119 :                      (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
      63          24 :            kwords)
      64          24 :      ,@(append
      65          24 :         (and (not (eq other-keys t))
      66          23 :              (list
      67          23 :               (list 'let '((cl-keys-temp cl-keys))
      68          23 :                     (list 'while 'cl-keys-temp
      69          23 :                           (list 'or (list 'memq '(car cl-keys-temp)
      70          23 :                                           (list 'quote
      71          23 :                                                 (mapcar
      72          23 :                                                  (function
      73             :                                                   (lambda (x)
      74         124 :                                                     (if (consp x)
      75         147 :                                                         (car x) x)))
      76          23 :                                                  (append kwords
      77          23 :                                                          other-keys))))
      78             :                                 '(car (cdr (memq (quote :allow-other-keys)
      79             :                                                  cl-keys)))
      80             :                                 '(error "Bad keyword argument %s"
      81          23 :                                         (car cl-keys-temp)))
      82          24 :                           '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
      83          24 :         body)))
      84             : 
      85             : (defmacro cl--check-key (x)     ;Expects `cl-key' in context of generated code.
      86             :   (declare (debug edebug-forms))
      87          70 :   `(if cl-key (funcall cl-key ,x) ,x))
      88             : 
      89             : (defmacro cl--check-test-nokey (item x) ;cl-test cl-if cl-test-not cl-if-not.
      90             :   (declare (debug edebug-forms))
      91          17 :   `(cond
      92          17 :     (cl-test (eq (not (funcall cl-test ,item ,x))
      93             :                  cl-test-not))
      94          17 :     (cl-if (eq (not (funcall cl-if ,x)) cl-if-not))
      95          17 :     (t (eql ,item ,x))))
      96             : 
      97             : (defmacro cl--check-test (item x)       ;all of the above.
      98             :   (declare (debug edebug-forms))
      99          14 :   `(cl--check-test-nokey ,item (cl--check-key ,x)))
     100             : 
     101             : (defmacro cl--check-match (x y)         ;cl-key cl-test cl-test-not
     102             :   (declare (debug edebug-forms))
     103           3 :   (setq x `(cl--check-key ,x) y `(cl--check-key ,y))
     104           3 :   `(if cl-test
     105           3 :        (eq (not (funcall cl-test ,x ,y)) cl-test-not)
     106           3 :      (eql ,x ,y)))
     107             : 
     108             : ;; Yuck!  These vars are set/bound by cl--parsing-keywords to match :if :test
     109             : ;; and :key keyword args, and they are also accessed (sometimes) via dynamic
     110             : ;; scoping (and some of those accesses are from macro-expanded code).
     111             : (defvar cl-test) (defvar cl-test-not)
     112             : (defvar cl-if) (defvar cl-if-not)
     113             : (defvar cl-key)
     114             : 
     115             : ;;;###autoload
     116             : (defun cl-reduce (cl-func cl-seq &rest cl-keys)
     117             :   "Reduce two-argument FUNCTION across SEQ.
     118             : \nKeywords supported:  :start :end :from-end :initial-value :key
     119             : 
     120             : Return the result of calling FUNCTION with the first and the
     121             : second element of SEQ, then calling FUNCTION with that result and
     122             : the third element of SEQ, then with that result and the fourth
     123             : element of SEQ, etc.
     124             : 
     125             : If :INITIAL-VALUE is specified, it is added to the front of SEQ.
     126             : If SEQ is empty, return :INITIAL-VALUE and FUNCTION is not
     127             : called.
     128             : 
     129             : \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
     130           0 :   (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
     131           0 :     (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
     132           0 :     (setq cl-seq (cl-subseq cl-seq cl-start cl-end))
     133           0 :     (if cl-from-end (setq cl-seq (nreverse cl-seq)))
     134           0 :     (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
     135           0 :                           (cl-seq (cl--check-key (pop cl-seq)))
     136           0 :                           (t (funcall cl-func)))))
     137           0 :       (if cl-from-end
     138           0 :           (while cl-seq
     139           0 :             (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
     140           0 :                                     cl-accum)))
     141           0 :         (while cl-seq
     142           0 :           (setq cl-accum (funcall cl-func cl-accum
     143           0 :                                   (cl--check-key (pop cl-seq))))))
     144           0 :       cl-accum)))
     145             : 
     146             : ;;;###autoload
     147             : (defun cl-fill (cl-seq cl-item &rest cl-keys)
     148             :   "Fill the elements of SEQ with ITEM.
     149             : \nKeywords supported:  :start :end
     150             : \n(fn SEQ ITEM [KEYWORD VALUE]...)"
     151           0 :   (cl--parsing-keywords ((:start 0) :end) ()
     152           0 :     (if (listp cl-seq)
     153           0 :         (let ((p (nthcdr cl-start cl-seq))
     154           0 :               (n (and cl-end (- cl-end cl-start))))
     155           0 :           (while (and p (or (null n) (>= (cl-decf n) 0)))
     156           0 :             (setcar p cl-item)
     157           0 :             (setq p (cdr p))))
     158           0 :       (or cl-end (setq cl-end (length cl-seq)))
     159           0 :       (if (and (= cl-start 0) (= cl-end (length cl-seq)))
     160           0 :           (fillarray cl-seq cl-item)
     161           0 :         (while (< cl-start cl-end)
     162           0 :           (aset cl-seq cl-start cl-item)
     163           0 :           (setq cl-start (1+ cl-start)))))
     164           0 :     cl-seq))
     165             : 
     166             : ;;;###autoload
     167             : (defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
     168             :   "Replace the elements of SEQ1 with the elements of SEQ2.
     169             : SEQ1 is destructively modified, then returned.
     170             : \nKeywords supported:  :start1 :end1 :start2 :end2
     171             : \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
     172           0 :   (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
     173           0 :     (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
     174           0 :         (or (= cl-start1 cl-start2)
     175           0 :             (let* ((cl-len (length cl-seq1))
     176           0 :                    (cl-n (min (- (or cl-end1 cl-len) cl-start1)
     177           0 :                               (- (or cl-end2 cl-len) cl-start2))))
     178           0 :               (while (>= (setq cl-n (1- cl-n)) 0)
     179           0 :                 (setf (elt cl-seq1 (+ cl-start1 cl-n))
     180           0 :                             (elt cl-seq2 (+ cl-start2 cl-n))))))
     181           0 :       (if (listp cl-seq1)
     182           0 :           (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
     183           0 :                 (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
     184           0 :             (if (listp cl-seq2)
     185           0 :                 (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
     186           0 :                       (cl-n (cond ((and cl-n1 cl-end2)
     187           0 :                                    (min cl-n1 (- cl-end2 cl-start2)))
     188           0 :                                   ((and cl-n1 (null cl-end2)) cl-n1)
     189           0 :                                   ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2)))))
     190           0 :                   (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0)))
     191           0 :                     (setcar cl-p1 (car cl-p2))
     192           0 :                     (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
     193           0 :               (setq cl-end2 (if (null cl-n1)
     194           0 :                                 (or cl-end2 (length cl-seq2))
     195           0 :                               (min (or cl-end2 (length cl-seq2))
     196           0 :                                    (+ cl-start2 cl-n1))))
     197           0 :               (while (and cl-p1 (< cl-start2 cl-end2))
     198           0 :                 (setcar cl-p1 (aref cl-seq2 cl-start2))
     199           0 :                 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
     200           0 :         (setq cl-end1 (min (or cl-end1 (length cl-seq1))
     201           0 :                            (+ cl-start1 (- (or cl-end2 (length cl-seq2))
     202           0 :                                            cl-start2))))
     203           0 :         (if (listp cl-seq2)
     204           0 :             (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
     205           0 :               (while (< cl-start1 cl-end1)
     206           0 :                 (aset cl-seq1 cl-start1 (car cl-p2))
     207           0 :                 (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
     208           0 :           (while (< cl-start1 cl-end1)
     209           0 :             (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
     210           0 :             (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
     211           0 :     cl-seq1))
     212             : 
     213             : ;;;###autoload
     214             : (defun cl-remove (cl-item cl-seq &rest cl-keys)
     215             :   "Remove all occurrences of ITEM in SEQ.
     216             : This is a non-destructive function; it makes a copy of SEQ if necessary
     217             : to avoid corrupting the original SEQ.
     218             : \nKeywords supported:  :test :test-not :key :count :start :end :from-end
     219             : \n(fn ITEM SEQ [KEYWORD VALUE]...)"
     220           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
     221             :                         (:start 0) :end) ()
     222           0 :     (let ((len (length cl-seq)))
     223           0 :       (if (<= (or cl-count (setq cl-count len)) 0)
     224           0 :         cl-seq
     225           0 :         (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
     226           0 :           (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
     227           0 :                                     cl-from-end)))
     228           0 :             (if cl-i
     229           0 :                 (let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
     230           0 :                                      (append (if cl-from-end
     231           0 :                                                  (list :end (1+ cl-i))
     232           0 :                                                (list :start cl-i))
     233           0 :                                              cl-keys))))
     234           0 :                   (if (listp cl-seq) cl-res
     235           0 :                     (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
     236           0 :               cl-seq))
     237           0 :           (setq cl-end (- (or cl-end len) cl-start))
     238           0 :         (if (= cl-start 0)
     239           0 :             (while (and cl-seq (> cl-end 0)
     240           0 :                         (cl--check-test cl-item (car cl-seq))
     241           0 :                         (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
     242           0 :                         (> (setq cl-count (1- cl-count)) 0))))
     243           0 :         (if (and (> cl-count 0) (> cl-end 0))
     244           0 :             (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
     245           0 :                           (setq cl-end (1- cl-end)) (cdr cl-seq))))
     246           0 :               (while (and cl-p (> cl-end 0)
     247           0 :                           (not (cl--check-test cl-item (car cl-p))))
     248           0 :                 (setq cl-p (cdr cl-p) cl-end (1- cl-end)))
     249           0 :               (if (and cl-p (> cl-end 0))
     250           0 :                   (nconc (cl-ldiff cl-seq cl-p)
     251           0 :                          (if (= cl-count 1) (cdr cl-p)
     252           0 :                            (and (cdr cl-p)
     253           0 :                                 (apply 'cl-delete cl-item
     254           0 :                                        (copy-sequence (cdr cl-p))
     255           0 :                                        :start 0 :end (1- cl-end)
     256           0 :                                        :count (1- cl-count) cl-keys))))
     257           0 :                 cl-seq))
     258           0 :           cl-seq))))))
     259             : 
     260             : ;;;###autoload
     261             : (defun cl-remove-if (cl-pred cl-list &rest cl-keys)
     262             :   "Remove all items satisfying PREDICATE in SEQ.
     263             : This is a non-destructive function; it makes a copy of SEQ if necessary
     264             : to avoid corrupting the original SEQ.
     265             : \nKeywords supported:  :key :count :start :end :from-end
     266             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     267           0 :   (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
     268             : 
     269             : ;;;###autoload
     270             : (defun cl-remove-if-not (cl-pred cl-list &rest cl-keys)
     271             :   "Remove all items not satisfying PREDICATE in SEQ.
     272             : This is a non-destructive function; it makes a copy of SEQ if necessary
     273             : to avoid corrupting the original SEQ.
     274             : \nKeywords supported:  :key :count :start :end :from-end
     275             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     276           0 :   (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
     277             : 
     278             : ;;;###autoload
     279             : (defun cl-delete (cl-item cl-seq &rest cl-keys)
     280             :   "Remove all occurrences of ITEM in SEQ.
     281             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     282             : \nKeywords supported:  :test :test-not :key :count :start :end :from-end
     283             : \n(fn ITEM SEQ [KEYWORD VALUE]...)"
     284           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
     285             :                         (:start 0) :end) ()
     286           0 :     (let ((len (length cl-seq)))
     287           0 :       (if (<= (or cl-count (setq cl-count len)) 0)
     288           0 :         cl-seq
     289           0 :       (if (listp cl-seq)
     290           0 :           (if (and cl-from-end (< cl-count (/ len 2)))
     291           0 :               (let (cl-i)
     292           0 :                 (while (and (>= (setq cl-count (1- cl-count)) 0)
     293           0 :                             (setq cl-i (cl--position cl-item cl-seq cl-start
     294           0 :                                                      cl-end cl-from-end)))
     295           0 :                   (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
     296           0 :                     (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
     297           0 :                       (setcdr cl-tail (cdr (cdr cl-tail)))))
     298           0 :                   (setq cl-end cl-i))
     299           0 :                 cl-seq)
     300           0 :             (setq cl-end (- (or cl-end len) cl-start))
     301           0 :             (if (= cl-start 0)
     302           0 :                 (progn
     303           0 :                   (while (and cl-seq
     304           0 :                               (> cl-end 0)
     305           0 :                               (cl--check-test cl-item (car cl-seq))
     306           0 :                               (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
     307           0 :                               (> (setq cl-count (1- cl-count)) 0)))
     308           0 :                   (setq cl-end (1- cl-end)))
     309           0 :               (setq cl-start (1- cl-start)))
     310           0 :             (if (and (> cl-count 0) (> cl-end 0))
     311           0 :                 (let ((cl-p (nthcdr cl-start cl-seq)))
     312           0 :                   (while (and (cdr cl-p) (> cl-end 0))
     313           0 :                     (if (cl--check-test cl-item (car (cdr cl-p)))
     314           0 :                         (progn
     315           0 :                           (setcdr cl-p (cdr (cdr cl-p)))
     316           0 :                           (if (= (setq cl-count (1- cl-count)) 0)
     317           0 :                               (setq cl-end 1)))
     318           0 :                       (setq cl-p (cdr cl-p)))
     319           0 :                     (setq cl-end (1- cl-end)))))
     320           0 :             cl-seq)
     321           0 :         (apply 'cl-remove cl-item cl-seq cl-keys))))))
     322             : 
     323             : ;;;###autoload
     324             : (defun cl-delete-if (cl-pred cl-list &rest cl-keys)
     325             :   "Remove all items satisfying PREDICATE in SEQ.
     326             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     327             : \nKeywords supported:  :key :count :start :end :from-end
     328             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     329           0 :   (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
     330             : 
     331             : ;;;###autoload
     332             : (defun cl-delete-if-not (cl-pred cl-list &rest cl-keys)
     333             :   "Remove all items not satisfying PREDICATE in SEQ.
     334             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     335             : \nKeywords supported:  :key :count :start :end :from-end
     336             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     337           0 :   (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
     338             : 
     339             : ;;;###autoload
     340             : (defun cl-remove-duplicates (cl-seq &rest cl-keys)
     341             :   "Return a copy of SEQ with all duplicate elements removed.
     342             : \nKeywords supported:  :test :test-not :key :start :end :from-end
     343             : \n(fn SEQ [KEYWORD VALUE]...)"
     344           0 :   (cl--delete-duplicates cl-seq cl-keys t))
     345             : 
     346             : ;;;###autoload
     347             : (defun cl-delete-duplicates (cl-seq &rest cl-keys)
     348             :   "Remove all duplicate elements from SEQ (destructively).
     349             : \nKeywords supported:  :test :test-not :key :start :end :from-end
     350             : \n(fn SEQ [KEYWORD VALUE]...)"
     351           0 :   (cl--delete-duplicates cl-seq cl-keys nil))
     352             : 
     353             : (defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
     354           0 :   (if (listp cl-seq)
     355           0 :       (cl--parsing-keywords
     356             :           ;; We need to parse :if, otherwise `cl-if' is unbound.
     357             :           (:test :test-not :key (:start 0) :end :from-end :if)
     358             :           ()
     359           0 :         (if cl-from-end
     360           0 :             (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
     361           0 :               (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
     362           0 :               (while (> cl-end 1)
     363           0 :                 (setq cl-i 0)
     364           0 :                 (while (setq cl-i (cl--position (cl--check-key (car cl-p))
     365           0 :                                                 (cdr cl-p) cl-i (1- cl-end)))
     366           0 :                   (if cl-copy (setq cl-seq (copy-sequence cl-seq)
     367           0 :                                     cl-p (nthcdr cl-start cl-seq) cl-copy nil))
     368           0 :                   (let ((cl-tail (nthcdr cl-i cl-p)))
     369           0 :                     (setcdr cl-tail (cdr (cdr cl-tail))))
     370           0 :                   (setq cl-end (1- cl-end)))
     371           0 :                 (setq cl-p (cdr cl-p) cl-end (1- cl-end)
     372           0 :                       cl-start (1+ cl-start)))
     373           0 :               cl-seq)
     374           0 :           (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
     375           0 :           (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
     376           0 :                       (cl--position (cl--check-key (car cl-seq))
     377           0 :                                     (cdr cl-seq) 0 (1- cl-end)))
     378           0 :             (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
     379           0 :           (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
     380           0 :                         (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
     381           0 :             (while (and (cdr (cdr cl-p)) (> cl-end 1))
     382           0 :               (if (cl--position (cl--check-key (car (cdr cl-p)))
     383           0 :                                 (cdr (cdr cl-p)) 0 (1- cl-end))
     384           0 :                   (progn
     385           0 :                     (if cl-copy (setq cl-seq (copy-sequence cl-seq)
     386           0 :                                       cl-p (nthcdr (1- cl-start) cl-seq)
     387           0 :                                       cl-copy nil))
     388           0 :                     (setcdr cl-p (cdr (cdr cl-p))))
     389           0 :                 (setq cl-p (cdr cl-p)))
     390           0 :               (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
     391           0 :             cl-seq)))
     392           0 :     (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
     393           0 :       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
     394             : 
     395             : ;;;###autoload
     396             : (defun cl-substitute (cl-new cl-old cl-seq &rest cl-keys)
     397             :   "Substitute NEW for OLD in SEQ.
     398             : This is a non-destructive function; it makes a copy of SEQ if necessary
     399             : to avoid corrupting the original SEQ.
     400             : \nKeywords supported:  :test :test-not :key :count :start :end :from-end
     401             : \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
     402           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
     403             :                         (:start 0) :end :from-end) ()
     404           0 :     (if (or (eq cl-old cl-new)
     405           0 :             (<= (or cl-count (setq cl-from-end nil
     406           0 :                                    cl-count (length cl-seq))) 0))
     407           0 :         cl-seq
     408           0 :       (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
     409           0 :         (if (not cl-i)
     410           0 :             cl-seq
     411           0 :           (setq cl-seq (copy-sequence cl-seq))
     412           0 :           (unless cl-from-end
     413           0 :             (setf (elt cl-seq cl-i) cl-new)
     414           0 :             (cl-incf cl-i)
     415           0 :             (cl-decf cl-count))
     416           0 :           (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
     417           0 :                  :start cl-i cl-keys))))))
     418             : 
     419             : ;;;###autoload
     420             : (defun cl-substitute-if (cl-new cl-pred cl-list &rest cl-keys)
     421             :   "Substitute NEW for all items satisfying PREDICATE in SEQ.
     422             : This is a non-destructive function; it makes a copy of SEQ if necessary
     423             : to avoid corrupting the original SEQ.
     424             : \nKeywords supported:  :key :count :start :end :from-end
     425             : \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
     426           0 :   (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
     427             : 
     428             : ;;;###autoload
     429             : (defun cl-substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
     430             :   "Substitute NEW for all items not satisfying PREDICATE in SEQ.
     431             : This is a non-destructive function; it makes a copy of SEQ if necessary
     432             : to avoid corrupting the original SEQ.
     433             : \nKeywords supported:  :key :count :start :end :from-end
     434             : \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
     435           0 :   (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
     436             : 
     437             : ;;;###autoload
     438             : (defun cl-nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
     439             :   "Substitute NEW for OLD in SEQ.
     440             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     441             : \nKeywords supported:  :test :test-not :key :count :start :end :from-end
     442             : \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
     443           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
     444             :                         (:start 0) :end :from-end) ()
     445           0 :     (let ((len (length cl-seq)))
     446           0 :       (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
     447           0 :           (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
     448           0 :             (let ((cl-p (nthcdr cl-start cl-seq)))
     449           0 :               (setq cl-end (- (or cl-end len) cl-start))
     450           0 :               (while (and cl-p (> cl-end 0) (> cl-count 0))
     451           0 :                 (if (cl--check-test cl-old (car cl-p))
     452           0 :                     (progn
     453           0 :                       (setcar cl-p cl-new)
     454           0 :                       (setq cl-count (1- cl-count))))
     455           0 :                 (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
     456           0 :             (or cl-end (setq cl-end len))
     457           0 :           (if cl-from-end
     458           0 :               (while (and (< cl-start cl-end) (> cl-count 0))
     459           0 :                 (setq cl-end (1- cl-end))
     460           0 :                 (if (cl--check-test cl-old (elt cl-seq cl-end))
     461           0 :                     (progn
     462           0 :                       (setf (elt cl-seq cl-end) cl-new)
     463           0 :                       (setq cl-count (1- cl-count)))))
     464           0 :             (while (and (< cl-start cl-end) (> cl-count 0))
     465           0 :               (if (cl--check-test cl-old (aref cl-seq cl-start))
     466           0 :                   (progn
     467           0 :                     (aset cl-seq cl-start cl-new)
     468           0 :                     (setq cl-count (1- cl-count))))
     469           0 :               (setq cl-start (1+ cl-start)))))))
     470           0 :     cl-seq))
     471             : 
     472             : ;;;###autoload
     473             : (defun cl-nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
     474             :   "Substitute NEW for all items satisfying PREDICATE in SEQ.
     475             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     476             : \nKeywords supported:  :key :count :start :end :from-end
     477             : \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
     478           0 :   (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
     479             : 
     480             : ;;;###autoload
     481             : (defun cl-nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
     482             :   "Substitute NEW for all items not satisfying PREDICATE in SEQ.
     483             : This is a destructive function; it reuses the storage of SEQ whenever possible.
     484             : \nKeywords supported:  :key :count :start :end :from-end
     485             : \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
     486           0 :   (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
     487             : 
     488             : ;;;###autoload
     489             : (defun cl-find (cl-item cl-seq &rest cl-keys)
     490             :   "Find the first occurrence of ITEM in SEQ.
     491             : Return the matching ITEM, or nil if not found.
     492             : \nKeywords supported:  :test :test-not :key :start :end :from-end
     493             : \n(fn ITEM SEQ [KEYWORD VALUE]...)"
     494           0 :   (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
     495           0 :     (and cl-pos (elt cl-seq cl-pos))))
     496             : 
     497             : ;;;###autoload
     498             : (defun cl-find-if (cl-pred cl-list &rest cl-keys)
     499             :   "Find the first item satisfying PREDICATE in SEQ.
     500             : Return the matching item, or nil if not found.
     501             : \nKeywords supported:  :key :start :end :from-end
     502             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     503           0 :   (apply 'cl-find nil cl-list :if cl-pred cl-keys))
     504             : 
     505             : ;;;###autoload
     506             : (defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
     507             :   "Find the first item not satisfying PREDICATE in SEQ.
     508             : Return the matching item, or nil if not found.
     509             : \nKeywords supported:  :key :start :end :from-end
     510             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     511           0 :   (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
     512             : 
     513             : ;;;###autoload
     514             : (defun cl-position (cl-item cl-seq &rest cl-keys)
     515             :   "Find the first occurrence of ITEM in SEQ.
     516             : Return the index of the matching item, or nil if not found.
     517             : \nKeywords supported:  :test :test-not :key :start :end :from-end
     518             : \n(fn ITEM SEQ [KEYWORD VALUE]...)"
     519          33 :   (cl--parsing-keywords (:test :test-not :key :if :if-not
     520             :                         (:start 0) :end :from-end) ()
     521          33 :     (cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
     522             : 
     523             : (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
     524          33 :   (if (listp cl-seq)
     525          33 :       (let ((cl-p (nthcdr cl-start cl-seq))
     526             :             cl-res)
     527         303 :         (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end))
     528         270 :             (if (cl--check-test cl-item (car cl-p))
     529         270 :                 (setq cl-res cl-start))
     530         270 :             (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
     531          33 :         cl-res)
     532           0 :     (or cl-end (setq cl-end (length cl-seq)))
     533           0 :     (if cl-from-end
     534           0 :         (progn
     535           0 :           (while (and (>= (setq cl-end (1- cl-end)) cl-start)
     536           0 :                       (not (cl--check-test cl-item (aref cl-seq cl-end)))))
     537           0 :           (and (>= cl-end cl-start) cl-end))
     538           0 :       (while (and (< cl-start cl-end)
     539           0 :                   (not (cl--check-test cl-item (aref cl-seq cl-start))))
     540           0 :         (setq cl-start (1+ cl-start)))
     541          33 :       (and (< cl-start cl-end) cl-start))))
     542             : 
     543             : ;;;###autoload
     544             : (defun cl-position-if (cl-pred cl-list &rest cl-keys)
     545             :   "Find the first item satisfying PREDICATE in SEQ.
     546             : Return the index of the matching item, or nil if not found.
     547             : \nKeywords supported:  :key :start :end :from-end
     548             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     549           0 :   (apply 'cl-position nil cl-list :if cl-pred cl-keys))
     550             : 
     551             : ;;;###autoload
     552             : (defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
     553             :   "Find the first item not satisfying PREDICATE in SEQ.
     554             : Return the index of the matching item, or nil if not found.
     555             : \nKeywords supported:  :key :start :end :from-end
     556             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     557           0 :   (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
     558             : 
     559             : ;;;###autoload
     560             : (defun cl-count (cl-item cl-seq &rest cl-keys)
     561             :   "Count the number of occurrences of ITEM in SEQ.
     562             : \nKeywords supported:  :test :test-not :key :start :end
     563             : \n(fn ITEM SEQ [KEYWORD VALUE]...)"
     564           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
     565           0 :     (let ((cl-count 0) cl-x)
     566           0 :       (or cl-end (setq cl-end (length cl-seq)))
     567           0 :       (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
     568           0 :       (while (< cl-start cl-end)
     569           0 :         (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
     570           0 :         (if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
     571           0 :         (setq cl-start (1+ cl-start)))
     572           0 :       cl-count)))
     573             : 
     574             : ;;;###autoload
     575             : (defun cl-count-if (cl-pred cl-list &rest cl-keys)
     576             :   "Count the number of items satisfying PREDICATE in SEQ.
     577             : \nKeywords supported:  :key :start :end
     578             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     579           0 :   (apply 'cl-count nil cl-list :if cl-pred cl-keys))
     580             : 
     581             : ;;;###autoload
     582             : (defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
     583             :   "Count the number of items not satisfying PREDICATE in SEQ.
     584             : \nKeywords supported:  :key :start :end
     585             : \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
     586           0 :   (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
     587             : 
     588             : ;;;###autoload
     589             : (defun cl-mismatch (cl-seq1 cl-seq2 &rest cl-keys)
     590             :   "Compare SEQ1 with SEQ2, return index of first mismatching element.
     591             : Return nil if the sequences match.  If one sequence is a prefix of the
     592             : other, the return value indicates the end of the shorter sequence.
     593             : \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
     594             : \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
     595           0 :   (cl--parsing-keywords (:test :test-not :key :from-end
     596             :                         (:start1 0) :end1 (:start2 0) :end2) ()
     597           0 :     (or cl-end1 (setq cl-end1 (length cl-seq1)))
     598           0 :     (or cl-end2 (setq cl-end2 (length cl-seq2)))
     599           0 :     (if cl-from-end
     600           0 :         (progn
     601           0 :           (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
     602           0 :                       (cl--check-match (elt cl-seq1 (1- cl-end1))
     603           0 :                                       (elt cl-seq2 (1- cl-end2))))
     604           0 :             (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
     605           0 :           (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
     606           0 :                (1- cl-end1)))
     607           0 :       (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
     608           0 :             (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
     609           0 :         (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
     610           0 :                     (cl--check-match (if cl-p1 (car cl-p1)
     611           0 :                                       (aref cl-seq1 cl-start1))
     612           0 :                                     (if cl-p2 (car cl-p2)
     613           0 :                                       (aref cl-seq2 cl-start2))))
     614           0 :           (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
     615           0 :                 cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
     616           0 :         (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
     617           0 :              cl-start1)))))
     618             : 
     619             : ;;;###autoload
     620             : (defun cl-search (cl-seq1 cl-seq2 &rest cl-keys)
     621             :   "Search for SEQ1 as a subsequence of SEQ2.
     622             : Return the index of the leftmost element of the first match found;
     623             : return nil if there are no matches.
     624             : \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
     625             : \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
     626           0 :   (cl--parsing-keywords (:test :test-not :key :from-end
     627             :                         (:start1 0) :end1 (:start2 0) :end2) ()
     628           0 :     (or cl-end1 (setq cl-end1 (length cl-seq1)))
     629           0 :     (or cl-end2 (setq cl-end2 (length cl-seq2)))
     630           0 :     (if (>= cl-start1 cl-end1)
     631           0 :         (if cl-from-end cl-end2 cl-start2)
     632           0 :       (let* ((cl-len (- cl-end1 cl-start1))
     633           0 :              (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
     634             :              (cl-if nil) cl-pos)
     635           0 :         (setq cl-end2 (- cl-end2 (1- cl-len)))
     636           0 :         (while (and (< cl-start2 cl-end2)
     637           0 :                     (setq cl-pos (cl--position cl-first cl-seq2
     638           0 :                                                cl-start2 cl-end2 cl-from-end))
     639           0 :                     (apply 'cl-mismatch cl-seq1 cl-seq2
     640           0 :                            :start1 (1+ cl-start1) :end1 cl-end1
     641           0 :                            :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
     642           0 :                            :from-end nil cl-keys))
     643           0 :           (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
     644           0 :         (and (< cl-start2 cl-end2) cl-pos)))))
     645             : 
     646             : ;;;###autoload
     647             : (defun cl-sort (cl-seq cl-pred &rest cl-keys)
     648             :   "Sort the argument SEQ according to PREDICATE.
     649             : This is a destructive function; it reuses the storage of SEQ if possible.
     650             : \nKeywords supported:  :key
     651             : \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
     652           0 :   (if (nlistp cl-seq)
     653           0 :       (cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
     654           0 :     (cl--parsing-keywords (:key) ()
     655           0 :       (if (memq cl-key '(nil identity))
     656           0 :           (sort cl-seq cl-pred)
     657           0 :         (sort cl-seq (function (lambda (cl-x cl-y)
     658           0 :                                  (funcall cl-pred (funcall cl-key cl-x)
     659           0 :                                           (funcall cl-key cl-y)))))))))
     660             : 
     661             : ;;;###autoload
     662             : (defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
     663             :   "Sort the argument SEQ stably according to PREDICATE.
     664             : This is a destructive function; it reuses the storage of SEQ if possible.
     665             : \nKeywords supported:  :key
     666             : \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
     667           0 :   (apply 'cl-sort cl-seq cl-pred cl-keys))
     668             : 
     669             : ;;;###autoload
     670             : (defun cl-merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
     671             :   "Destructively merge the two sequences to produce a new sequence.
     672             : TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
     673             : sequences, and PREDICATE is a `less-than' predicate on the elements.
     674             : \nKeywords supported:  :key
     675             : \n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
     676           0 :   (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
     677           0 :   (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
     678           0 :   (cl--parsing-keywords (:key) ()
     679           0 :     (let ((cl-res nil))
     680           0 :       (while (and cl-seq1 cl-seq2)
     681           0 :         (if (funcall cl-pred (cl--check-key (car cl-seq2))
     682           0 :                      (cl--check-key (car cl-seq1)))
     683           0 :             (push (pop cl-seq2) cl-res)
     684           0 :           (push (pop cl-seq1) cl-res)))
     685           0 :       (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
     686             : 
     687             : ;;;###autoload
     688             : (defun cl-member (cl-item cl-list &rest cl-keys)
     689             :   "Find the first occurrence of ITEM in LIST.
     690             : Return the sublist of LIST whose car is ITEM.
     691             : \nKeywords supported:  :test :test-not :key
     692             : \n(fn ITEM LIST [KEYWORD VALUE]...)"
     693             :   (declare (compiler-macro cl--compiler-macro-member))
     694          32 :   (if cl-keys
     695          32 :       (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
     696          88 :         (while (and cl-list (not (cl--check-test cl-item (car cl-list))))
     697          56 :           (setq cl-list (cdr cl-list)))
     698          32 :         cl-list)
     699           0 :     (if (and (numberp cl-item) (not (integerp cl-item)))
     700           0 :         (member cl-item cl-list)
     701          32 :       (memq cl-item cl-list))))
     702             : (autoload 'cl--compiler-macro-member "cl-macs")
     703             : 
     704             : ;;;###autoload
     705             : (defun cl-member-if (cl-pred cl-list &rest cl-keys)
     706             :   "Find the first item satisfying PREDICATE in LIST.
     707             : Return the sublist of LIST whose car matches.
     708             : \nKeywords supported:  :key
     709             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     710           0 :   (apply 'cl-member nil cl-list :if cl-pred cl-keys))
     711             : 
     712             : ;;;###autoload
     713             : (defun cl-member-if-not (cl-pred cl-list &rest cl-keys)
     714             :   "Find the first item not satisfying PREDICATE in LIST.
     715             : Return the sublist of LIST whose car matches.
     716             : \nKeywords supported:  :key
     717             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     718           0 :   (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
     719             : 
     720             : ;;;###autoload
     721             : (defun cl--adjoin (cl-item cl-list &rest cl-keys)
     722           0 :   (if (cl--parsing-keywords (:key) t
     723           0 :         (apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
     724           0 :       cl-list
     725           0 :     (cons cl-item cl-list)))
     726             : 
     727             : ;;;###autoload
     728             : (defun cl-assoc (cl-item cl-alist &rest cl-keys)
     729             :   "Find the first item whose car matches ITEM in LIST.
     730             : \nKeywords supported:  :test :test-not :key
     731             : \n(fn ITEM LIST [KEYWORD VALUE]...)"
     732             :   (declare (compiler-macro cl--compiler-macro-assoc))
     733           0 :   (if cl-keys
     734           0 :       (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
     735           0 :         (while (and cl-alist
     736           0 :                     (or (not (consp (car cl-alist)))
     737           0 :                         (not (cl--check-test cl-item (car (car cl-alist))))))
     738           0 :           (setq cl-alist (cdr cl-alist)))
     739           0 :         (and cl-alist (car cl-alist)))
     740           0 :     (if (and (numberp cl-item) (not (integerp cl-item)))
     741           0 :         (assoc cl-item cl-alist)
     742           0 :       (assq cl-item cl-alist))))
     743             : (autoload 'cl--compiler-macro-assoc "cl-macs")
     744             : 
     745             : ;;;###autoload
     746             : (defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
     747             :   "Find the first item whose car satisfies PREDICATE in LIST.
     748             : \nKeywords supported:  :key
     749             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     750           0 :   (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
     751             : 
     752             : ;;;###autoload
     753             : (defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
     754             :   "Find the first item whose car does not satisfy PREDICATE in LIST.
     755             : \nKeywords supported:  :key
     756             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     757           0 :   (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
     758             : 
     759             : ;;;###autoload
     760             : (defun cl-rassoc (cl-item cl-alist &rest cl-keys)
     761             :   "Find the first item whose cdr matches ITEM in LIST.
     762             : \nKeywords supported:  :test :test-not :key
     763             : \n(fn ITEM LIST [KEYWORD VALUE]...)"
     764           0 :   (if (or cl-keys (numberp cl-item))
     765           0 :       (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
     766           0 :         (while (and cl-alist
     767           0 :                     (or (not (consp (car cl-alist)))
     768           0 :                         (not (cl--check-test cl-item (cdr (car cl-alist))))))
     769           0 :           (setq cl-alist (cdr cl-alist)))
     770           0 :         (and cl-alist (car cl-alist)))
     771           0 :     (rassq cl-item cl-alist)))
     772             : 
     773             : ;;;###autoload
     774             : (defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
     775             :   "Find the first item whose cdr satisfies PREDICATE in LIST.
     776             : \nKeywords supported:  :key
     777             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     778           0 :   (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
     779             : 
     780             : ;;;###autoload
     781             : (defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
     782             :   "Find the first item whose cdr does not satisfy PREDICATE in LIST.
     783             : \nKeywords supported:  :key
     784             : \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
     785           0 :   (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
     786             : 
     787             : ;;;###autoload
     788             : (defun cl-union (cl-list1 cl-list2 &rest cl-keys)
     789             :   "Combine LIST1 and LIST2 using a set-union operation.
     790             : The resulting list contains all items that appear in either LIST1 or LIST2.
     791             : This is a non-destructive function; it makes a copy of the data if necessary
     792             : to avoid corrupting the original LIST1 and LIST2.
     793             : \nKeywords supported:  :test :test-not :key
     794             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     795           0 :   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
     796           0 :         ((and (not cl-keys) (equal cl-list1 cl-list2)) cl-list1)
     797             :         (t
     798           0 :          (or (>= (length cl-list1) (length cl-list2))
     799           0 :              (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
     800           0 :          (while cl-list2
     801           0 :            (if (or cl-keys (numberp (car cl-list2)))
     802           0 :                (setq cl-list1
     803           0 :                      (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
     804           0 :              (or (memq (car cl-list2) cl-list1)
     805           0 :                  (push (car cl-list2) cl-list1)))
     806           0 :            (pop cl-list2))
     807           0 :          cl-list1)))
     808             : 
     809             : ;;;###autoload
     810             : (defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
     811             :   "Combine LIST1 and LIST2 using a set-union operation.
     812             : The resulting list contains all items that appear in either LIST1 or LIST2.
     813             : This is a destructive function; it reuses the storage of LIST1 and LIST2
     814             : whenever possible.
     815             : \nKeywords supported:  :test :test-not :key
     816             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     817           0 :   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
     818           0 :         (t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
     819             : 
     820             : ;;;###autoload
     821             : (defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
     822             :   "Combine LIST1 and LIST2 using a set-intersection operation.
     823             : The resulting list contains all items that appear in both LIST1 and LIST2.
     824             : This is a non-destructive function; it makes a copy of the data if necessary
     825             : to avoid corrupting the original LIST1 and LIST2.
     826             : \nKeywords supported:  :test :test-not :key
     827             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     828          22 :   (and cl-list1 cl-list2
     829          22 :        (if (equal cl-list1 cl-list2) cl-list1
     830          22 :          (cl--parsing-keywords (:key) (:test :test-not)
     831          22 :            (let ((cl-res nil))
     832          22 :              (or (>= (length cl-list1) (length cl-list2))
     833          22 :                  (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
     834          44 :              (while cl-list2
     835          22 :                (if (if (or cl-keys (numberp (car cl-list2)))
     836           0 :                        (apply 'cl-member (cl--check-key (car cl-list2))
     837           0 :                               cl-list1 cl-keys)
     838          22 :                      (memq (car cl-list2) cl-list1))
     839          44 :                    (push (car cl-list2) cl-res))
     840          44 :                (pop cl-list2))
     841          22 :              cl-res)))))
     842             : 
     843             : ;;;###autoload
     844             : (defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
     845             :   "Combine LIST1 and LIST2 using a set-intersection operation.
     846             : The resulting list contains all items that appear in both LIST1 and LIST2.
     847             : This is a destructive function; it reuses the storage of LIST1 and LIST2
     848             : whenever possible.
     849             : \nKeywords supported:  :test :test-not :key
     850             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     851           0 :   (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
     852             : 
     853             : ;;;###autoload
     854             : (defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
     855             :   "Combine LIST1 and LIST2 using a set-difference operation.
     856             : The resulting list contains all items that appear in LIST1 but not LIST2.
     857             : This is a non-destructive function; it makes a copy of the data if necessary
     858             : to avoid corrupting the original LIST1 and LIST2.
     859             : \nKeywords supported:  :test :test-not :key
     860             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     861           0 :   (if (or (null cl-list1) (null cl-list2)) cl-list1
     862           0 :     (cl--parsing-keywords (:key) (:test :test-not)
     863           0 :       (let ((cl-res nil))
     864           0 :         (while cl-list1
     865           0 :           (or (if (or cl-keys (numberp (car cl-list1)))
     866           0 :                   (apply 'cl-member (cl--check-key (car cl-list1))
     867           0 :                          cl-list2 cl-keys)
     868           0 :                 (memq (car cl-list1) cl-list2))
     869           0 :               (push (car cl-list1) cl-res))
     870           0 :           (pop cl-list1))
     871           0 :         (nreverse cl-res)))))
     872             : 
     873             : ;;;###autoload
     874             : (defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
     875             :   "Combine LIST1 and LIST2 using a set-difference operation.
     876             : The resulting list contains all items that appear in LIST1 but not LIST2.
     877             : This is a destructive function; it reuses the storage of LIST1 and LIST2
     878             : whenever possible.
     879             : \nKeywords supported:  :test :test-not :key
     880             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     881           0 :   (if (or (null cl-list1) (null cl-list2)) cl-list1
     882           0 :     (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
     883             : 
     884             : ;;;###autoload
     885             : (defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
     886             :   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
     887             : The resulting list contains all items appearing in exactly one of LIST1, LIST2.
     888             : This is a non-destructive function; it makes a copy of the data if necessary
     889             : to avoid corrupting the original LIST1 and LIST2.
     890             : \nKeywords supported:  :test :test-not :key
     891             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     892           0 :   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
     893           0 :         ((equal cl-list1 cl-list2) nil)
     894           0 :         (t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
     895           0 :                    (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
     896             : 
     897             : ;;;###autoload
     898             : (defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
     899             :   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
     900             : The resulting list contains all items appearing in exactly one of LIST1, LIST2.
     901             : This is a destructive function; it reuses the storage of LIST1 and LIST2
     902             : whenever possible.
     903             : \nKeywords supported:  :test :test-not :key
     904             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     905           0 :   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
     906           0 :         ((equal cl-list1 cl-list2) nil)
     907           0 :         (t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
     908           0 :                   (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
     909             : 
     910             : ;;;###autoload
     911             : (defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
     912             :   "Return true if LIST1 is a subset of LIST2.
     913             : I.e., if every element of LIST1 also appears in LIST2.
     914             : \nKeywords supported:  :test :test-not :key
     915             : \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
     916           0 :   (cond ((null cl-list1) t) ((null cl-list2) nil)
     917           0 :         ((equal cl-list1 cl-list2) t)
     918           0 :         (t (cl--parsing-keywords (:key) (:test :test-not)
     919           0 :              (while (and cl-list1
     920           0 :                          (apply 'cl-member (cl--check-key (car cl-list1))
     921           0 :                                 cl-list2 cl-keys))
     922           0 :                (pop cl-list1))
     923           0 :              (null cl-list1)))))
     924             : 
     925             : ;;;###autoload
     926             : (defun cl-subst-if (cl-new cl-pred cl-tree &rest cl-keys)
     927             :   "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
     928             : Return a copy of TREE with all matching elements replaced by NEW.
     929             : \nKeywords supported:  :key
     930             : \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
     931           0 :   (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
     932             : 
     933             : ;;;###autoload
     934             : (defun cl-subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
     935             :   "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
     936             : Return a copy of TREE with all non-matching elements replaced by NEW.
     937             : \nKeywords supported:  :key
     938             : \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
     939           0 :   (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
     940             : 
     941             : ;;;###autoload
     942             : (defun cl-nsubst (cl-new cl-old cl-tree &rest cl-keys)
     943             :   "Substitute NEW for OLD everywhere in TREE (destructively).
     944             : Any element of TREE which is `eql' to OLD is changed to NEW (via a call
     945             : to `setcar').
     946             : \nKeywords supported:  :test :test-not :key
     947             : \n(fn NEW OLD TREE [KEYWORD VALUE]...)"
     948           0 :   (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
     949             : 
     950             : ;;;###autoload
     951             : (defun cl-nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
     952             :   "Substitute NEW for elements matching PREDICATE in TREE (destructively).
     953             : Any element of TREE which matches is changed to NEW (via a call to `setcar').
     954             : \nKeywords supported:  :key
     955             : \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
     956           0 :   (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
     957             : 
     958             : ;;;###autoload
     959             : (defun cl-nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
     960             :   "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
     961             : Any element of TREE which matches is changed to NEW (via a call to `setcar').
     962             : \nKeywords supported:  :key
     963             : \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
     964           0 :   (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
     965             : 
     966             : (defvar cl--alist)
     967             : 
     968             : ;;;###autoload
     969             : (defun cl-sublis (cl-alist cl-tree &rest cl-keys)
     970             :   "Perform substitutions indicated by ALIST in TREE (non-destructively).
     971             : Return a copy of TREE with all matching elements replaced.
     972             : \nKeywords supported:  :test :test-not :key
     973             : \n(fn ALIST TREE [KEYWORD VALUE]...)"
     974           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
     975           0 :     (let ((cl--alist cl-alist))
     976           0 :       (cl--sublis-rec cl-tree))))
     977             : 
     978             : (defun cl--sublis-rec (cl-tree)   ;Uses cl--alist cl-key/test*/if*.
     979           0 :   (let ((cl-temp (cl--check-key cl-tree)) (cl-p cl--alist))
     980           0 :     (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
     981           0 :       (setq cl-p (cdr cl-p)))
     982           0 :     (if cl-p (cdr (car cl-p))
     983           0 :       (if (consp cl-tree)
     984           0 :           (let ((cl-a (cl--sublis-rec (car cl-tree)))
     985           0 :                 (cl-d (cl--sublis-rec (cdr cl-tree))))
     986           0 :             (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
     987           0 :                 cl-tree
     988           0 :               (cons cl-a cl-d)))
     989           0 :         cl-tree))))
     990             : 
     991             : ;;;###autoload
     992             : (defun cl-nsublis (cl-alist cl-tree &rest cl-keys)
     993             :   "Perform substitutions indicated by ALIST in TREE (destructively).
     994             : Any matching element of TREE is changed via a call to `setcar'.
     995             : \nKeywords supported:  :test :test-not :key
     996             : \n(fn ALIST TREE [KEYWORD VALUE]...)"
     997           0 :   (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
     998           0 :     (let ((cl-hold (list cl-tree))
     999           0 :           (cl--alist cl-alist))
    1000           0 :       (cl--nsublis-rec cl-hold)
    1001           0 :       (car cl-hold))))
    1002             : 
    1003             : (defun cl--nsublis-rec (cl-tree)   ;Uses cl--alist cl-key/test*/if*.
    1004           0 :   (while (consp cl-tree)
    1005           0 :     (let ((cl-temp (cl--check-key (car cl-tree))) (cl-p cl--alist))
    1006           0 :       (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
    1007           0 :         (setq cl-p (cdr cl-p)))
    1008           0 :       (if cl-p (setcar cl-tree (cdr (car cl-p)))
    1009           0 :         (if (consp (car cl-tree)) (cl--nsublis-rec (car cl-tree))))
    1010           0 :       (setq cl-temp (cl--check-key (cdr cl-tree)) cl-p cl--alist)
    1011           0 :       (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
    1012           0 :         (setq cl-p (cdr cl-p)))
    1013           0 :       (if cl-p
    1014           0 :           (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
    1015           0 :         (setq cl-tree (cdr cl-tree))))))
    1016             : 
    1017             : ;;;###autoload
    1018             : (defun cl-tree-equal (cl-x cl-y &rest cl-keys)
    1019             :   "Return t if trees TREE1 and TREE2 have `eql' leaves.
    1020             : Atoms are compared by `eql'; cons cells are compared recursively.
    1021             : \nKeywords supported:  :test :test-not :key
    1022             : \n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
    1023           0 :   (cl--parsing-keywords (:test :test-not :key) ()
    1024           0 :     (cl--tree-equal-rec cl-x cl-y)))
    1025             : 
    1026             : (defun cl--tree-equal-rec (cl-x cl-y)   ;Uses cl-key/test*.
    1027           0 :   (while (and (consp cl-x) (consp cl-y)
    1028           0 :               (cl--tree-equal-rec (car cl-x) (car cl-y)))
    1029           0 :     (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
    1030           0 :   (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
    1031             : 
    1032             : 
    1033             : (run-hooks 'cl-seq-load-hook)
    1034             : 
    1035             : ;; Local variables:
    1036             : ;; byte-compile-dynamic: t
    1037             : ;; generated-autoload-file: "cl-loaddefs.el"
    1038             : ;; End:
    1039             : 
    1040             : (provide 'cl-seq)
    1041             : 
    1042             : ;;; cl-seq.el ends here

Generated by: LCOV version 1.12