Mercurial > hg > xemacs-beta
annotate lisp/cl-seq.el @ 5247:02d875ebd1ea
Make Lisp reader errors more informative with over-long hex, octal characters
src/ChangeLog addition:
2010-08-21 Aidan Kehoe <kehoea@parhasard.net>
* lread.c (read_escape):
Make error messages better reflect the text that was encountered,
when overlong hex character escapes or non-Latin-1 octal character
escapes are encountered.
man/ChangeLog addition:
2010-08-21 Aidan Kehoe <kehoea@parhasard.net>
* lispref/objects.texi (Character Type):
Go into more detail here on the specific type of error provoked on
overlong hex character escapes and non-Latin-1 octal character
escapes; give details of why the latter may be encountered, and
what to do with such code.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 21 Aug 2010 19:02:44 +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 |