code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/cl-seq.el

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