comparison lisp/emacs-lisp/cl-seq.el @ 90185:5b029ff3b08d

Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-55 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 320-323) - Update from CVS
author Miles Bader <miles@gnu.org>
date Thu, 26 May 2005 05:42:19 +0000
parents f042e7c0fe20 e74fa19e333d
children f9a65d7ebd29
comparison
equal deleted inserted replaced
90184:9e5e2f01c7ab 90185:5b029ff3b08d
123 (defvar cl-if) (defvar cl-if-not) 123 (defvar cl-if) (defvar cl-if-not)
124 (defvar cl-key) 124 (defvar cl-key)
125 125
126 126
127 (defun reduce (cl-func cl-seq &rest cl-keys) 127 (defun reduce (cl-func cl-seq &rest cl-keys)
128 "Reduce two-argument FUNCTION across SEQUENCE. 128 "Reduce two-argument FUNCTION across SEQ.
129 Keywords supported: :start :end :from-end :initial-value :key" 129 \nKeywords supported: :start :end :from-end :initial-value :key
130 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
130 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () 131 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
131 (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) 132 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
132 (setq cl-seq (subseq cl-seq cl-start cl-end)) 133 (setq cl-seq (subseq cl-seq cl-start cl-end))
133 (if cl-from-end (setq cl-seq (nreverse cl-seq))) 134 (if cl-from-end (setq cl-seq (nreverse cl-seq)))
134 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) 135 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
143 (cl-check-key (pop cl-seq)))))) 144 (cl-check-key (pop cl-seq))))))
144 cl-accum))) 145 cl-accum)))
145 146
146 (defun fill (seq item &rest cl-keys) 147 (defun fill (seq item &rest cl-keys)
147 "Fill the elements of SEQ with ITEM. 148 "Fill the elements of SEQ with ITEM.
148 Keywords supported: :start :end" 149 \nKeywords supported: :start :end
150 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
149 (cl-parsing-keywords ((:start 0) :end) () 151 (cl-parsing-keywords ((:start 0) :end) ()
150 (if (listp seq) 152 (if (listp seq)
151 (let ((p (nthcdr cl-start seq)) 153 (let ((p (nthcdr cl-start seq))
152 (n (if cl-end (- cl-end cl-start) 8000000))) 154 (n (if cl-end (- cl-end cl-start) 8000000)))
153 (while (and p (>= (setq n (1- n)) 0)) 155 (while (and p (>= (setq n (1- n)) 0))
162 seq)) 164 seq))
163 165
164 (defun replace (cl-seq1 cl-seq2 &rest cl-keys) 166 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
165 "Replace the elements of SEQ1 with the elements of SEQ2. 167 "Replace the elements of SEQ1 with the elements of SEQ2.
166 SEQ1 is destructively modified, then returned. 168 SEQ1 is destructively modified, then returned.
167 Keywords supported: :start1 :end1 :start2 :end2" 169 \nKeywords supported: :start1 :end1 :start2 :end2
170 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
168 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () 171 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
169 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) 172 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
170 (or (= cl-start1 cl-start2) 173 (or (= cl-start1 cl-start2)
171 (let* ((cl-len (length cl-seq1)) 174 (let* ((cl-len (length cl-seq1))
172 (cl-n (min (- (or cl-end1 cl-len) cl-start1) 175 (cl-n (min (- (or cl-end1 cl-len) cl-start1)
204 207
205 (defun remove* (cl-item cl-seq &rest cl-keys) 208 (defun remove* (cl-item cl-seq &rest cl-keys)
206 "Remove all occurrences of ITEM in SEQ. 209 "Remove all occurrences of ITEM in SEQ.
207 This is a non-destructive function; it makes a copy of SEQ if necessary 210 This is a non-destructive function; it makes a copy of SEQ if necessary
208 to avoid corrupting the original SEQ. 211 to avoid corrupting the original SEQ.
209 Keywords supported: :test :test-not :key :count :start :end :from-end" 212 \nKeywords supported: :test :test-not :key :count :start :end :from-end
213 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
210 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 214 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
211 (:start 0) :end) () 215 (:start 0) :end) ()
212 (if (<= (or cl-count (setq cl-count 8000000)) 0) 216 (if (<= (or cl-count (setq cl-count 8000000)) 0)
213 cl-seq 217 cl-seq
214 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) 218 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
248 252
249 (defun remove-if (cl-pred cl-list &rest cl-keys) 253 (defun remove-if (cl-pred cl-list &rest cl-keys)
250 "Remove all items satisfying PREDICATE in SEQ. 254 "Remove all items satisfying PREDICATE in SEQ.
251 This is a non-destructive function; it makes a copy of SEQ if necessary 255 This is a non-destructive function; it makes a copy of SEQ if necessary
252 to avoid corrupting the original SEQ. 256 to avoid corrupting the original SEQ.
253 Keywords supported: :key :count :start :end :from-end" 257 \nKeywords supported: :key :count :start :end :from-end
258 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
254 (apply 'remove* nil cl-list :if cl-pred cl-keys)) 259 (apply 'remove* nil cl-list :if cl-pred cl-keys))
255 260
256 (defun remove-if-not (cl-pred cl-list &rest cl-keys) 261 (defun remove-if-not (cl-pred cl-list &rest cl-keys)
257 "Remove all items not satisfying PREDICATE in SEQ. 262 "Remove all items not satisfying PREDICATE in SEQ.
258 This is a non-destructive function; it makes a copy of SEQ if necessary 263 This is a non-destructive function; it makes a copy of SEQ if necessary
259 to avoid corrupting the original SEQ. 264 to avoid corrupting the original SEQ.
260 Keywords supported: :key :count :start :end :from-end" 265 \nKeywords supported: :key :count :start :end :from-end
266 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
261 (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) 267 (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
262 268
263 (defun delete* (cl-item cl-seq &rest cl-keys) 269 (defun delete* (cl-item cl-seq &rest cl-keys)
264 "Remove all occurrences of ITEM in SEQ. 270 "Remove all occurrences of ITEM in SEQ.
265 This is a destructive function; it reuses the storage of SEQ whenever possible. 271 This is a destructive function; it reuses the storage of SEQ whenever possible.
266 Keywords supported: :test :test-not :key :count :start :end :from-end" 272 \nKeywords supported: :test :test-not :key :count :start :end :from-end
273 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
267 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 274 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
268 (:start 0) :end) () 275 (:start 0) :end) ()
269 (if (<= (or cl-count (setq cl-count 8000000)) 0) 276 (if (<= (or cl-count (setq cl-count 8000000)) 0)
270 cl-seq 277 cl-seq
271 (if (listp cl-seq) 278 (if (listp cl-seq)
303 (apply 'remove* cl-item cl-seq cl-keys))))) 310 (apply 'remove* cl-item cl-seq cl-keys)))))
304 311
305 (defun delete-if (cl-pred cl-list &rest cl-keys) 312 (defun delete-if (cl-pred cl-list &rest cl-keys)
306 "Remove all items satisfying PREDICATE in SEQ. 313 "Remove all items satisfying PREDICATE in SEQ.
307 This is a destructive function; it reuses the storage of SEQ whenever possible. 314 This is a destructive function; it reuses the storage of SEQ whenever possible.
308 Keywords supported: :key :count :start :end :from-end" 315 \nKeywords supported: :key :count :start :end :from-end
316 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
309 (apply 'delete* nil cl-list :if cl-pred cl-keys)) 317 (apply 'delete* nil cl-list :if cl-pred cl-keys))
310 318
311 (defun delete-if-not (cl-pred cl-list &rest cl-keys) 319 (defun delete-if-not (cl-pred cl-list &rest cl-keys)
312 "Remove all items not satisfying PREDICATE in SEQ. 320 "Remove all items not satisfying PREDICATE in SEQ.
313 This is a destructive function; it reuses the storage of SEQ whenever possible. 321 This is a destructive function; it reuses the storage of SEQ whenever possible.
314 Keywords supported: :key :count :start :end :from-end" 322 \nKeywords supported: :key :count :start :end :from-end
323 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
315 (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) 324 (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
316 325
317 (defun remove-duplicates (cl-seq &rest cl-keys) 326 (defun remove-duplicates (cl-seq &rest cl-keys)
318 "Return a copy of SEQ with all duplicate elements removed. 327 "Return a copy of SEQ with all duplicate elements removed.
319 Keywords supported: :test :test-not :key :start :end :from-end" 328 \nKeywords supported: :test :test-not :key :start :end :from-end
329 \n(fn SEQ [KEYWORD VALUE]...)"
320 (cl-delete-duplicates cl-seq cl-keys t)) 330 (cl-delete-duplicates cl-seq cl-keys t))
321 331
322 (defun delete-duplicates (cl-seq &rest cl-keys) 332 (defun delete-duplicates (cl-seq &rest cl-keys)
323 "Remove all duplicate elements from SEQ (destructively). 333 "Remove all duplicate elements from SEQ (destructively).
324 Keywords supported: :test :test-not :key :start :end :from-end" 334 \nKeywords supported: :test :test-not :key :start :end :from-end
335 \n(fn SEQ [KEYWORD VALUE]...)"
325 (cl-delete-duplicates cl-seq cl-keys nil)) 336 (cl-delete-duplicates cl-seq cl-keys nil))
326 337
327 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy) 338 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
328 (if (listp cl-seq) 339 (if (listp cl-seq)
329 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) 340 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
366 377
367 (defun substitute (cl-new cl-old cl-seq &rest cl-keys) 378 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
368 "Substitute NEW for OLD in SEQ. 379 "Substitute NEW for OLD in SEQ.
369 This is a non-destructive function; it makes a copy of SEQ if necessary 380 This is a non-destructive function; it makes a copy of SEQ if necessary
370 to avoid corrupting the original SEQ. 381 to avoid corrupting the original SEQ.
371 Keywords supported: :test :test-not :key :count :start :end :from-end" 382 \nKeywords supported: :test :test-not :key :count :start :end :from-end
383 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
372 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 384 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
373 (:start 0) :end :from-end) () 385 (:start 0) :end :from-end) ()
374 (if (or (eq cl-old cl-new) 386 (if (or (eq cl-old cl-new)
375 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) 387 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
376 cl-seq 388 cl-seq
386 398
387 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) 399 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
388 "Substitute NEW for all items satisfying PREDICATE in SEQ. 400 "Substitute NEW for all items satisfying PREDICATE in SEQ.
389 This is a non-destructive function; it makes a copy of SEQ if necessary 401 This is a non-destructive function; it makes a copy of SEQ if necessary
390 to avoid corrupting the original SEQ. 402 to avoid corrupting the original SEQ.
391 Keywords supported: :key :count :start :end :from-end" 403 \nKeywords supported: :key :count :start :end :from-end
404 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
392 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) 405 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
393 406
394 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 407 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
395 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 408 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
396 This is a non-destructive function; it makes a copy of SEQ if necessary 409 This is a non-destructive function; it makes a copy of SEQ if necessary
397 to avoid corrupting the original SEQ. 410 to avoid corrupting the original SEQ.
398 Keywords supported: :key :count :start :end :from-end" 411 \nKeywords supported: :key :count :start :end :from-end
412 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
399 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) 413 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
400 414
401 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) 415 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
402 "Substitute NEW for OLD in SEQ. 416 "Substitute NEW for OLD in SEQ.
403 This is a destructive function; it reuses the storage of SEQ whenever possible. 417 This is a destructive function; it reuses the storage of SEQ whenever possible.
404 Keywords supported: :test :test-not :key :count :start :end :from-end" 418 \nKeywords supported: :test :test-not :key :count :start :end :from-end
419 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
405 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 420 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
406 (:start 0) :end :from-end) () 421 (:start 0) :end :from-end) ()
407 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) 422 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
408 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) 423 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
409 (let ((cl-p (nthcdr cl-start cl-seq))) 424 (let ((cl-p (nthcdr cl-start cl-seq)))
431 cl-seq)) 446 cl-seq))
432 447
433 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) 448 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
434 "Substitute NEW for all items satisfying PREDICATE in SEQ. 449 "Substitute NEW for all items satisfying PREDICATE in SEQ.
435 This is a destructive function; it reuses the storage of SEQ whenever possible. 450 This is a destructive function; it reuses the storage of SEQ whenever possible.
436 Keywords supported: :key :count :start :end :from-end" 451 \nKeywords supported: :key :count :start :end :from-end
452 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
437 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) 453 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
438 454
439 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 455 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
440 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 456 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
441 This is a destructive function; it reuses the storage of SEQ whenever possible. 457 This is a destructive function; it reuses the storage of SEQ whenever possible.
442 Keywords supported: :key :count :start :end :from-end" 458 \nKeywords supported: :key :count :start :end :from-end
459 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
443 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) 460 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
444 461
445 (defun find (cl-item cl-seq &rest cl-keys) 462 (defun find (cl-item cl-seq &rest cl-keys)
446 "Find the first occurrence of ITEM in LIST. 463 "Find the first occurrence of ITEM in SEQ.
447 Return the matching ITEM, or nil if not found. 464 Return the matching ITEM, or nil if not found.
448 Keywords supported: :test :test-not :key :start :end :from-end" 465 \nKeywords supported: :test :test-not :key :start :end :from-end
466 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
449 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) 467 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
450 (and cl-pos (elt cl-seq cl-pos)))) 468 (and cl-pos (elt cl-seq cl-pos))))
451 469
452 (defun find-if (cl-pred cl-list &rest cl-keys) 470 (defun find-if (cl-pred cl-list &rest cl-keys)
453 "Find the first item satisfying PREDICATE in LIST. 471 "Find the first item satisfying PREDICATE in SEQ.
454 Return the matching ITEM, or nil if not found. 472 Return the matching item, or nil if not found.
455 Keywords supported: :key :start :end :from-end" 473 \nKeywords supported: :key :start :end :from-end
474 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
456 (apply 'find nil cl-list :if cl-pred cl-keys)) 475 (apply 'find nil cl-list :if cl-pred cl-keys))
457 476
458 (defun find-if-not (cl-pred cl-list &rest cl-keys) 477 (defun find-if-not (cl-pred cl-list &rest cl-keys)
459 "Find the first item not satisfying PREDICATE in LIST. 478 "Find the first item not satisfying PREDICATE in SEQ.
460 Return the matching ITEM, or nil if not found. 479 Return the matching item, or nil if not found.
461 Keywords supported: :key :start :end :from-end" 480 \nKeywords supported: :key :start :end :from-end
481 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
462 (apply 'find nil cl-list :if-not cl-pred cl-keys)) 482 (apply 'find nil cl-list :if-not cl-pred cl-keys))
463 483
464 (defun position (cl-item cl-seq &rest cl-keys) 484 (defun position (cl-item cl-seq &rest cl-keys)
465 "Find the first occurrence of ITEM in LIST. 485 "Find the first occurrence of ITEM in SEQ.
466 Return the index of the matching item, or nil if not found. 486 Return the index of the matching item, or nil if not found.
467 Keywords supported: :test :test-not :key :start :end :from-end" 487 \nKeywords supported: :test :test-not :key :start :end :from-end
488 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
468 (cl-parsing-keywords (:test :test-not :key :if :if-not 489 (cl-parsing-keywords (:test :test-not :key :if :if-not
469 (:start 0) :end :from-end) () 490 (:start 0) :end :from-end) ()
470 (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) 491 (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
471 492
472 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) 493 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
489 (not (cl-check-test cl-item (aref cl-seq cl-start)))) 510 (not (cl-check-test cl-item (aref cl-seq cl-start))))
490 (setq cl-start (1+ cl-start))) 511 (setq cl-start (1+ cl-start)))
491 (and (< cl-start cl-end) cl-start)))) 512 (and (< cl-start cl-end) cl-start))))
492 513
493 (defun position-if (cl-pred cl-list &rest cl-keys) 514 (defun position-if (cl-pred cl-list &rest cl-keys)
494 "Find the first item satisfying PREDICATE in LIST. 515 "Find the first item satisfying PREDICATE in SEQ.
495 Return the index of the matching item, or nil if not found. 516 Return the index of the matching item, or nil if not found.
496 Keywords supported: :key :start :end :from-end" 517 \nKeywords supported: :key :start :end :from-end
518 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
497 (apply 'position nil cl-list :if cl-pred cl-keys)) 519 (apply 'position nil cl-list :if cl-pred cl-keys))
498 520
499 (defun position-if-not (cl-pred cl-list &rest cl-keys) 521 (defun position-if-not (cl-pred cl-list &rest cl-keys)
500 "Find the first item not satisfying PREDICATE in LIST. 522 "Find the first item not satisfying PREDICATE in SEQ.
501 Return the index of the matching item, or nil if not found. 523 Return the index of the matching item, or nil if not found.
502 Keywords supported: :key :start :end :from-end" 524 \nKeywords supported: :key :start :end :from-end
525 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
503 (apply 'position nil cl-list :if-not cl-pred cl-keys)) 526 (apply 'position nil cl-list :if-not cl-pred cl-keys))
504 527
505 (defun count (cl-item cl-seq &rest cl-keys) 528 (defun count (cl-item cl-seq &rest cl-keys)
506 "Count the number of occurrences of ITEM in LIST. 529 "Count the number of occurrences of ITEM in SEQ.
507 Keywords supported: :test :test-not :key :start :end" 530 \nKeywords supported: :test :test-not :key :start :end
531 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
508 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () 532 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
509 (let ((cl-count 0) cl-x) 533 (let ((cl-count 0) cl-x)
510 (or cl-end (setq cl-end (length cl-seq))) 534 (or cl-end (setq cl-end (length cl-seq)))
511 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) 535 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
512 (while (< cl-start cl-end) 536 (while (< cl-start cl-end)
514 (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) 538 (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
515 (setq cl-start (1+ cl-start))) 539 (setq cl-start (1+ cl-start)))
516 cl-count))) 540 cl-count)))
517 541
518 (defun count-if (cl-pred cl-list &rest cl-keys) 542 (defun count-if (cl-pred cl-list &rest cl-keys)
519 "Count the number of items satisfying PREDICATE in LIST. 543 "Count the number of items satisfying PREDICATE in SEQ.
520 Keywords supported: :key :start :end" 544 \nKeywords supported: :key :start :end
545 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
521 (apply 'count nil cl-list :if cl-pred cl-keys)) 546 (apply 'count nil cl-list :if cl-pred cl-keys))
522 547
523 (defun count-if-not (cl-pred cl-list &rest cl-keys) 548 (defun count-if-not (cl-pred cl-list &rest cl-keys)
524 "Count the number of items not satisfying PREDICATE in LIST. 549 "Count the number of items not satisfying PREDICATE in SEQ.
525 Keywords supported: :key :start :end" 550 \nKeywords supported: :key :start :end
551 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
526 (apply 'count nil cl-list :if-not cl-pred cl-keys)) 552 (apply 'count nil cl-list :if-not cl-pred cl-keys))
527 553
528 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) 554 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
529 "Compare SEQ1 with SEQ2, return index of first mismatching element. 555 "Compare SEQ1 with SEQ2, return index of first mismatching element.
530 Return nil if the sequences match. If one sequence is a prefix of the 556 Return nil if the sequences match. If one sequence is a prefix of the
531 other, the return value indicates the end of the shorter sequence. 557 other, the return value indicates the end of the shorter sequence.
532 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 558 \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
559 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
533 (cl-parsing-keywords (:test :test-not :key :from-end 560 (cl-parsing-keywords (:test :test-not :key :from-end
534 (:start1 0) :end1 (:start2 0) :end2) () 561 (:start1 0) :end1 (:start2 0) :end2) ()
535 (or cl-end1 (setq cl-end1 (length cl-seq1))) 562 (or cl-end1 (setq cl-end1 (length cl-seq1)))
536 (or cl-end2 (setq cl-end2 (length cl-seq2))) 563 (or cl-end2 (setq cl-end2 (length cl-seq2)))
537 (if cl-from-end 564 (if cl-from-end
556 583
557 (defun search (cl-seq1 cl-seq2 &rest cl-keys) 584 (defun search (cl-seq1 cl-seq2 &rest cl-keys)
558 "Search for SEQ1 as a subsequence of SEQ2. 585 "Search for SEQ1 as a subsequence of SEQ2.
559 Return the index of the leftmost element of the first match found; 586 Return the index of the leftmost element of the first match found;
560 return nil if there are no matches. 587 return nil if there are no matches.
561 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 588 \nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
589 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
562 (cl-parsing-keywords (:test :test-not :key :from-end 590 (cl-parsing-keywords (:test :test-not :key :from-end
563 (:start1 0) :end1 (:start2 0) :end2) () 591 (:start1 0) :end1 (:start2 0) :end2) ()
564 (or cl-end1 (setq cl-end1 (length cl-seq1))) 592 (or cl-end1 (setq cl-end1 (length cl-seq1)))
565 (or cl-end2 (setq cl-end2 (length cl-seq2))) 593 (or cl-end2 (setq cl-end2 (length cl-seq2)))
566 (if (>= cl-start1 cl-end1) 594 (if (>= cl-start1 cl-end1)
578 :from-end nil cl-keys)) 606 :from-end nil cl-keys))
579 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) 607 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
580 (and (< cl-start2 cl-end2) cl-pos))))) 608 (and (< cl-start2 cl-end2) cl-pos)))))
581 609
582 (defun sort* (cl-seq cl-pred &rest cl-keys) 610 (defun sort* (cl-seq cl-pred &rest cl-keys)
583 "Sort the argument SEQUENCE according to PREDICATE. 611 "Sort the argument SEQ according to PREDICATE.
584 This is a destructive function; it reuses the storage of SEQUENCE if possible. 612 This is a destructive function; it reuses the storage of SEQ if possible.
585 Keywords supported: :key" 613 \nKeywords supported: :key
614 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
586 (if (nlistp cl-seq) 615 (if (nlistp cl-seq)
587 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) 616 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
588 (cl-parsing-keywords (:key) () 617 (cl-parsing-keywords (:key) ()
589 (if (memq cl-key '(nil identity)) 618 (if (memq cl-key '(nil identity))
590 (sort cl-seq cl-pred) 619 (sort cl-seq cl-pred)
591 (sort cl-seq (function (lambda (cl-x cl-y) 620 (sort cl-seq (function (lambda (cl-x cl-y)
592 (funcall cl-pred (funcall cl-key cl-x) 621 (funcall cl-pred (funcall cl-key cl-x)
593 (funcall cl-key cl-y))))))))) 622 (funcall cl-key cl-y)))))))))
594 623
595 (defun stable-sort (cl-seq cl-pred &rest cl-keys) 624 (defun stable-sort (cl-seq cl-pred &rest cl-keys)
596 "Sort the argument SEQUENCE stably according to PREDICATE. 625 "Sort the argument SEQ stably according to PREDICATE.
597 This is a destructive function; it reuses the storage of SEQUENCE if possible. 626 This is a destructive function; it reuses the storage of SEQ if possible.
598 Keywords supported: :key" 627 \nKeywords supported: :key
628 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
599 (apply 'sort* cl-seq cl-pred cl-keys)) 629 (apply 'sort* cl-seq cl-pred cl-keys))
600 630
601 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) 631 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
602 "Destructively merge the two sequences to produce a new sequence. 632 "Destructively merge the two sequences to produce a new sequence.
603 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two 633 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
604 argument sequences, and PRED is a `less-than' predicate on the elements. 634 sequences, and PREDICATE is a `less-than' predicate on the elements.
605 Keywords supported: :key" 635 \nKeywords supported: :key
636 \n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
606 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) 637 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
607 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) 638 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
608 (cl-parsing-keywords (:key) () 639 (cl-parsing-keywords (:key) ()
609 (let ((cl-res nil)) 640 (let ((cl-res nil))
610 (while (and cl-seq1 cl-seq2) 641 (while (and cl-seq1 cl-seq2)
616 647
617 ;;; See compiler macro in cl-macs.el 648 ;;; See compiler macro in cl-macs.el
618 (defun member* (cl-item cl-list &rest cl-keys) 649 (defun member* (cl-item cl-list &rest cl-keys)
619 "Find the first occurrence of ITEM in LIST. 650 "Find the first occurrence of ITEM in LIST.
620 Return the sublist of LIST whose car is ITEM. 651 Return the sublist of LIST whose car is ITEM.
621 Keywords supported: :test :test-not :key" 652 \nKeywords supported: :test :test-not :key
653 \n(fn ITEM LIST [KEYWORD VALUE]...)"
622 (if cl-keys 654 (if cl-keys
623 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 655 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
624 (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) 656 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
625 (setq cl-list (cdr cl-list))) 657 (setq cl-list (cdr cl-list)))
626 cl-list) 658 cl-list)
629 (memq cl-item cl-list)))) 661 (memq cl-item cl-list))))
630 662
631 (defun member-if (cl-pred cl-list &rest cl-keys) 663 (defun member-if (cl-pred cl-list &rest cl-keys)
632 "Find the first item satisfying PREDICATE in LIST. 664 "Find the first item satisfying PREDICATE in LIST.
633 Return the sublist of LIST whose car matches. 665 Return the sublist of LIST whose car matches.
634 Keywords supported: :key" 666 \nKeywords supported: :key
667 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
635 (apply 'member* nil cl-list :if cl-pred cl-keys)) 668 (apply 'member* nil cl-list :if cl-pred cl-keys))
636 669
637 (defun member-if-not (cl-pred cl-list &rest cl-keys) 670 (defun member-if-not (cl-pred cl-list &rest cl-keys)
638 "Find the first item not satisfying PREDICATE in LIST. 671 "Find the first item not satisfying PREDICATE in LIST.
639 Return the sublist of LIST whose car matches. 672 Return the sublist of LIST whose car matches.
640 Keywords supported: :key" 673 \nKeywords supported: :key
674 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
641 (apply 'member* nil cl-list :if-not cl-pred cl-keys)) 675 (apply 'member* nil cl-list :if-not cl-pred cl-keys))
642 676
643 (defun cl-adjoin (cl-item cl-list &rest cl-keys) 677 (defun cl-adjoin (cl-item cl-list &rest cl-keys)
644 (if (cl-parsing-keywords (:key) t 678 (if (cl-parsing-keywords (:key) t
645 (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) 679 (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
647 (cons cl-item cl-list))) 681 (cons cl-item cl-list)))
648 682
649 ;;; See compiler macro in cl-macs.el 683 ;;; See compiler macro in cl-macs.el
650 (defun assoc* (cl-item cl-alist &rest cl-keys) 684 (defun assoc* (cl-item cl-alist &rest cl-keys)
651 "Find the first item whose car matches ITEM in LIST. 685 "Find the first item whose car matches ITEM in LIST.
652 Keywords supported: :test :test-not :key" 686 \nKeywords supported: :test :test-not :key
687 \n(fn ITEM LIST [KEYWORD VALUE]...)"
653 (if cl-keys 688 (if cl-keys
654 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 689 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
655 (while (and cl-alist 690 (while (and cl-alist
656 (or (not (consp (car cl-alist))) 691 (or (not (consp (car cl-alist)))
657 (not (cl-check-test cl-item (car (car cl-alist)))))) 692 (not (cl-check-test cl-item (car (car cl-alist))))))
661 (assoc cl-item cl-alist) 696 (assoc cl-item cl-alist)
662 (assq cl-item cl-alist)))) 697 (assq cl-item cl-alist))))
663 698
664 (defun assoc-if (cl-pred cl-list &rest cl-keys) 699 (defun assoc-if (cl-pred cl-list &rest cl-keys)
665 "Find the first item whose car satisfies PREDICATE in LIST. 700 "Find the first item whose car satisfies PREDICATE in LIST.
666 Keywords supported: :key" 701 \nKeywords supported: :key
702 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
667 (apply 'assoc* nil cl-list :if cl-pred cl-keys)) 703 (apply 'assoc* nil cl-list :if cl-pred cl-keys))
668 704
669 (defun assoc-if-not (cl-pred cl-list &rest cl-keys) 705 (defun assoc-if-not (cl-pred cl-list &rest cl-keys)
670 "Find the first item whose car does not satisfy PREDICATE in LIST. 706 "Find the first item whose car does not satisfy PREDICATE in LIST.
671 Keywords supported: :key" 707 \nKeywords supported: :key
708 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
672 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) 709 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
673 710
674 (defun rassoc* (cl-item cl-alist &rest cl-keys) 711 (defun rassoc* (cl-item cl-alist &rest cl-keys)
675 "Find the first item whose cdr matches ITEM in LIST. 712 "Find the first item whose cdr matches ITEM in LIST.
676 Keywords supported: :test :test-not :key" 713 \nKeywords supported: :test :test-not :key
714 \n(fn ITEM LIST [KEYWORD VALUE]...)"
677 (if (or cl-keys (numberp cl-item)) 715 (if (or cl-keys (numberp cl-item))
678 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 716 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
679 (while (and cl-alist 717 (while (and cl-alist
680 (or (not (consp (car cl-alist))) 718 (or (not (consp (car cl-alist)))
681 (not (cl-check-test cl-item (cdr (car cl-alist)))))) 719 (not (cl-check-test cl-item (cdr (car cl-alist))))))
683 (and cl-alist (car cl-alist))) 721 (and cl-alist (car cl-alist)))
684 (rassq cl-item cl-alist))) 722 (rassq cl-item cl-alist)))
685 723
686 (defun rassoc-if (cl-pred cl-list &rest cl-keys) 724 (defun rassoc-if (cl-pred cl-list &rest cl-keys)
687 "Find the first item whose cdr satisfies PREDICATE in LIST. 725 "Find the first item whose cdr satisfies PREDICATE in LIST.
688 Keywords supported: :key" 726 \nKeywords supported: :key
727 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
689 (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) 728 (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
690 729
691 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) 730 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
692 "Find the first item whose cdr does not satisfy PREDICATE in LIST. 731 "Find the first item whose cdr does not satisfy PREDICATE in LIST.
693 Keywords supported: :key" 732 \nKeywords supported: :key
733 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
694 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) 734 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
695 735
696 (defun union (cl-list1 cl-list2 &rest cl-keys) 736 (defun union (cl-list1 cl-list2 &rest cl-keys)
697 "Combine LIST1 and LIST2 using a set-union operation. 737 "Combine LIST1 and LIST2 using a set-union operation.
698 The result list contains all items that appear in either LIST1 or LIST2. 738 The result list contains all items that appear in either LIST1 or LIST2.
699 This is a non-destructive function; it makes a copy of the data if necessary 739 This is a non-destructive function; it makes a copy of the data if necessary
700 to avoid corrupting the original LIST1 and LIST2. 740 to avoid corrupting the original LIST1 and LIST2.
701 Keywords supported: :test :test-not :key" 741 \nKeywords supported: :test :test-not :key
742 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
702 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 743 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
703 ((equal cl-list1 cl-list2) cl-list1) 744 ((equal cl-list1 cl-list2) cl-list1)
704 (t 745 (t
705 (or (>= (length cl-list1) (length cl-list2)) 746 (or (>= (length cl-list1) (length cl-list2))
706 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) 747 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
715 (defun nunion (cl-list1 cl-list2 &rest cl-keys) 756 (defun nunion (cl-list1 cl-list2 &rest cl-keys)
716 "Combine LIST1 and LIST2 using a set-union operation. 757 "Combine LIST1 and LIST2 using a set-union operation.
717 The result list contains all items that appear in either LIST1 or LIST2. 758 The result list contains all items that appear in either LIST1 or LIST2.
718 This is a destructive function; it reuses the storage of LIST1 and LIST2 759 This is a destructive function; it reuses the storage of LIST1 and LIST2
719 whenever possible. 760 whenever possible.
720 Keywords supported: :test :test-not :key" 761 \nKeywords supported: :test :test-not :key
762 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
721 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 763 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
722 (t (apply 'union cl-list1 cl-list2 cl-keys)))) 764 (t (apply 'union cl-list1 cl-list2 cl-keys))))
723 765
724 (defun intersection (cl-list1 cl-list2 &rest cl-keys) 766 (defun intersection (cl-list1 cl-list2 &rest cl-keys)
725 "Combine LIST1 and LIST2 using a set-intersection operation. 767 "Combine LIST1 and LIST2 using a set-intersection operation.
726 The result list contains all items that appear in both LIST1 and LIST2. 768 The result list contains all items that appear in both LIST1 and LIST2.
727 This is a non-destructive function; it makes a copy of the data if necessary 769 This is a non-destructive function; it makes a copy of the data if necessary
728 to avoid corrupting the original LIST1 and LIST2. 770 to avoid corrupting the original LIST1 and LIST2.
729 Keywords supported: :test :test-not :key" 771 \nKeywords supported: :test :test-not :key
772 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
730 (and cl-list1 cl-list2 773 (and cl-list1 cl-list2
731 (if (equal cl-list1 cl-list2) cl-list1 774 (if (equal cl-list1 cl-list2) cl-list1
732 (cl-parsing-keywords (:key) (:test :test-not) 775 (cl-parsing-keywords (:key) (:test :test-not)
733 (let ((cl-res nil)) 776 (let ((cl-res nil))
734 (or (>= (length cl-list1) (length cl-list2)) 777 (or (>= (length cl-list1) (length cl-list2))
745 (defun nintersection (cl-list1 cl-list2 &rest cl-keys) 788 (defun nintersection (cl-list1 cl-list2 &rest cl-keys)
746 "Combine LIST1 and LIST2 using a set-intersection operation. 789 "Combine LIST1 and LIST2 using a set-intersection operation.
747 The result list contains all items that appear in both LIST1 and LIST2. 790 The result list contains all items that appear in both LIST1 and LIST2.
748 This is a destructive function; it reuses the storage of LIST1 and LIST2 791 This is a destructive function; it reuses the storage of LIST1 and LIST2
749 whenever possible. 792 whenever possible.
750 Keywords supported: :test :test-not :key" 793 \nKeywords supported: :test :test-not :key
794 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
751 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) 795 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
752 796
753 (defun set-difference (cl-list1 cl-list2 &rest cl-keys) 797 (defun set-difference (cl-list1 cl-list2 &rest cl-keys)
754 "Combine LIST1 and LIST2 using a set-difference operation. 798 "Combine LIST1 and LIST2 using a set-difference operation.
755 The result list contains all items that appear in LIST1 but not LIST2. 799 The result list contains all items that appear in LIST1 but not LIST2.
756 This is a non-destructive function; it makes a copy of the data if necessary 800 This is a non-destructive function; it makes a copy of the data if necessary
757 to avoid corrupting the original LIST1 and LIST2. 801 to avoid corrupting the original LIST1 and LIST2.
758 Keywords supported: :test :test-not :key" 802 \nKeywords supported: :test :test-not :key
803 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
759 (if (or (null cl-list1) (null cl-list2)) cl-list1 804 (if (or (null cl-list1) (null cl-list2)) cl-list1
760 (cl-parsing-keywords (:key) (:test :test-not) 805 (cl-parsing-keywords (:key) (:test :test-not)
761 (let ((cl-res nil)) 806 (let ((cl-res nil))
762 (while cl-list1 807 (while cl-list1
763 (or (if (or cl-keys (numberp (car cl-list1))) 808 (or (if (or cl-keys (numberp (car cl-list1)))
771 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) 816 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
772 "Combine LIST1 and LIST2 using a set-difference operation. 817 "Combine LIST1 and LIST2 using a set-difference operation.
773 The result list contains all items that appear in LIST1 but not LIST2. 818 The result list contains all items that appear in LIST1 but not LIST2.
774 This is a destructive function; it reuses the storage of LIST1 and LIST2 819 This is a destructive function; it reuses the storage of LIST1 and LIST2
775 whenever possible. 820 whenever possible.
776 Keywords supported: :test :test-not :key" 821 \nKeywords supported: :test :test-not :key
822 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
777 (if (or (null cl-list1) (null cl-list2)) cl-list1 823 (if (or (null cl-list1) (null cl-list2)) cl-list1
778 (apply 'set-difference cl-list1 cl-list2 cl-keys))) 824 (apply 'set-difference cl-list1 cl-list2 cl-keys)))
779 825
780 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) 826 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
781 "Combine LIST1 and LIST2 using a set-exclusive-or operation. 827 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
782 The result list contains all items that appear in exactly one of LIST1, LIST2. 828 The result list contains all items that appear in exactly one of LIST1, LIST2.
783 This is a non-destructive function; it makes a copy of the data if necessary 829 This is a non-destructive function; it makes a copy of the data if necessary
784 to avoid corrupting the original LIST1 and LIST2. 830 to avoid corrupting the original LIST1 and LIST2.
785 Keywords supported: :test :test-not :key" 831 \nKeywords supported: :test :test-not :key
832 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
786 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 833 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
787 ((equal cl-list1 cl-list2) nil) 834 ((equal cl-list1 cl-list2) nil)
788 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) 835 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
789 (apply 'set-difference cl-list2 cl-list1 cl-keys))))) 836 (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
790 837
791 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) 838 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
792 "Combine LIST1 and LIST2 using a set-exclusive-or operation. 839 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
793 The result list contains all items that appear in exactly one of LIST1, LIST2. 840 The result list contains all items that appear in exactly one of LIST1, LIST2.
794 This is a destructive function; it reuses the storage of LIST1 and LIST2 841 This is a destructive function; it reuses the storage of LIST1 and LIST2
795 whenever possible. 842 whenever possible.
796 Keywords supported: :test :test-not :key" 843 \nKeywords supported: :test :test-not :key
844 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
797 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 845 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
798 ((equal cl-list1 cl-list2) nil) 846 ((equal cl-list1 cl-list2) nil)
799 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) 847 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
800 (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) 848 (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
801 849
802 (defun subsetp (cl-list1 cl-list2 &rest cl-keys) 850 (defun subsetp (cl-list1 cl-list2 &rest cl-keys)
803 "Return true if LIST1 is a subset of LIST2. 851 "Return true if LIST1 is a subset of LIST2.
804 I.e., if every element of LIST1 also appears in LIST2. 852 I.e., if every element of LIST1 also appears in LIST2.
805 Keywords supported: :test :test-not :key" 853 \nKeywords supported: :test :test-not :key
854 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
806 (cond ((null cl-list1) t) ((null cl-list2) nil) 855 (cond ((null cl-list1) t) ((null cl-list2) nil)
807 ((equal cl-list1 cl-list2) t) 856 ((equal cl-list1 cl-list2) t)
808 (t (cl-parsing-keywords (:key) (:test :test-not) 857 (t (cl-parsing-keywords (:key) (:test :test-not)
809 (while (and cl-list1 858 (while (and cl-list1
810 (apply 'member* (cl-check-key (car cl-list1)) 859 (apply 'member* (cl-check-key (car cl-list1))
813 (null cl-list1))))) 862 (null cl-list1)))))
814 863
815 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) 864 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
816 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). 865 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
817 Return a copy of TREE with all matching elements replaced by NEW. 866 Return a copy of TREE with all matching elements replaced by NEW.
818 Keywords supported: :key" 867 \nKeywords supported: :key
868 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
819 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 869 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
820 870
821 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 871 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
822 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). 872 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
823 Return a copy of TREE with all non-matching elements replaced by NEW. 873 Return a copy of TREE with all non-matching elements replaced by NEW.
824 Keywords supported: :key" 874 \nKeywords supported: :key
875 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
825 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 876 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
826 877
827 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) 878 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
828 "Substitute NEW for OLD everywhere in TREE (destructively). 879 "Substitute NEW for OLD everywhere in TREE (destructively).
829 Any element of TREE which is `eql' to OLD is changed to NEW (via a call 880 Any element of TREE which is `eql' to OLD is changed to NEW (via a call
830 to `setcar'). 881 to `setcar').
831 Keywords supported: :test :test-not :key" 882 \nKeywords supported: :test :test-not :key
883 \n(fn NEW OLD TREE [KEYWORD VALUE]...)"
832 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) 884 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
833 885
834 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) 886 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
835 "Substitute NEW for elements matching PREDICATE in TREE (destructively). 887 "Substitute NEW for elements matching PREDICATE in TREE (destructively).
836 Any element of TREE which matches is changed to NEW (via a call to `setcar'). 888 Any element of TREE which matches is changed to NEW (via a call to `setcar').
837 Keywords supported: :key" 889 \nKeywords supported: :key
890 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
838 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 891 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
839 892
840 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 893 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
841 "Substitute NEW for elements not matching PREDICATE in TREE (destructively). 894 "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
842 Any element of TREE which matches is changed to NEW (via a call to `setcar'). 895 Any element of TREE which matches is changed to NEW (via a call to `setcar').
843 Keywords supported: :key" 896 \nKeywords supported: :key
897 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
844 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 898 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
845 899
846 (defun sublis (cl-alist cl-tree &rest cl-keys) 900 (defun sublis (cl-alist cl-tree &rest cl-keys)
847 "Perform substitutions indicated by ALIST in TREE (non-destructively). 901 "Perform substitutions indicated by ALIST in TREE (non-destructively).
848 Return a copy of TREE with all matching elements replaced. 902 Return a copy of TREE with all matching elements replaced.
849 Keywords supported: :test :test-not :key" 903 \nKeywords supported: :test :test-not :key
904 \n(fn ALIST TREE [KEYWORD VALUE]...)"
850 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 905 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
851 (cl-sublis-rec cl-tree))) 906 (cl-sublis-rec cl-tree)))
852 907
853 (defvar cl-alist) 908 (defvar cl-alist)
854 (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* 909 (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
865 cl-tree)))) 920 cl-tree))))
866 921
867 (defun nsublis (cl-alist cl-tree &rest cl-keys) 922 (defun nsublis (cl-alist cl-tree &rest cl-keys)
868 "Perform substitutions indicated by ALIST in TREE (destructively). 923 "Perform substitutions indicated by ALIST in TREE (destructively).
869 Any matching element of TREE is changed via a call to `setcar'. 924 Any matching element of TREE is changed via a call to `setcar'.
870 Keywords supported: :test :test-not :key" 925 \nKeywords supported: :test :test-not :key
926 \n(fn ALIST TREE [KEYWORD VALUE]...)"
871 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 927 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
872 (let ((cl-hold (list cl-tree))) 928 (let ((cl-hold (list cl-tree)))
873 (cl-nsublis-rec cl-hold) 929 (cl-nsublis-rec cl-hold)
874 (car cl-hold)))) 930 (car cl-hold))))
875 931
886 (if cl-p 942 (if cl-p
887 (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) 943 (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
888 (setq cl-tree (cdr cl-tree)))))) 944 (setq cl-tree (cdr cl-tree))))))
889 945
890 (defun tree-equal (cl-x cl-y &rest cl-keys) 946 (defun tree-equal (cl-x cl-y &rest cl-keys)
891 "Return t if trees X and Y have `eql' leaves. 947 "Return t if trees TREE1 and TREE2 have `eql' leaves.
892 Atoms are compared by `eql'; cons cells are compared recursively. 948 Atoms are compared by `eql'; cons cells are compared recursively.
893 Keywords supported: :test :test-not :key" 949 \nKeywords supported: :test :test-not :key
950 \n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
894 (cl-parsing-keywords (:test :test-not :key) () 951 (cl-parsing-keywords (:test :test-not :key) ()
895 (cl-tree-equal-rec cl-x cl-y))) 952 (cl-tree-equal-rec cl-x cl-y)))
896 953
897 (defun cl-tree-equal-rec (cl-x cl-y) 954 (defun cl-tree-equal-rec (cl-x cl-y)
898 (while (and (consp cl-x) (consp cl-y) 955 (while (and (consp cl-x) (consp cl-y)