lisp/emacs-lisp/cl-seq.el

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