annotate lisp/cl-seq.el @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents 393039450288
children 545ec923b4eb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 442
diff changeset
1 ;;; cl-seq.el --- Common Lisp extensions for XEmacs Lisp (part three)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Version: 2.02
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
27 ;;; Synched up with: FSF 21.3.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; These are extensions to Emacs Lisp that provide a degree of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Common Lisp compatibility, beyond what is already built-in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; in Emacs Lisp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; This package was written by Dave Gillespie; it is a complete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; Bug reports, comments, and suggestions are welcome!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; This file contains the Common Lisp sequence and list functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; which take keyword arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; See cl.el for Change Log.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 (or (memq 'cl-19 features)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (error "Tried to load `cl-seq' before `cl'!"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;; Keyword parsing. This is special-cased here so that we can compile
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;;; this file independent from cl-macs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 (defmacro cl-parsing-keywords (kwords other-keys &rest body)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
60 "Helper macro for functions with keyword arguments.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
61 This is a temporary solution, until keyword arguments are natively supported.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
62 Declare your function ending with (... &rest cl-keys), then wrap the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
63 function body in a call to `cl-parsing-keywords'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
64
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
65 KWORDS is a list of keyword definitions. Each definition should be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
66 either a keyword or a list (KEYWORD DEFAULT-VALUE). In the former case,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
67 the default value is nil. The keywords are available in BODY as the name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
68 of the keyword, minus its initial colon and prepended with `cl-'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
69
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
70 OTHER-KEYS specifies other keywords that are accepted but ignored. It
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
71 is either the value 't' (ignore all other keys, equivalent to the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
72 &allow-other-keys argument declaration in Common Lisp) or a list in the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
73 same format as KWORDS. If keywords are given that are not in KWORDS
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
74 and not allowed by OTHER-KEYS, an error will normally be signalled; but
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
75 the caller can override this by specifying a non-nil value for the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
76 keyword :allow-other-keys (which defaults to t)."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (cons
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 'let*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (cons (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (let* ((var (if (consp x) (car x) x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 'cl-keys)))))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
85 (if (eq var :test-not)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
87 (if (eq var :if-not)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (list (intern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (format "cl-%s" (substring (symbol-name var) 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (if (consp x) (list 'or mem (car (cdr x))) mem)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 kwords)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (and (not (eq other-keys t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 (list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (list 'let '((cl-keys-temp cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (list 'while 'cl-keys-temp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 (list 'or (list 'memq '(car cl-keys-temp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (list 'quote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 (function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (lambda (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (if (consp x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (car x) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (append kwords
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 other-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 '(car (cdr (memq (quote :allow-other-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 cl-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 '(error "Bad keyword argument %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (car cl-keys-temp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 body))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (put 'cl-parsing-keywords 'lisp-indent-function 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 (put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (defmacro cl-check-key (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (list 'if 'cl-key (list 'funcall 'cl-key x) x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (defmacro cl-check-test-nokey (item x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (list 'cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (list 'cl-test
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 (list 'eq (list 'not (list 'funcall 'cl-test item x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 'cl-test-not))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (list 'cl-if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (list 't (list 'if (list 'numberp item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (list 'equal item x) (list 'eq item x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (defmacro cl-check-test (item x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (list 'cl-check-test-nokey item (list 'cl-check-key x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (defmacro cl-check-match (x y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (list 'if 'cl-test
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (list 'if (list 'numberp x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (list 'equal x y) (list 'eq x y))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (put 'cl-check-key 'edebug-form-spec 'edebug-forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (put 'cl-check-test 'edebug-form-spec 'edebug-forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (put 'cl-check-match 'edebug-form-spec 'edebug-forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (defvar cl-test) (defvar cl-test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (defvar cl-if) (defvar cl-if-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (defvar cl-key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (defun reduce (cl-func cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 "Reduce two-argument FUNCTION across SEQUENCE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Keywords supported: :start :end :from-end :initial-value :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (setq cl-seq (subseq cl-seq cl-start cl-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (if cl-from-end (setq cl-seq (nreverse cl-seq)))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
156 (let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
157 (cl-seq (cl-check-key (pop cl-seq)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (t (funcall cl-func)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (if cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (while cl-seq
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
161 (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 cl-accum)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (while cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (setq cl-accum (funcall cl-func cl-accum
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
165 (cl-check-key (pop cl-seq))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 cl-accum)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (defun fill (seq item &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 "Fill the elements of SEQ with ITEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 Keywords supported: :start :end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (cl-parsing-keywords ((:start 0) :end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (if (listp seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (let ((p (nthcdr cl-start seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (n (if cl-end (- cl-end cl-start) 8000000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (while (and p (>= (setq n (1- n)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (setcar p item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (setq p (cdr p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (or cl-end (setq cl-end (length seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (if (and (= cl-start 0) (= cl-end (length seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (fillarray seq item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 (while (< cl-start cl-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 (aset seq cl-start item)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 (setq cl-start (1+ cl-start)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 (defun replace (cl-seq1 cl-seq2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 "Replace the elements of SEQ1 with the elements of SEQ2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 SEQ1 is destructively modified, then returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Keywords supported: :start1 :end1 :start2 :end2"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (or (= cl-start1 cl-start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (let* ((cl-len (length cl-seq1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (cl-n (min (- (or cl-end1 cl-len) cl-start1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (- (or cl-end2 cl-len) cl-start2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 (while (>= (setq cl-n (1- cl-n)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 (elt cl-seq2 (+ cl-start2 cl-n))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 (if (listp cl-seq1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (if (listp cl-seq2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 (cl-n (min cl-n1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 (setcar cl-p1 (car cl-p2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (setq cl-end2 (min (or cl-end2 (length cl-seq2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 (+ cl-start2 cl-n1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (while (and cl-p1 (< cl-start2 cl-end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (setcar cl-p1 (aref cl-seq2 cl-start2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (setq cl-end1 (min (or cl-end1 (length cl-seq1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 (+ cl-start1 (- (or cl-end2 (length cl-seq2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 cl-start2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (if (listp cl-seq2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (while (< cl-start1 cl-end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (aset cl-seq1 cl-start1 (car cl-p2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 (while (< cl-start1 cl-end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 cl-seq1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 (defun remove* (cl-item cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 "Remove all occurrences of ITEM in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Keywords supported: :test :test-not :key :count :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 (:start 0) :end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 (if (<= (or cl-count (setq cl-count 8000000)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 cl-from-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 (if cl-i
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 (let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 (append (if cl-from-end
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
242 (list :end (1+ cl-i))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
243 (list :start cl-i))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 cl-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 (if (listp cl-seq) cl-res
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 (setq cl-end (- (or cl-end 8000000) cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 (if (= cl-start 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 (while (and cl-seq (> cl-end 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (cl-check-test cl-item (car cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (> (setq cl-count (1- cl-count)) 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (if (and (> cl-count 0) (> cl-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 (setq cl-end (1- cl-end)) (cdr cl-seq))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 (while (and cl-p (> cl-end 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 (not (cl-check-test cl-item (car cl-p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 (setq cl-p (cdr cl-p) cl-end (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (if (and cl-p (> cl-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 (nconc (ldiff cl-seq cl-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (if (= cl-count 1) (cdr cl-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (and (cdr cl-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (apply 'delete* cl-item
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 (copy-sequence (cdr cl-p))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
266 :start 0 :end (1- cl-end)
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
267 :count (1- cl-count) cl-keys))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 cl-seq)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 (defun remove-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 "Remove all items satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
276 (apply 'remove* nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (defun remove-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 "Remove all items not satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
283 (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (defun delete* (cl-item cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 "Remove all occurrences of ITEM in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 Keywords supported: :test :test-not :key :count :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 (:start 0) :end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (if (<= (or cl-count (setq cl-count 8000000)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (if (listp cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (if (and cl-from-end (< cl-count 4000000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (let (cl-i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (while (and (>= (setq cl-count (1- cl-count)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (setq cl-i (cl-position cl-item cl-seq cl-start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 cl-end cl-from-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (setcdr cl-tail (cdr (cdr cl-tail)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 (setq cl-end cl-i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (setq cl-end (- (or cl-end 8000000) cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (if (= cl-start 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (while (and cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (> cl-end 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (cl-check-test cl-item (car cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (> (setq cl-count (1- cl-count)) 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (setq cl-end (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (setq cl-start (1- cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (if (and (> cl-count 0) (> cl-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (let ((cl-p (nthcdr cl-start cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (while (and (cdr cl-p) (> cl-end 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (if (cl-check-test cl-item (car (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (setcdr cl-p (cdr (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (if (= (setq cl-count (1- cl-count)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 (setq cl-end 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (setq cl-p (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (setq cl-end (1- cl-end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (apply 'remove* cl-item cl-seq cl-keys)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 (defun delete-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 "Remove all items satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
331 (apply 'delete* nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (defun delete-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 "Remove all items not satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
337 (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
339 ;; XEmacs change: this is in subr.el in Emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (defun remove (cl-item cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 "Remove all occurrences of ITEM in SEQ, testing with `equal'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 Also see: `remove*', `delete', `delete*'"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (remove* cl-item cl-seq ':test 'equal))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
347 ;; XEmacs change: this is in subr.el in Emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (defun remq (cl-elt cl-list)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
349 "Remove all occurrences of ELT in LIST, comparing with `eq'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 This is a non-destructive function; it makes a copy of LIST to avoid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 corrupting the original LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 Also see: `delq', `delete', `delete*', `remove', `remove*'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (if (memq cl-elt cl-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (delq cl-elt (copy-list cl-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 cl-list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (defun remove-duplicates (cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 "Return a copy of SEQ with all duplicate elements removed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 Keywords supported: :test :test-not :key :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (cl-delete-duplicates cl-seq cl-keys t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (defun delete-duplicates (cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 "Remove all duplicate elements from SEQ (destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 Keywords supported: :test :test-not :key :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (cl-delete-duplicates cl-seq cl-keys nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (if (listp cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (if cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (while (> cl-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (setq cl-i 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (while (setq cl-i (cl-position (cl-check-key (car cl-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (cdr cl-p) cl-i (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (if cl-copy (setq cl-seq (copy-sequence cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 cl-p (nthcdr cl-start cl-seq) cl-copy nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (let ((cl-tail (nthcdr cl-i cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (setcdr cl-tail (cdr (cdr cl-tail))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (setq cl-end (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (setq cl-p (cdr cl-p) cl-end (1- cl-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 cl-start (1+ cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (cl-position (cl-check-key (car cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (cdr cl-seq) 0 (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (setq cl-end (1- cl-end) cl-start 1) cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (while (and (cdr (cdr cl-p)) (> cl-end 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (if (cl-position (cl-check-key (car (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (cdr (cdr cl-p)) 0 (1- cl-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (if cl-copy (setq cl-seq (copy-sequence cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 cl-p (nthcdr (1- cl-start) cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 cl-copy nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (setcdr cl-p (cdr (cdr cl-p))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (setq cl-p (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (defun substitute (cl-new cl-old cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 "Substitute NEW for OLD in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 Keywords supported: :test :test-not :key :count :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (:start 0) :end :from-end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (if (or (eq cl-old cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (if (not cl-i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 cl-seq
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (setq cl-seq (copy-sequence cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (or cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (progn (cl-set-elt cl-seq cl-i cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
424 (apply 'nsubstitute cl-new cl-old cl-seq :count cl-count
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
425 :start cl-i cl-keys))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 "Substitute NEW for all items satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
432 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 This is a non-destructive function; it makes a copy of SEQ if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 to avoid corrupting the original SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
439 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "Substitute NEW for OLD in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 Keywords supported: :test :test-not :key :count :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (:start 0) :end :from-end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (let ((cl-p (nthcdr cl-start cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (setq cl-end (- (or cl-end 8000000) cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (while (and cl-p (> cl-end 0) (> cl-count 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (if (cl-check-test cl-old (car cl-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (setcar cl-p cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (setq cl-count (1- cl-count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (or cl-end (setq cl-end (length cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (if cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (while (and (< cl-start cl-end) (> cl-count 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (setq cl-end (1- cl-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (if (cl-check-test cl-old (elt cl-seq cl-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (cl-set-elt cl-seq cl-end cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (setq cl-count (1- cl-count)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (while (and (< cl-start cl-end) (> cl-count 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (if (cl-check-test cl-old (aref cl-seq cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (aset cl-seq cl-start cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (setq cl-count (1- cl-count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (setq cl-start (1+ cl-start))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 cl-seq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 "Substitute NEW for all items satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
477 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 This is a destructive function; it reuses the storage of SEQ whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 Keywords supported: :key :count :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
483 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (defun find (cl-item cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 "Find the first occurrence of ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 Return the matching ITEM, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 Keywords supported: :test :test-not :key :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (and cl-pos (elt cl-seq cl-pos))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (defun find-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 "Find the first item satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 Return the matching ITEM, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 Keywords supported: :key :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
496 (apply 'find nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (defun find-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 "Find the first item not satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 Return the matching ITEM, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 Keywords supported: :key :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
502 (apply 'find nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (defun position (cl-item cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 "Find the first occurrence of ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 Return the index of the matching item, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 Keywords supported: :test :test-not :key :start :end :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (cl-parsing-keywords (:test :test-not :key :if :if-not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (:start 0) :end :from-end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (if (listp cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (let ((cl-p (nthcdr cl-start cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (or cl-end (setq cl-end 8000000))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 (let ((cl-res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 (if (cl-check-test cl-item (car cl-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (setq cl-res cl-start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 cl-res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (or cl-end (setq cl-end (length cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (if cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (while (and (>= (setq cl-end (1- cl-end)) cl-start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (not (cl-check-test cl-item (aref cl-seq cl-end)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (and (>= cl-end cl-start) cl-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (while (and (< cl-start cl-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (not (cl-check-test cl-item (aref cl-seq cl-start))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (setq cl-start (1+ cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (and (< cl-start cl-end) cl-start))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (defun position-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 "Find the first item satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 Return the index of the matching item, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 Keywords supported: :key :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
537 (apply 'position nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (defun position-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 "Find the first item not satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Return the index of the matching item, or nil if not found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 Keywords supported: :key :start :end :from-end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
543 (apply 'position nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (defun count (cl-item cl-seq &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 "Count the number of occurrences of ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 Keywords supported: :test :test-not :key :start :end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (let ((cl-count 0) cl-x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (or cl-end (setq cl-end (length cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 (while (< cl-start cl-end)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
553 (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (setq cl-start (1+ cl-start)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 cl-count)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (defun count-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 "Count the number of items satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 Keywords supported: :key :start :end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
561 (apply 'count nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (defun count-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 "Count the number of items not satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 Keywords supported: :key :start :end"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
566 (apply 'count nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 "Compare SEQ1 with SEQ2, return index of first mismatching element.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 Return nil if the sequences match. If one sequence is a prefix of the
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
571 other, the return value indicates the end of the shorter sequence.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 (cl-parsing-keywords (:test :test-not :key :from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (:start1 0) :end1 (:start2 0) :end2) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 (or cl-end1 (setq cl-end1 (length cl-seq1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 (or cl-end2 (setq cl-end2 (length cl-seq2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 (if cl-from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 (cl-check-match (elt cl-seq1 (1- cl-end1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (elt cl-seq2 (1- cl-end2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (1- cl-end1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (cl-check-match (if cl-p1 (car cl-p1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (aref cl-seq1 cl-start1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (if cl-p2 (car cl-p2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (aref cl-seq2 cl-start2))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 cl-start1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (defun search (cl-seq1 cl-seq2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 "Search for SEQ1 as a subsequence of SEQ2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 Return the index of the leftmost element of the first match found;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return nil if there are no matches.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (cl-parsing-keywords (:test :test-not :key :from-end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (:start1 0) :end1 (:start2 0) :end2) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (or cl-end1 (setq cl-end1 (length cl-seq1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (or cl-end2 (setq cl-end2 (length cl-seq2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (if (>= cl-start1 cl-end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (if cl-from-end cl-end2 cl-start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (let* ((cl-len (- cl-end1 cl-start1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (cl-if nil) cl-pos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (setq cl-end2 (- cl-end2 (1- cl-len)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (while (and (< cl-start2 cl-end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (setq cl-pos (cl-position cl-first cl-seq2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 cl-start2 cl-end2 cl-from-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 (apply 'mismatch cl-seq1 cl-seq2
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
616 :start1 (1+ cl-start1) :end1 cl-end1
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
617 :start2 (1+ cl-pos) :end2 (+ cl-pos cl-len)
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
618 :from-end nil cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 (and (< cl-start2 cl-end2) cl-pos)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 (defun sort* (cl-seq cl-pred &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 "Sort the argument SEQUENCE according to PREDICATE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 This is a destructive function; it reuses the storage of SEQUENCE if possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 Keywords supported: :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (if (nlistp cl-seq)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 (cl-parsing-keywords (:key) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (if (memq cl-key '(nil identity))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (sort cl-seq cl-pred)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (sort cl-seq (function (lambda (cl-x cl-y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (funcall cl-pred (funcall cl-key cl-x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (funcall cl-key cl-y)))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (defun stable-sort (cl-seq cl-pred &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 "Sort the argument SEQUENCE stably according to PREDICATE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 This is a destructive function; it reuses the storage of SEQUENCE if possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 Keywords supported: :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (apply 'sort* cl-seq cl-pred cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 "Destructively merge the two sequences to produce a new sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 TYPE is the sequence type to return, SEQ1 and SEQ2 are the two
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 argument sequences, and PRED is a `less-than' predicate on the elements.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 Keywords supported: :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (cl-parsing-keywords (:key) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (let ((cl-res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (while (and cl-seq1 cl-seq2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (if (funcall cl-pred (cl-check-key (car cl-seq2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (cl-check-key (car cl-seq1)))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
653 (push (pop cl-seq2) cl-res)
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
654 (push (pop cl-seq1) cl-res)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 ;;; See compiler macro in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (defun member* (cl-item cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 "Find the first occurrence of ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 Return the sublist of LIST whose car is ITEM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (if cl-keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (setq cl-list (cdr cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 cl-list)
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 2153
diff changeset
667 (if (and (numberp cl-item) (not (fixnump cl-item)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (member cl-item cl-list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 (memq cl-item cl-list))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 (defun member-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 "Find the first item satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 Return the sublist of LIST whose car matches.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
675 (apply 'member* nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (defun member-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 "Find the first item not satisfying PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 Return the sublist of LIST whose car matches.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
681 (apply 'member* nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (defun cl-adjoin (cl-item cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (if (cl-parsing-keywords (:key) t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (apply 'member* (cl-check-key cl-item) cl-list cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 cl-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (cons cl-item cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 ;;; See compiler macro in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 (defun assoc* (cl-item cl-alist &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 "Find the first item whose car matches ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (if cl-keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (while (and cl-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 (or (not (consp (car cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (not (cl-check-test cl-item (car (car cl-alist))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (setq cl-alist (cdr cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (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
700 (if (and (numberp cl-item) (not (fixnump cl-item)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (assoc cl-item cl-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (assq cl-item cl-alist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (defun assoc-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 "Find the first item whose car satisfies PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
707 (apply 'assoc* nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 (defun assoc-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 "Find the first item whose car does not satisfy PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
712 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 (defun rassoc* (cl-item cl-alist &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 "Find the first item whose cdr matches ITEM in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 Keywords supported: :test :test-not :key"
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 2153
diff changeset
717 (if (or cl-keys (and (numberp cl-item) (not (fixnump cl-item))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (while (and cl-alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (or (not (consp (car cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (not (cl-check-test cl-item (cdr (car cl-alist))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (setq cl-alist (cdr cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (and cl-alist (car cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (rassq cl-item cl-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 (defun rassoc-if (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 "Find the first item whose cdr satisfies PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
729 (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 "Find the first item whose cdr does not satisfy PREDICATE in LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
734 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (defun union (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 "Combine LIST1 and LIST2 using a set-union operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 The result list contains all items that appear in either LIST1 or LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 This is a non-destructive function; it makes a copy of the data if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 to avoid corrupting the original LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 ((equal cl-list1 cl-list2) cl-list1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (or (>= (length cl-list1) (length cl-list2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (while cl-list2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 (if (or cl-keys (numberp (car cl-list2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (or (memq (car cl-list2) cl-list1)
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
751 (push (car cl-list2) cl-list1)))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
752 (pop cl-list2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 cl-list1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (defun nunion (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 "Combine LIST1 and LIST2 using a set-union operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 The result list contains all items that appear in either LIST1 or LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 This is a destructive function; it reuses the storage of LIST1 and LIST2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (t (apply 'union cl-list1 cl-list2 cl-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (defun intersection (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 "Combine LIST1 and LIST2 using a set-intersection operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 The result list contains all items that appear in both LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 This is a non-destructive function; it makes a copy of the data if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 to avoid corrupting the original LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (and cl-list1 cl-list2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (if (equal cl-list1 cl-list2) cl-list1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (cl-parsing-keywords (:key) (:test :test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (let ((cl-res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 (or (>= (length cl-list1) (length cl-list2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (while cl-list2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (if (if (or cl-keys (numberp (car cl-list2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 (apply 'member* (cl-check-key (car cl-list2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 cl-list1 cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 (memq (car cl-list2) cl-list1))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
781 (push (car cl-list2) cl-res))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
782 (pop cl-list2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 cl-res)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (defun nintersection (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 "Combine LIST1 and LIST2 using a set-intersection operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 The result list contains all items that appear in both LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 This is a destructive function; it reuses the storage of LIST1 and LIST2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 (defun set-difference (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 "Combine LIST1 and LIST2 using a set-difference operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 The result list contains all items that appear in LIST1 but not LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 This is a non-destructive function; it makes a copy of the data if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 to avoid corrupting the original LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 (if (or (null cl-list1) (null cl-list2)) cl-list1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 (cl-parsing-keywords (:key) (:test :test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 (let ((cl-res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (while cl-list1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 (or (if (or cl-keys (numberp (car cl-list1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (apply 'member* (cl-check-key (car cl-list1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 cl-list2 cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 (memq (car cl-list1) cl-list2))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
807 (push (car cl-list1) cl-res))
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
808 (pop cl-list1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 cl-res))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 (defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 "Combine LIST1 and LIST2 using a set-difference operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 The result list contains all items that appear in LIST1 but not LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 This is a destructive function; it reuses the storage of LIST1 and LIST2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (if (or (null cl-list1) (null cl-list2)) cl-list1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 (apply 'set-difference cl-list1 cl-list2 cl-keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 The result list contains all items that appear in exactly one of LIST1, LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 This is a non-destructive function; it makes a copy of the data if necessary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 to avoid corrupting the original LIST1 and LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 ((equal cl-list1 cl-list2) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 "Combine LIST1 and LIST2 using a set-exclusive-or operation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 The result list contains all items that appear in exactly one of LIST1, LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 This is a destructive function; it reuses the storage of LIST1 and LIST2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 ((equal cl-list1 cl-list2) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (defun subsetp (cl-list1 cl-list2 &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 "True if LIST1 is a subset of LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 I.e., if every element of LIST1 also appears in LIST2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (cond ((null cl-list1) t) ((null cl-list2) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 ((equal cl-list1 cl-list2) t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 (t (cl-parsing-keywords (:key) (:test :test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (while (and cl-list1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (apply 'member* (cl-check-key (car cl-list1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 cl-list2 cl-keys))
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
852 (pop cl-list1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 (null cl-list1)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 Return a copy of TREE with all matching elements replaced by NEW.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
859 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 Return a copy of TREE with all non-matching elements replaced by NEW.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
865 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 "Substitute NEW for OLD everywhere in TREE (destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 Any element of TREE which is `eql' to OLD is changed to NEW (via a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 to `setcar').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 "Substitute NEW for elements matching PREDICATE in TREE (destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 Any element of TREE which matches is changed to NEW (via a call to `setcar').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
878 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 Any element of TREE which matches is changed to NEW (via a call to `setcar').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 Keywords supported: :key"
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
884 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (defun sublis (cl-alist cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 "Perform substitutions indicated by ALIST in TREE (non-destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 Return a copy of TREE with all matching elements replaced.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (cl-sublis-rec cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (defvar cl-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (setq cl-p (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (if cl-p (cdr (car cl-p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (if (consp cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (let ((cl-a (cl-sublis-rec (car cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (cl-d (cl-sublis-rec (cdr cl-tree))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 cl-tree
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (cons cl-a cl-d)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 cl-tree))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (defun nsublis (cl-alist cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 "Perform substitutions indicated by ALIST in TREE (destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 Any matching element of TREE is changed via a call to `setcar'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 (let ((cl-hold (list cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 (cl-nsublis-rec cl-hold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 (car cl-hold))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 (defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (while (consp cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (setq cl-p (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 (if cl-p (setcar cl-tree (cdr (car cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 (setq cl-p (cdr cl-p)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 (if cl-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 (setq cl-tree (cdr cl-tree))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 (defun tree-equal (cl-x cl-y &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 "Return t if trees X and Y have `eql' leaves.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 Atoms are compared by `eql'; cons cells are compared recursively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (cl-parsing-keywords (:test :test-not :key) ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (cl-tree-equal-rec cl-x cl-y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (defun cl-tree-equal-rec (cl-x cl-y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 (while (and (consp cl-x) (consp cl-y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 (cl-tree-equal-rec (car cl-x) (car cl-y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (run-hooks 'cl-seq-load-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
2153
393039450288 [xemacs-hg @ 2004-06-26 21:25:23 by james]
james
parents: 613
diff changeset
946 ;;; arch-tag: ec1cc072-9006-4225-b6ba-d6b07ed1710c
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 ;;; cl-seq.el ends here