Mercurial > hg > xemacs-beta

comparison lisp/cl-seq.el @ 5066:545ec923b4eb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add documentation on keywords to cl*.el -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * cl-seq.el: * cl-seq.el (reduce): * cl-seq.el (fill): * cl-seq.el (replace): * cl-seq.el (remove*): * cl-seq.el (remove-if): * cl-seq.el (remove-if-not): * cl-seq.el (delete*): * cl-seq.el (delete-if): * cl-seq.el (delete-if-not): * cl-seq.el (remove-duplicates): * cl-seq.el (delete-duplicates): * cl-seq.el (substitute): * cl-seq.el (substitute-if): * cl-seq.el (substitute-if-not): * cl-seq.el (nsubstitute): * cl-seq.el (nsubstitute-if): * cl-seq.el (nsubstitute-if-not): * cl-seq.el (find): * cl-seq.el (find-if): * cl-seq.el (find-if-not): * cl-seq.el (position): * cl-seq.el (position-if): * cl-seq.el (position-if-not): * cl-seq.el (count): * cl-seq.el (count-if): * cl-seq.el (count-if-not): * cl-seq.el (mismatch): * cl-seq.el (search): * cl-seq.el (sort*): * cl-seq.el (stable-sort): * cl-seq.el (merge): * cl-seq.el (member*): * cl-seq.el (member-if): * cl-seq.el (member-if-not): * cl-seq.el (assoc*): * cl-seq.el (assoc-if): * cl-seq.el (assoc-if-not): * cl-seq.el (rassoc*): * cl-seq.el (rassoc-if): * cl-seq.el (rassoc-if-not): * cl-seq.el (union): * cl-seq.el (nunion): * cl-seq.el (intersection): * cl-seq.el (nintersection): * cl-seq.el (set-difference): * cl-seq.el (nset-difference): * cl-seq.el (set-exclusive-or): * cl-seq.el (nset-exclusive-or): * cl-seq.el (subsetp): * cl-seq.el (subst-if): * cl-seq.el (subst-if-not): * cl-seq.el (nsubst): * cl-seq.el (nsubst-if): * cl-seq.el (nsubst-if-not): * cl-seq.el (sublis): * cl-seq.el (nsublis): * cl-seq.el (tree-equal): * cl-seq.el (cl-tree-equal-rec): * cl.el: * cl.el (pushnew): * cl.el (adjoin): * cl.el (subst): Document the keywords to the various sequence/list functions.
author Ben Wing <ben@xemacs.org>
date Mon, 22 Feb 2010 21:17:47 -0600
parents 6772ce4d982b
children 7d7ae8db0341
comparison
equal deleted inserted replaced
5065:133e816778ed 5066:545ec923b4eb
1 ;;; cl-seq.el --- Common Lisp extensions for XEmacs Lisp (part three) 1 ;;; cl-seq.el --- Common Lisp extensions for XEmacs Lisp (part three)
2 2
3 ;; Copyright (C) 1993 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
4 ;; Copyright (C) 2010 Ben Wing.
4 5
5 ;; Author: Dave Gillespie <daveg@synaptics.com> 6 ;; Author: Dave Gillespie <daveg@synaptics.com>
6 ;; Maintainer: XEmacs Development Team 7 ;; Maintainer: XEmacs Development Team
7 ;; Version: 2.02 8 ;; Version: 2.02
8 ;; Keywords: extensions, dumped 9 ;; Keywords: extensions, dumped
145 (defvar cl-if) (defvar cl-if-not) 146 (defvar cl-if) (defvar cl-if-not)
146 (defvar cl-key) 147 (defvar cl-key)
147 148
148 149
149 (defun reduce (cl-func cl-seq &rest cl-keys) 150 (defun reduce (cl-func cl-seq &rest cl-keys)
150 "Reduce two-argument FUNCTION across SEQUENCE. 151 "Combine the elements of sequence using FUNCTION, a binary operation.
151 Keywords supported: :start :end :from-end :initial-value :key" 152 For example, `(reduce #'+ SEQUENCE)' returns the sum of all elements in
153 SEQUENCE, and `(reduce #'union SEQUENCE)' returns the union of all elements
154 in SEQUENCE.
155 Keywords supported: :start :end :from-end :initial-value :key
156 See `remove*' for the meaning of :start, :end, :from-end and :key.
157 :initial-value specifies an element (typically an identity element, such as 0)
158 that is conceptually prepended to the sequence (or appended, when :from-end
159 is given).
160 If the sequence has one element, that element is returned directly.
161 If the sequence has no elements, :initial-value is returned if given;
162 otherwise, FUNCTION is called with no arguments, and its result returned."
152 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () 163 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
153 (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) 164 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
154 (setq cl-seq (subseq cl-seq cl-start cl-end)) 165 (setq cl-seq (subseq cl-seq cl-start cl-end))
155 (if cl-from-end (setq cl-seq (nreverse cl-seq))) 166 (if cl-from-end (setq cl-seq (nreverse cl-seq)))
156 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value) 167 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
165 (cl-check-key (pop cl-seq)))))) 176 (cl-check-key (pop cl-seq))))))
166 cl-accum))) 177 cl-accum)))
167 178
168 (defun fill (seq item &rest cl-keys) 179 (defun fill (seq item &rest cl-keys)
169 "Fill the elements of SEQ with ITEM. 180 "Fill the elements of SEQ with ITEM.
170 Keywords supported: :start :end" 181 Keywords supported: :start :end
182 :start and :end specify a subsequence of SEQ; see `remove*' for more
183 information."
171 (cl-parsing-keywords ((:start 0) :end) () 184 (cl-parsing-keywords ((:start 0) :end) ()
172 (if (listp seq) 185 (if (listp seq)
173 (let ((p (nthcdr cl-start seq)) 186 (let ((p (nthcdr cl-start seq))
174 (n (if cl-end (- cl-end cl-start) 8000000))) 187 (n (if cl-end (- cl-end cl-start) 8000000)))
175 (while (and p (>= (setq n (1- n)) 0)) 188 (while (and p (>= (setq n (1- n)) 0))
184 seq)) 197 seq))
185 198
186 (defun replace (cl-seq1 cl-seq2 &rest cl-keys) 199 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
187 "Replace the elements of SEQ1 with the elements of SEQ2. 200 "Replace the elements of SEQ1 with the elements of SEQ2.
188 SEQ1 is destructively modified, then returned. 201 SEQ1 is destructively modified, then returned.
189 Keywords supported: :start1 :end1 :start2 :end2" 202 Keywords supported: :start1 :end1 :start2 :end2
203 :start1 and :end1 specify a subsequence of SEQ1, and :start2 and :end2 a
204 subsequence of SEQ2; see `search' for more information."
190 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () 205 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
191 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) 206 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
192 (or (= cl-start1 cl-start2) 207 (or (= cl-start1 cl-start2)
193 (let* ((cl-len (length cl-seq1)) 208 (let* ((cl-len (length cl-seq1))
194 (cl-n (min (- (or cl-end1 cl-len) cl-start1) 209 (cl-n (min (- (or cl-end1 cl-len) cl-start1)
226 241
227 (defun remove* (cl-item cl-seq &rest cl-keys) 242 (defun remove* (cl-item cl-seq &rest cl-keys)
228 "Remove all occurrences of ITEM in SEQ. 243 "Remove all occurrences of ITEM in SEQ.
229 This is a non-destructive function; it makes a copy of SEQ if necessary 244 This is a non-destructive function; it makes a copy of SEQ if necessary
230 to avoid corrupting the original SEQ. 245 to avoid corrupting the original SEQ.
231 Keywords supported: :test :test-not :key :count :start :end :from-end" 246 Keywords supported: :test :test-not :key :count :start :end :from-end
247 The keywords :test and :test-not specify two-argument test and negated-test
248 predicates, respectively; :test defaults to `eql'. :key specifies a
249 one-argument function that transforms elements of SEQ into \"comparison keys\"
250 before the test predicate is applied. See `member*' for more information
251 on these keywords.
252 :start and :end, if given, specify indices of a subsequence of SEQ to
253 be processed. Indices are 0-based and processing involves the subsequence
254 starting at the index given by :start and ending just before the index
255 given by :end.
256 :count, if given, limits the number of items removed to the number specified.
257 :from-end, if given, causes processing to proceed starting from the end
258 instead of the beginning; in this case, this matters only if :count is given."
232 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 259 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
233 (:start 0) :end) () 260 (:start 0) :end) ()
234 (if (<= (or cl-count (setq cl-count 8000000)) 0) 261 (if (<= (or cl-count (setq cl-count 8000000)) 0)
235 cl-seq 262 cl-seq
236 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) 263 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
270 297
271 (defun remove-if (cl-pred cl-list &rest cl-keys) 298 (defun remove-if (cl-pred cl-list &rest cl-keys)
272 "Remove all items satisfying PREDICATE in SEQ. 299 "Remove all items satisfying PREDICATE in SEQ.
273 This is a non-destructive function; it makes a copy of SEQ if necessary 300 This is a non-destructive function; it makes a copy of SEQ if necessary
274 to avoid corrupting the original SEQ. 301 to avoid corrupting the original SEQ.
275 Keywords supported: :key :count :start :end :from-end" 302 Keywords supported: :key :count :start :end :from-end
303 See `remove*' for the meaning of the keywords."
276 (apply 'remove* nil cl-list :if cl-pred cl-keys)) 304 (apply 'remove* nil cl-list :if cl-pred cl-keys))
277 305
278 (defun remove-if-not (cl-pred cl-list &rest cl-keys) 306 (defun remove-if-not (cl-pred cl-list &rest cl-keys)
279 "Remove all items not satisfying PREDICATE in SEQ. 307 "Remove all items not satisfying PREDICATE in SEQ.
280 This is a non-destructive function; it makes a copy of SEQ if necessary 308 This is a non-destructive function; it makes a copy of SEQ if necessary
281 to avoid corrupting the original SEQ. 309 to avoid corrupting the original SEQ.
282 Keywords supported: :key :count :start :end :from-end" 310 Keywords supported: :key :count :start :end :from-end
311 See `remove*' for the meaning of the keywords."
283 (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) 312 (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
284 313
285 (defun delete* (cl-item cl-seq &rest cl-keys) 314 (defun delete* (cl-item cl-seq &rest cl-keys)
286 "Remove all occurrences of ITEM in SEQ. 315 "Remove all occurrences of ITEM in SEQ.
287 This is a destructive function; it reuses the storage of SEQ whenever possible. 316 This is a destructive function; it reuses the storage of SEQ whenever possible.
288 Keywords supported: :test :test-not :key :count :start :end :from-end" 317 Keywords supported: :test :test-not :key :count :start :end :from-end
318 See `remove*' for the meaning of the keywords."
289 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 319 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
290 (:start 0) :end) () 320 (:start 0) :end) ()
291 (if (<= (or cl-count (setq cl-count 8000000)) 0) 321 (if (<= (or cl-count (setq cl-count 8000000)) 0)
292 cl-seq 322 cl-seq
293 (if (listp cl-seq) 323 (if (listp cl-seq)
325 (apply 'remove* cl-item cl-seq cl-keys))))) 355 (apply 'remove* cl-item cl-seq cl-keys)))))
326 356
327 (defun delete-if (cl-pred cl-list &rest cl-keys) 357 (defun delete-if (cl-pred cl-list &rest cl-keys)
328 "Remove all items satisfying PREDICATE in SEQ. 358 "Remove all items satisfying PREDICATE in SEQ.
329 This is a destructive function; it reuses the storage of SEQ whenever possible. 359 This is a destructive function; it reuses the storage of SEQ whenever possible.
330 Keywords supported: :key :count :start :end :from-end" 360 Keywords supported: :key :count :start :end :from-end
361 See `remove*' for the meaning of the keywords."
331 (apply 'delete* nil cl-list :if cl-pred cl-keys)) 362 (apply 'delete* nil cl-list :if cl-pred cl-keys))
332 363
333 (defun delete-if-not (cl-pred cl-list &rest cl-keys) 364 (defun delete-if-not (cl-pred cl-list &rest cl-keys)
334 "Remove all items not satisfying PREDICATE in SEQ. 365 "Remove all items not satisfying PREDICATE in SEQ.
335 This is a destructive function; it reuses the storage of SEQ whenever possible. 366 This is a destructive function; it reuses the storage of SEQ whenever possible.
336 Keywords supported: :key :count :start :end :from-end" 367 Keywords supported: :key :count :start :end :from-end
368 See `remove*' for the meaning of the keywords."
337 (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) 369 (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
338 370
339 ;; XEmacs change: this is in subr.el in Emacs 371 ;; XEmacs change: this is in subr.el in GNU Emacs
340 (defun remove (cl-item cl-seq) 372 (defun remove (cl-item cl-seq)
341 "Remove all occurrences of ITEM in SEQ, testing with `equal' 373 "Remove all occurrences of ITEM in SEQ, testing with `equal'
342 This is a non-destructive function; it makes a copy of SEQ if necessary 374 This is a non-destructive function; it makes a copy of SEQ if necessary
343 to avoid corrupting the original SEQ. 375 to avoid corrupting the original SEQ.
344 Also see: `remove*', `delete', `delete*'" 376 Also see: `remove*', `delete', `delete*'"
345 (remove* cl-item cl-seq ':test 'equal)) 377 (remove* cl-item cl-seq ':test 'equal))
346 378
347 ;; XEmacs change: this is in subr.el in Emacs 379 ;; XEmacs change: this is in subr.el in GNU Emacs
348 (defun remq (cl-elt cl-list) 380 (defun remq (cl-elt cl-list)
349 "Remove all occurrences of ELT in LIST, comparing with `eq'. 381 "Remove all occurrences of ELT in LIST, comparing with `eq'.
350 This is a non-destructive function; it makes a copy of LIST to avoid 382 This is a non-destructive function; it makes a copy of LIST to avoid
351 corrupting the original LIST. 383 corrupting the original LIST.
352 Also see: `delq', `delete', `delete*', `remove', `remove*'." 384 Also see: `delq', `delete', `delete*', `remove', `remove*'."
354 (delq cl-elt (copy-list cl-list)) 386 (delq cl-elt (copy-list cl-list))
355 cl-list)) 387 cl-list))
356 388
357 (defun remove-duplicates (cl-seq &rest cl-keys) 389 (defun remove-duplicates (cl-seq &rest cl-keys)
358 "Return a copy of SEQ with all duplicate elements removed. 390 "Return a copy of SEQ with all duplicate elements removed.
359 Keywords supported: :test :test-not :key :start :end :from-end" 391 Keywords supported: :test :test-not :key :start :end :from-end
392 See `remove*' for the meaning of the keywords."
360 (cl-delete-duplicates cl-seq cl-keys t)) 393 (cl-delete-duplicates cl-seq cl-keys t))
361 394
362 (defun delete-duplicates (cl-seq &rest cl-keys) 395 (defun delete-duplicates (cl-seq &rest cl-keys)
363 "Remove all duplicate elements from SEQ (destructively). 396 "Remove all duplicate elements from SEQ (destructively).
364 Keywords supported: :test :test-not :key :start :end :from-end" 397 Keywords supported: :test :test-not :key :start :end :from-end
398 See `remove*' for the meaning of the keywords."
365 (cl-delete-duplicates cl-seq cl-keys nil)) 399 (cl-delete-duplicates cl-seq cl-keys nil))
366 400
367 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy) 401 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
368 (if (listp cl-seq) 402 (if (listp cl-seq)
369 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) 403 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
406 440
407 (defun substitute (cl-new cl-old cl-seq &rest cl-keys) 441 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
408 "Substitute NEW for OLD in SEQ. 442 "Substitute NEW for OLD in SEQ.
409 This is a non-destructive function; it makes a copy of SEQ if necessary 443 This is a non-destructive function; it makes a copy of SEQ if necessary
410 to avoid corrupting the original SEQ. 444 to avoid corrupting the original SEQ.
411 Keywords supported: :test :test-not :key :count :start :end :from-end" 445 Keywords supported: :test :test-not :key :count :start :end :from-end
446 See `remove*' for the meaning of the keywords."
412 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 447 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
413 (:start 0) :end :from-end) () 448 (:start 0) :end :from-end) ()
414 (if (or (eq cl-old cl-new) 449 (if (or (eq cl-old cl-new)
415 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) 450 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
416 cl-seq 451 cl-seq
426 461
427 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) 462 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
428 "Substitute NEW for all items satisfying PREDICATE in SEQ. 463 "Substitute NEW for all items satisfying PREDICATE in SEQ.
429 This is a non-destructive function; it makes a copy of SEQ if necessary 464 This is a non-destructive function; it makes a copy of SEQ if necessary
430 to avoid corrupting the original SEQ. 465 to avoid corrupting the original SEQ.
431 Keywords supported: :key :count :start :end :from-end" 466 See `remove*' for the meaning of the keywords."
432 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) 467 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
433 468
434 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 469 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
435 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 470 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
436 This is a non-destructive function; it makes a copy of SEQ if necessary 471 This is a non-destructive function; it makes a copy of SEQ if necessary
437 to avoid corrupting the original SEQ. 472 to avoid corrupting the original SEQ.
438 Keywords supported: :key :count :start :end :from-end" 473 See `remove*' for the meaning of the keywords."
439 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) 474 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
440 475
441 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) 476 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
442 "Substitute NEW for OLD in SEQ. 477 "Substitute NEW for OLD in SEQ.
443 This is a destructive function; it reuses the storage of SEQ whenever possible. 478 This is a destructive function; it reuses the storage of SEQ whenever possible.
444 Keywords supported: :test :test-not :key :count :start :end :from-end" 479 Keywords supported: :test :test-not :key :count :start :end :from-end
480 See `remove*' for the meaning of the keywords."
445 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 481 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
446 (:start 0) :end :from-end) () 482 (:start 0) :end :from-end) ()
447 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) 483 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
448 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) 484 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
449 (let ((cl-p (nthcdr cl-start cl-seq))) 485 (let ((cl-p (nthcdr cl-start cl-seq)))
471 cl-seq)) 507 cl-seq))
472 508
473 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) 509 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
474 "Substitute NEW for all items satisfying PREDICATE in SEQ. 510 "Substitute NEW for all items satisfying PREDICATE in SEQ.
475 This is a destructive function; it reuses the storage of SEQ whenever possible. 511 This is a destructive function; it reuses the storage of SEQ whenever possible.
476 Keywords supported: :key :count :start :end :from-end" 512 Keywords supported: :key :count :start :end :from-end
513 See `remove*' for the meaning of the keywords."
477 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) 514 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
478 515
479 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 516 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
480 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 517 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
481 This is a destructive function; it reuses the storage of SEQ whenever possible. 518 This is a destructive function; it reuses the storage of SEQ whenever possible.
482 Keywords supported: :key :count :start :end :from-end" 519 Keywords supported: :key :count :start :end :from-end
520 See `remove*' for the meaning of the keywords."
483 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) 521 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
484 522
485 (defun find (cl-item cl-seq &rest cl-keys) 523 (defun find (cl-item cl-seq &rest cl-keys)
486 "Find the first occurrence of ITEM in LIST. 524 "Find the first occurrence of ITEM in LIST.
487 Return the matching ITEM, or nil if not found. 525 Return the matching ITEM, or nil if not found.
488 Keywords supported: :test :test-not :key :start :end :from-end" 526 Keywords supported: :test :test-not :key :start :end :from-end
527 See `remove*' for the meaning of the keywords."
489 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) 528 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
490 (and cl-pos (elt cl-seq cl-pos)))) 529 (and cl-pos (elt cl-seq cl-pos))))
491 530
492 (defun find-if (cl-pred cl-list &rest cl-keys) 531 (defun find-if (cl-pred cl-list &rest cl-keys)
493 "Find the first item satisfying PREDICATE in LIST. 532 "Find the first item satisfying PREDICATE in LIST.
494 Return the matching ITEM, or nil if not found. 533 Return the matching ITEM, or nil if not found.
495 Keywords supported: :key :start :end :from-end" 534 Keywords supported: :key :start :end :from-end
535 See `remove*' for the meaning of the keywords."
496 (apply 'find nil cl-list :if cl-pred cl-keys)) 536 (apply 'find nil cl-list :if cl-pred cl-keys))
497 537
498 (defun find-if-not (cl-pred cl-list &rest cl-keys) 538 (defun find-if-not (cl-pred cl-list &rest cl-keys)
499 "Find the first item not satisfying PREDICATE in LIST. 539 "Find the first item not satisfying PREDICATE in LIST.
500 Return the matching ITEM, or nil if not found. 540 Return the matching ITEM, or nil if not found.
501 Keywords supported: :key :start :end :from-end" 541 Keywords supported: :key :start :end :from-end
542 See `remove*' for the meaning of the keywords."
502 (apply 'find nil cl-list :if-not cl-pred cl-keys)) 543 (apply 'find nil cl-list :if-not cl-pred cl-keys))
503 544
504 (defun position (cl-item cl-seq &rest cl-keys) 545 (defun position (cl-item cl-seq &rest cl-keys)
505 "Find the first occurrence of ITEM in LIST. 546 "Find the first occurrence of ITEM in LIST.
506 Return the index of the matching item, or nil if not found. 547 Return the index of the matching item, or nil if not found.
507 Keywords supported: :test :test-not :key :start :end :from-end" 548 Keywords supported: :test :test-not :key :start :end :from-end
549 See `remove*' for the meaning of the keywords."
508 (cl-parsing-keywords (:test :test-not :key :if :if-not 550 (cl-parsing-keywords (:test :test-not :key :if :if-not
509 (:start 0) :end :from-end) () 551 (:start 0) :end :from-end) ()
510 (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) 552 (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
511 553
512 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) 554 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
531 (and (< cl-start cl-end) cl-start)))) 573 (and (< cl-start cl-end) cl-start))))
532 574
533 (defun position-if (cl-pred cl-list &rest cl-keys) 575 (defun position-if (cl-pred cl-list &rest cl-keys)
534 "Find the first item satisfying PREDICATE in LIST. 576 "Find the first item satisfying PREDICATE in LIST.
535 Return the index of the matching item, or nil if not found. 577 Return the index of the matching item, or nil if not found.
536 Keywords supported: :key :start :end :from-end" 578 Keywords supported: :key :start :end :from-end
579 See `remove*' for the meaning of the keywords."
537 (apply 'position nil cl-list :if cl-pred cl-keys)) 580 (apply 'position nil cl-list :if cl-pred cl-keys))
538 581
539 (defun position-if-not (cl-pred cl-list &rest cl-keys) 582 (defun position-if-not (cl-pred cl-list &rest cl-keys)
540 "Find the first item not satisfying PREDICATE in LIST. 583 "Find the first item not satisfying PREDICATE in LIST.
541 Return the index of the matching item, or nil if not found. 584 Return the index of the matching item, or nil if not found.
542 Keywords supported: :key :start :end :from-end" 585 Keywords supported: :key :start :end :from-end
586 See `remove*' for the meaning of the keywords."
543 (apply 'position nil cl-list :if-not cl-pred cl-keys)) 587 (apply 'position nil cl-list :if-not cl-pred cl-keys))
544 588
545 (defun count (cl-item cl-seq &rest cl-keys) 589 (defun count (cl-item cl-seq &rest cl-keys)
546 "Count the number of occurrences of ITEM in LIST. 590 "Count the number of occurrences of ITEM in LIST.
547 Keywords supported: :test :test-not :key :start :end" 591 Keywords supported: :test :test-not :key :start :end
592 See `remove*' for the meaning of the keywords."
548 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () 593 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
549 (let ((cl-count 0) cl-x) 594 (let ((cl-count 0) cl-x)
550 (or cl-end (setq cl-end (length cl-seq))) 595 (or cl-end (setq cl-end (length cl-seq)))
551 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) 596 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
552 (while (< cl-start cl-end) 597 (while (< cl-start cl-end)
555 (setq cl-start (1+ cl-start))) 600 (setq cl-start (1+ cl-start)))
556 cl-count))) 601 cl-count)))
557 602
558 (defun count-if (cl-pred cl-list &rest cl-keys) 603 (defun count-if (cl-pred cl-list &rest cl-keys)
559 "Count the number of items satisfying PREDICATE in LIST. 604 "Count the number of items satisfying PREDICATE in LIST.
560 Keywords supported: :key :start :end" 605 Keywords supported: :key :start :end
606 See `remove*' for the meaning of the keywords."
561 (apply 'count nil cl-list :if cl-pred cl-keys)) 607 (apply 'count nil cl-list :if cl-pred cl-keys))
562 608
563 (defun count-if-not (cl-pred cl-list &rest cl-keys) 609 (defun count-if-not (cl-pred cl-list &rest cl-keys)
564 "Count the number of items not satisfying PREDICATE in LIST. 610 "Count the number of items not satisfying PREDICATE in LIST.
565 Keywords supported: :key :start :end" 611 Keywords supported: :key :start :end
612 See `remove*' for the meaning of the keywords."
566 (apply 'count nil cl-list :if-not cl-pred cl-keys)) 613 (apply 'count nil cl-list :if-not cl-pred cl-keys))
567 614
568 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) 615 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
569 "Compare SEQ1 with SEQ2, return index of first mismatching element. 616 "Compare SEQ1 with SEQ2, return index of first mismatching element.
570 Return nil if the sequences match. If one sequence is a prefix of the 617 Return nil if the sequences match. If one sequence is a prefix of the
571 other, the return value indicates the end of the shorter sequence. 618 other, the return value indicates the end of the shorter sequence.
572 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 619 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
620 See `search' for the meaning of the keywords."
573 (cl-parsing-keywords (:test :test-not :key :from-end 621 (cl-parsing-keywords (:test :test-not :key :from-end
574 (:start1 0) :end1 (:start2 0) :end2) () 622 (:start1 0) :end1 (:start2 0) :end2) ()
575 (or cl-end1 (setq cl-end1 (length cl-seq1))) 623 (or cl-end1 (setq cl-end1 (length cl-seq1)))
576 (or cl-end2 (setq cl-end2 (length cl-seq2))) 624 (or cl-end2 (setq cl-end2 (length cl-seq2)))
577 (if cl-from-end 625 (if cl-from-end
596 644
597 (defun search (cl-seq1 cl-seq2 &rest cl-keys) 645 (defun search (cl-seq1 cl-seq2 &rest cl-keys)
598 "Search for SEQ1 as a subsequence of SEQ2. 646 "Search for SEQ1 as a subsequence of SEQ2.
599 Return the index of the leftmost element of the first match found; 647 Return the index of the leftmost element of the first match found;
600 return nil if there are no matches. 648 return nil if there are no matches.
601 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 649 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
650 See `remove*' for the meaning of the keywords. In this case, :start1 and :end1
651 specify a subsequence of SEQ1, and :start2 and :end2 specify a subsequence
652 of SEQ2."
602 (cl-parsing-keywords (:test :test-not :key :from-end 653 (cl-parsing-keywords (:test :test-not :key :from-end
603 (:start1 0) :end1 (:start2 0) :end2) () 654 (:start1 0) :end1 (:start2 0) :end2) ()
604 (or cl-end1 (setq cl-end1 (length cl-seq1))) 655 (or cl-end1 (setq cl-end1 (length cl-seq1)))
605 (or cl-end2 (setq cl-end2 (length cl-seq2))) 656 (or cl-end2 (setq cl-end2 (length cl-seq2)))
606 (if (>= cl-start1 cl-end1) 657 (if (>= cl-start1 cl-end1)
620 (and (< cl-start2 cl-end2) cl-pos))))) 671 (and (< cl-start2 cl-end2) cl-pos)))))
621 672
622 (defun sort* (cl-seq cl-pred &rest cl-keys) 673 (defun sort* (cl-seq cl-pred &rest cl-keys)
623 "Sort the argument SEQUENCE according to PREDICATE. 674 "Sort the argument SEQUENCE according to PREDICATE.
624 This is a destructive function; it reuses the storage of SEQUENCE if possible. 675 This is a destructive function; it reuses the storage of SEQUENCE if possible.
625 Keywords supported: :key" 676 Keywords supported: :key
677 :key specifies a one-argument function that transforms elements of SEQUENCE
678 into \"comparison keys\" before the test predicate is applied. See
679 `member*' for more information."
626 (if (nlistp cl-seq) 680 (if (nlistp cl-seq)
627 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) 681 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
628 (cl-parsing-keywords (:key) () 682 (cl-parsing-keywords (:key) ()
629 (if (memq cl-key '(nil identity)) 683 (if (memq cl-key '(nil identity))
630 (sort cl-seq cl-pred) 684 (sort cl-seq cl-pred)
633 (funcall cl-key cl-y))))))))) 687 (funcall cl-key cl-y)))))))))
634 688
635 (defun stable-sort (cl-seq cl-pred &rest cl-keys) 689 (defun stable-sort (cl-seq cl-pred &rest cl-keys)
636 "Sort the argument SEQUENCE stably according to PREDICATE. 690 "Sort the argument SEQUENCE stably according to PREDICATE.
637 This is a destructive function; it reuses the storage of SEQUENCE if possible. 691 This is a destructive function; it reuses the storage of SEQUENCE if possible.
638 Keywords supported: :key" 692 Keywords supported: :key
693 :key specifies a one-argument function that transforms elements of SEQUENCE
694 into \"comparison keys\" before the test predicate is applied. See
695 `member*' for more information."
639 (apply 'sort* cl-seq cl-pred cl-keys)) 696 (apply 'sort* cl-seq cl-pred cl-keys))
640 697
641 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) 698 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
642 "Destructively merge the two sequences to produce a new sequence. 699 "Destructively merge the two sequences to produce a new sequence.
643 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two 700 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two
644 argument sequences, and PRED is a `less-than' predicate on the elements. 701 argument sequences, and PRED is a `less-than' predicate on the elements.
645 Keywords supported: :key" 702 Keywords supported: :key
703 :key specifies a one-argument function that transforms elements of SEQ1 and
704 SEQ2 into \"comparison keys\" before the test predicate is applied. See
705 `member*' for more information."
646 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) 706 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
647 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) 707 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
648 (cl-parsing-keywords (:key) () 708 (cl-parsing-keywords (:key) ()
649 (let ((cl-res nil)) 709 (let ((cl-res nil))
650 (while (and cl-seq1 cl-seq2) 710 (while (and cl-seq1 cl-seq2)
656 716
657 ;;; See compiler macro in cl-macs.el 717 ;;; See compiler macro in cl-macs.el
658 (defun member* (cl-item cl-list &rest cl-keys) 718 (defun member* (cl-item cl-list &rest cl-keys)
659 "Find the first occurrence of ITEM in LIST. 719 "Find the first occurrence of ITEM in LIST.
660 Return the sublist of LIST whose car is ITEM. 720 Return the sublist of LIST whose car is ITEM.
661 Keywords supported: :test :test-not :key" 721 Keywords supported: :test :test-not :key
722 The keyword :test specifies a two-argument function that is used to
723 compare ITEM with elements in LIST; if omitted, it defaults to `eql'.
724 The keyword :test-not is similar, but specifies a negated predicate. That
725 is, ITEM is considered equal to an element in LIST if the given predicate
726 returns nil.
727 :key specifies a one-argument function that transforms elements of LIST into
728 \"comparison keys\" before the test predicate is applied. For example,
729 if :key is #'car, then ITEM is compared with the car of elements from LIST1.
730 The :key function, however, is not applied to ITEM, and does not affect the
731 elements in the returned list, which are taken directly from the elements in
732 LIST."
662 (if cl-keys 733 (if cl-keys
663 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 734 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
664 (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) 735 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
665 (setq cl-list (cdr cl-list))) 736 (setq cl-list (cdr cl-list)))
666 cl-list) 737 cl-list)
669 (memq cl-item cl-list)))) 740 (memq cl-item cl-list))))
670 741
671 (defun member-if (cl-pred cl-list &rest cl-keys) 742 (defun member-if (cl-pred cl-list &rest cl-keys)
672 "Find the first item satisfying PREDICATE in LIST. 743 "Find the first item satisfying PREDICATE in LIST.
673 Return the sublist of LIST whose car matches. 744 Return the sublist of LIST whose car matches.
674 Keywords supported: :key" 745 Keywords supported: :key
746 See `member*' for the meaning of :key."
675 (apply 'member* nil cl-list :if cl-pred cl-keys)) 747 (apply 'member* nil cl-list :if cl-pred cl-keys))
676 748
677 (defun member-if-not (cl-pred cl-list &rest cl-keys) 749 (defun member-if-not (cl-pred cl-list &rest cl-keys)
678 "Find the first item not satisfying PREDICATE in LIST. 750 "Find the first item not satisfying PREDICATE in LIST.
679 Return the sublist of LIST whose car matches. 751 Return the sublist of LIST whose car matches.
680 Keywords supported: :key" 752 Keywords supported: :key
753 See `member*' for the meaning of :key."
681 (apply 'member* nil cl-list :if-not cl-pred cl-keys)) 754 (apply 'member* nil cl-list :if-not cl-pred cl-keys))
682 755
683 (defun cl-adjoin (cl-item cl-list &rest cl-keys) 756 (defun cl-adjoin (cl-item cl-list &rest cl-keys)
684 (if (cl-parsing-keywords (:key) t 757 (if (cl-parsing-keywords (:key) t
685 (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) 758 (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
687 (cons cl-item cl-list))) 760 (cons cl-item cl-list)))
688 761
689 ;;; See compiler macro in cl-macs.el 762 ;;; See compiler macro in cl-macs.el
690 (defun assoc* (cl-item cl-alist &rest cl-keys) 763 (defun assoc* (cl-item cl-alist &rest cl-keys)
691 "Find the first item whose car matches ITEM in LIST. 764 "Find the first item whose car matches ITEM in LIST.
692 Keywords supported: :test :test-not :key" 765 Keywords supported: :test :test-not :key
766 See `member*' for the meaning of :test, :test-not and :key."
693 (if cl-keys 767 (if cl-keys
694 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 768 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
695 (while (and cl-alist 769 (while (and cl-alist
696 (or (not (consp (car cl-alist))) 770 (or (not (consp (car cl-alist)))
697 (not (cl-check-test cl-item (car (car cl-alist)))))) 771 (not (cl-check-test cl-item (car (car cl-alist))))))
701 (assoc cl-item cl-alist) 775 (assoc cl-item cl-alist)
702 (assq cl-item cl-alist)))) 776 (assq cl-item cl-alist))))
703 777
704 (defun assoc-if (cl-pred cl-list &rest cl-keys) 778 (defun assoc-if (cl-pred cl-list &rest cl-keys)
705 "Find the first item whose car satisfies PREDICATE in LIST. 779 "Find the first item whose car satisfies PREDICATE in LIST.
706 Keywords supported: :key" 780 Keywords supported: :key
781 See `member*' for the meaning of :key."
707 (apply 'assoc* nil cl-list :if cl-pred cl-keys)) 782 (apply 'assoc* nil cl-list :if cl-pred cl-keys))
708 783
709 (defun assoc-if-not (cl-pred cl-list &rest cl-keys) 784 (defun assoc-if-not (cl-pred cl-list &rest cl-keys)
710 "Find the first item whose car does not satisfy PREDICATE in LIST. 785 "Find the first item whose car does not satisfy PREDICATE in LIST.
711 Keywords supported: :key" 786 Keywords supported: :key
787 See `member*' for the meaning of :key."
712 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) 788 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
713 789
714 (defun rassoc* (cl-item cl-alist &rest cl-keys) 790 (defun rassoc* (cl-item cl-alist &rest cl-keys)
715 "Find the first item whose cdr matches ITEM in LIST. 791 "Find the first item whose cdr matches ITEM in LIST.
716 Keywords supported: :test :test-not :key" 792 Keywords supported: :test :test-not :key
793 See `member*' for the meaning of :test, :test-not and :key."
717 (if (or cl-keys (and (numberp cl-item) (not (fixnump cl-item)))) 794 (if (or cl-keys (and (numberp cl-item) (not (fixnump cl-item))))
718 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 795 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
719 (while (and cl-alist 796 (while (and cl-alist
720 (or (not (consp (car cl-alist))) 797 (or (not (consp (car cl-alist)))
721 (not (cl-check-test cl-item (cdr (car cl-alist)))))) 798 (not (cl-check-test cl-item (cdr (car cl-alist))))))
723 (and cl-alist (car cl-alist))) 800 (and cl-alist (car cl-alist)))
724 (rassq cl-item cl-alist))) 801 (rassq cl-item cl-alist)))
725 802
726 (defun rassoc-if (cl-pred cl-list &rest cl-keys) 803 (defun rassoc-if (cl-pred cl-list &rest cl-keys)
727 "Find the first item whose cdr satisfies PREDICATE in LIST. 804 "Find the first item whose cdr satisfies PREDICATE in LIST.
728 Keywords supported: :key" 805 Keywords supported: :key
806 See `member*' for the meaning of :key."
729 (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) 807 (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
730 808
731 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) 809 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
732 "Find the first item whose cdr does not satisfy PREDICATE in LIST. 810 "Find the first item whose cdr does not satisfy PREDICATE in LIST.
733 Keywords supported: :key" 811 Keywords supported: :key
812 See `member*' for the meaning of :key."
734 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) 813 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
735 814
736 (defun union (cl-list1 cl-list2 &rest cl-keys) 815 (defun union (cl-list1 cl-list2 &rest cl-keys)
737 "Combine LIST1 and LIST2 using a set-union operation. 816 "Combine LIST1 and LIST2 using a set-union operation.
738 The result list contains all items that appear in either LIST1 or LIST2. 817 The result list contains all items that appear in either LIST1 or LIST2.
739 This is a non-destructive function; it makes a copy of the data if necessary 818 This is a non-destructive function; it makes a copy of the data if necessary
740 to avoid corrupting the original LIST1 and LIST2. 819 to avoid corrupting the original LIST1 and LIST2.
741 Keywords supported: :test :test-not :key" 820 Keywords supported: :test :test-not :key
821 The keywords :test and :test-not specify two-argument test and negated-test
822 predicates, respectively; :test defaults to `eql'. see `member*' for more
823 information.
824 :key specifies a one-argument function that transforms elements of LIST1
825 and LIST2 into \"comparison keys\" before the test predicate is applied.
826 For example, if :key is #'car, then the car of elements from LIST1 is
827 compared with the car of elements from LIST2. The :key function, however,
828 does not affect the elements in the returned list, which are taken directly
829 from the elements in LIST1 and LIST2."
742 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 830 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
743 ((equal cl-list1 cl-list2) cl-list1) 831 ((equal cl-list1 cl-list2) cl-list1)
744 (t 832 (t
745 (or (>= (length cl-list1) (length cl-list2)) 833 (or (>= (length cl-list1) (length cl-list2))
746 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) 834 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
755 (defun nunion (cl-list1 cl-list2 &rest cl-keys) 843 (defun nunion (cl-list1 cl-list2 &rest cl-keys)
756 "Combine LIST1 and LIST2 using a set-union operation. 844 "Combine LIST1 and LIST2 using a set-union operation.
757 The result list contains all items that appear in either LIST1 or LIST2. 845 The result list contains all items that appear in either LIST1 or LIST2.
758 This is a destructive function; it reuses the storage of LIST1 and LIST2 846 This is a destructive function; it reuses the storage of LIST1 and LIST2
759 whenever possible. 847 whenever possible.
760 Keywords supported: :test :test-not :key" 848 Keywords supported: :test :test-not :key
849 See `union' for the meaning of :test, :test-not and :key."
761 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 850 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
762 (t (apply 'union cl-list1 cl-list2 cl-keys)))) 851 (t (apply 'union cl-list1 cl-list2 cl-keys))))
763 852
764 (defun intersection (cl-list1 cl-list2 &rest cl-keys) 853 (defun intersection (cl-list1 cl-list2 &rest cl-keys)
765 "Combine LIST1 and LIST2 using a set-intersection operation. 854 "Combine LIST1 and LIST2 using a set-intersection operation.
766 The result list contains all items that appear in both LIST1 and LIST2. 855 The result list contains all items that appear in both LIST1 and LIST2.
767 This is a non-destructive function; it makes a copy of the data if necessary 856 This is a non-destructive function; it makes a copy of the data if necessary
768 to avoid corrupting the original LIST1 and LIST2. 857 to avoid corrupting the original LIST1 and LIST2.
769 Keywords supported: :test :test-not :key" 858 Keywords supported: :test :test-not :key
859 See `union' for the meaning of :test, :test-not and :key."
770 (and cl-list1 cl-list2 860 (and cl-list1 cl-list2
771 (if (equal cl-list1 cl-list2) cl-list1 861 (if (equal cl-list1 cl-list2) cl-list1
772 (cl-parsing-keywords (:key) (:test :test-not) 862 (cl-parsing-keywords (:key) (:test :test-not)
773 (let ((cl-res nil)) 863 (let ((cl-res nil))
774 (or (>= (length cl-list1) (length cl-list2)) 864 (or (>= (length cl-list1) (length cl-list2))
785 (defun nintersection (cl-list1 cl-list2 &rest cl-keys) 875 (defun nintersection (cl-list1 cl-list2 &rest cl-keys)
786 "Combine LIST1 and LIST2 using a set-intersection operation. 876 "Combine LIST1 and LIST2 using a set-intersection operation.
787 The result list contains all items that appear in both LIST1 and LIST2. 877 The result list contains all items that appear in both LIST1 and LIST2.
788 This is a destructive function; it reuses the storage of LIST1 and LIST2 878 This is a destructive function; it reuses the storage of LIST1 and LIST2
789 whenever possible. 879 whenever possible.
790 Keywords supported: :test :test-not :key" 880 Keywords supported: :test :test-not :key
881 See `union' for the meaning of :test, :test-not and :key."
791 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) 882 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
792 883
793 (defun set-difference (cl-list1 cl-list2 &rest cl-keys) 884 (defun set-difference (cl-list1 cl-list2 &rest cl-keys)
794 "Combine LIST1 and LIST2 using a set-difference operation. 885 "Combine LIST1 and LIST2 using a set-difference operation.
795 The result list contains all items that appear in LIST1 but not LIST2. 886 The result list contains all items that appear in LIST1 but not LIST2.
796 This is a non-destructive function; it makes a copy of the data if necessary 887 This is a non-destructive function; it makes a copy of the data if necessary
797 to avoid corrupting the original LIST1 and LIST2. 888 to avoid corrupting the original LIST1 and LIST2.
798 Keywords supported: :test :test-not :key" 889 Keywords supported: :test :test-not :key
890 See `union' for the meaning of :test, :test-not and :key."
799 (if (or (null cl-list1) (null cl-list2)) cl-list1 891 (if (or (null cl-list1) (null cl-list2)) cl-list1
800 (cl-parsing-keywords (:key) (:test :test-not) 892 (cl-parsing-keywords (:key) (:test :test-not)
801 (let ((cl-res nil)) 893 (let ((cl-res nil))
802 (while cl-list1 894 (while cl-list1
803 (or (if (or cl-keys (numberp (car cl-list1))) 895 (or (if (or cl-keys (numberp (car cl-list1)))
811 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) 903 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
812 "Combine LIST1 and LIST2 using a set-difference operation. 904 "Combine LIST1 and LIST2 using a set-difference operation.
813 The result list contains all items that appear in LIST1 but not LIST2. 905 The result list contains all items that appear in LIST1 but not LIST2.
814 This is a destructive function; it reuses the storage of LIST1 and LIST2 906 This is a destructive function; it reuses the storage of LIST1 and LIST2
815 whenever possible. 907 whenever possible.
816 Keywords supported: :test :test-not :key" 908 Keywords supported: :test :test-not :key
909 See `union' for the meaning of :test, :test-not and :key."
817 (if (or (null cl-list1) (null cl-list2)) cl-list1 910 (if (or (null cl-list1) (null cl-list2)) cl-list1
818 (apply 'set-difference cl-list1 cl-list2 cl-keys))) 911 (apply 'set-difference cl-list1 cl-list2 cl-keys)))
819 912
820 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) 913 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
821 "Combine LIST1 and LIST2 using a set-exclusive-or operation. 914 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
822 The result list contains all items that appear in exactly one of LIST1, LIST2. 915 The result list contains all items that appear in exactly one of LIST1, LIST2.
823 This is a non-destructive function; it makes a copy of the data if necessary 916 This is a non-destructive function; it makes a copy of the data if necessary
824 to avoid corrupting the original LIST1 and LIST2. 917 to avoid corrupting the original LIST1 and LIST2.
825 Keywords supported: :test :test-not :key" 918 Keywords supported: :test :test-not :key
919 See `union' for the meaning of :test, :test-not and :key."
826 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 920 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
827 ((equal cl-list1 cl-list2) nil) 921 ((equal cl-list1 cl-list2) nil)
828 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) 922 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
829 (apply 'set-difference cl-list2 cl-list1 cl-keys))))) 923 (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
830 924
831 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) 925 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
832 "Combine LIST1 and LIST2 using a set-exclusive-or operation. 926 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
833 The result list contains all items that appear in exactly one of LIST1, LIST2. 927 The result list contains all items that appear in exactly one of LIST1, LIST2.
834 This is a destructive function; it reuses the storage of LIST1 and LIST2 928 This is a destructive function; it reuses the storage of LIST1 and LIST2
835 whenever possible. 929 whenever possible.
836 Keywords supported: :test :test-not :key" 930 Keywords supported: :test :test-not :key
931 See `union' for the meaning of :test, :test-not and :key."
837 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 932 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
838 ((equal cl-list1 cl-list2) nil) 933 ((equal cl-list1 cl-list2) nil)
839 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) 934 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
840 (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) 935 (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
841 936
842 (defun subsetp (cl-list1 cl-list2 &rest cl-keys) 937 (defun subsetp (cl-list1 cl-list2 &rest cl-keys)
843 "True if LIST1 is a subset of LIST2. 938 "True if LIST1 is a subset of LIST2.
844 I.e., if every element of LIST1 also appears in LIST2. 939 I.e., if every element of LIST1 also appears in LIST2.
845 Keywords supported: :test :test-not :key" 940 Keywords supported: :test :test-not :key
941 See `union' for the meaning of :test, :test-not and :key."
846 (cond ((null cl-list1) t) ((null cl-list2) nil) 942 (cond ((null cl-list1) t) ((null cl-list2) nil)
847 ((equal cl-list1 cl-list2) t) 943 ((equal cl-list1 cl-list2) t)
848 (t (cl-parsing-keywords (:key) (:test :test-not) 944 (t (cl-parsing-keywords (:key) (:test :test-not)
849 (while (and cl-list1 945 (while (and cl-list1
850 (apply 'member* (cl-check-key (car cl-list1)) 946 (apply 'member* (cl-check-key (car cl-list1))
853 (null cl-list1))))) 949 (null cl-list1)))))
854 950
855 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) 951 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
856 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). 952 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
857 Return a copy of TREE with all matching elements replaced by NEW. 953 Return a copy of TREE with all matching elements replaced by NEW.
858 Keywords supported: :key" 954 Keywords supported: :key
955 See `member*' for the meaning of :key."
859 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 956 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
860 957
861 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 958 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
862 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). 959 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
863 Return a copy of TREE with all non-matching elements replaced by NEW. 960 Return a copy of TREE with all non-matching elements replaced by NEW.
864 Keywords supported: :key" 961 Keywords supported: :key
962 See `member*' for the meaning of :key."
865 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 963 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
866 964
867 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) 965 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
868 "Substitute NEW for OLD everywhere in TREE (destructively). 966 "Substitute NEW for OLD everywhere in TREE (destructively).
869 Any element of TREE which is `eql' to OLD is changed to NEW (via a call 967 Any element of TREE which is `eql' to OLD is changed to NEW (via a call
870 to `setcar'). 968 to `setcar').
871 Keywords supported: :test :test-not :key" 969 Keywords supported: :test :test-not :key
970 See `member*' for the meaning of :test, :test-not and :key."
872 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) 971 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
873 972
874 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) 973 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
875 "Substitute NEW for elements matching PREDICATE in TREE (destructively). 974 "Substitute NEW for elements matching PREDICATE in TREE (destructively).
876 Any element of TREE which matches is changed to NEW (via a call to `setcar'). 975 Any element of TREE which matches is changed to NEW (via a call to `setcar').
877 Keywords supported: :key" 976 Keywords supported: :key
977 See `member*' for the meaning of :key."
878 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 978 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
879 979
880 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 980 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
881 "Substitute NEW for elements not matching PREDICATE in TREE (destructively). 981 "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
882 Any element of TREE which matches is changed to NEW (via a call to `setcar'). 982 Any element of TREE which matches is changed to NEW (via a call to `setcar').
883 Keywords supported: :key" 983 Keywords supported: :key
984 See `member*' for the meaning of :key."
884 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 985 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
885 986
886 (defun sublis (cl-alist cl-tree &rest cl-keys) 987 (defun sublis (cl-alist cl-tree &rest cl-keys)
887 "Perform substitutions indicated by ALIST in TREE (non-destructively). 988 "Perform substitutions indicated by ALIST in TREE (non-destructively).
888 Return a copy of TREE with all matching elements replaced. 989 Return a copy of TREE with all matching elements replaced.
889 Keywords supported: :test :test-not :key" 990 Keywords supported: :test :test-not :key
991 See `member*' for the meaning of :test, :test-not and :key."
890 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 992 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
891 (cl-sublis-rec cl-tree))) 993 (cl-sublis-rec cl-tree)))
892 994
893 (defvar cl-alist) 995 (defvar cl-alist)
894 (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* 996 (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
905 cl-tree)))) 1007 cl-tree))))
906 1008
907 (defun nsublis (cl-alist cl-tree &rest cl-keys) 1009 (defun nsublis (cl-alist cl-tree &rest cl-keys)
908 "Perform substitutions indicated by ALIST in TREE (destructively). 1010 "Perform substitutions indicated by ALIST in TREE (destructively).
909 Any matching element of TREE is changed via a call to `setcar'. 1011 Any matching element of TREE is changed via a call to `setcar'.
910 Keywords supported: :test :test-not :key" 1012 Keywords supported: :test :test-not :key
1013 See `member*' for the meaning of :test, :test-not and :key."
911 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 1014 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
912 (let ((cl-hold (list cl-tree))) 1015 (let ((cl-hold (list cl-tree)))
913 (cl-nsublis-rec cl-hold) 1016 (cl-nsublis-rec cl-hold)
914 (car cl-hold)))) 1017 (car cl-hold))))
915 1018
928 (setq cl-tree (cdr cl-tree)))))) 1031 (setq cl-tree (cdr cl-tree))))))
929 1032
930 (defun tree-equal (cl-x cl-y &rest cl-keys) 1033 (defun tree-equal (cl-x cl-y &rest cl-keys)
931 "Return t if trees X and Y have `eql' leaves. 1034 "Return t if trees X and Y have `eql' leaves.
932 Atoms are compared by `eql'; cons cells are compared recursively. 1035 Atoms are compared by `eql'; cons cells are compared recursively.
933 Keywords supported: :test :test-not :key" 1036 Keywords supported: :test :test-not :key
1037 See `union' for the meaning of :test, :test-not and :key."
934 (cl-parsing-keywords (:test :test-not :key) () 1038 (cl-parsing-keywords (:test :test-not :key) ()
935 (cl-tree-equal-rec cl-x cl-y))) 1039 (cl-tree-equal-rec cl-x cl-y)))
936 1040
937 (defun cl-tree-equal-rec (cl-x cl-y) 1041 (defun cl-tree-equal-rec (cl-x cl-y)
938 (while (and (consp cl-x) (consp cl-y) 1042 (while (and (consp cl-x) (consp cl-y)