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