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