Mercurial > emacs
annotate lisp/emacs-lisp/cl.el @ 108006:452f0cc5f879
Remove references to (default-)direction-reversed.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Wed, 21 Apr 2010 01:05:30 +0200 |
parents | 1d1d5d9bd884 |
children | a133fd492185 376148b31b5e |
rev | line source |
---|---|
85736
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
1 ;;; cl.el --- Common Lisp extensions for Emacs |
4355 | 2 |
104035
2a920253454b
(cl-compiling-file): Update for the name-change `outbuffer' to
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
3 ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
106815 | 4 ;; 2009, 2010 Free Software Foundation, Inc. |
4355 | 5 |
6 ;; Author: Dave Gillespie <daveg@synaptics.com> | |
7 ;; Version: 2.02 | |
8 ;; Keywords: extensions | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
4355 | 13 ;; it under the terms of the GNU General Public License as published by |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
15 ;; (at your option) any later version. |
4355 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
4355 | 24 |
7942 | 25 ;;; Commentary: |
4355 | 26 |
27 ;; These are extensions to Emacs Lisp that provide a degree of | |
28 ;; Common Lisp compatibility, beyond what is already built-in | |
29 ;; in Emacs Lisp. | |
30 ;; | |
31 ;; This package was written by Dave Gillespie; it is a complete | |
32 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. | |
33 ;; | |
34 ;; Bug reports, comments, and suggestions are welcome! | |
35 | |
36 ;; This file contains the portions of the Common Lisp extensions | |
37 ;; package which should always be present. | |
38 | |
39 | |
7942 | 40 ;;; Future notes: |
4355 | 41 |
42 ;; Once Emacs 19 becomes standard, many things in this package which are | |
43 ;; messy for reasons of compatibility can be greatly simplified. For now, | |
44 ;; I prefer to maintain one unified version. | |
45 | |
46 | |
7942 | 47 ;;; Change Log: |
4355 | 48 |
49 ;; Version 2.02 (30 Jul 93): | |
50 ;; * Added "cl-compat.el" file, extra compatibility with old package. | |
51 ;; * Added `lexical-let' and `lexical-let*'. | |
52 ;; * Added `define-modify-macro', `callf', and `callf2'. | |
53 ;; * Added `ignore-errors'. | |
54 ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero. | |
55 ;; * Merged `*gentemp-counter*' into `*gensym-counter*'. | |
56 ;; * Extended `subseq' to allow negative START and END like `substring'. | |
57 ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses. | |
58 ;; * Added `concat', `vconcat' loop clauses. | |
59 ;; * Cleaned up a number of compiler warnings. | |
60 | |
61 ;; Version 2.01 (7 Jul 93): | |
62 ;; * Added support for FSF version of Emacs 19. | |
63 ;; * Added `add-hook' for Emacs 18 users. | |
64 ;; * Added `defsubst*' and `symbol-macrolet'. | |
65 ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'. | |
66 ;; * Added `map', `concatenate', `reduce', `merge'. | |
67 ;; * Added `revappend', `nreconc', `tailp', `tree-equal'. | |
68 ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'. | |
69 ;; * Added destructuring and `&environment' support to `defmacro*'. | |
70 ;; * Added destructuring to `loop', and added the following clauses: | |
71 ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'. | |
72 ;; * Renamed `delete' to `delete*' and `remove' to `remove*'. | |
73 ;; * Completed support for all keywords in `remove*', `substitute', etc. | |
74 ;; * Added `most-positive-float' and company. | |
75 ;; * Fixed hash tables to work with latest Lucid Emacs. | |
76 ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'. | |
77 ;; * Syntax for `warn' declarations has changed. | |
78 ;; * Improved implementation of `random*'. | |
79 ;; * Moved most sequence functions to a new file, cl-seq.el. | |
80 ;; * Moved `eval-when' into cl-macs.el. | |
81 ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases. | |
82 ;; * Moved `provide' forms down to ends of files. | |
83 ;; * Changed expansion of `pop' to something that compiles to better code. | |
84 ;; * Changed so that no patch is required for Emacs 19 byte compiler. | |
85 ;; * Made more things dependent on `optimize' declarations. | |
86 ;; * Added a partial implementation of struct print functions. | |
87 ;; * Miscellaneous minor changes. | |
88 | |
89 ;; Version 2.00: | |
90 ;; * First public release of this package. | |
91 | |
92 | |
7942 | 93 ;;; Code: |
4355 | 94 |
95 (defvar cl-optimize-speed 1) | |
96 (defvar cl-optimize-safety 1) | |
97 | |
98 | |
24790
a6b268f4dfc7
(custom-print-functions): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
21465
diff
changeset
|
99 ;;;###autoload |
4355 | 100 (defvar custom-print-functions nil |
101 "This is a list of functions that format user objects for printing. | |
102 Each function is called in turn with three arguments: the object, the | |
103 stream, and the print level (currently ignored). If it is able to | |
104 print the object it returns true; otherwise it returns nil and the | |
105 printer proceeds to the next function on the list. | |
106 | |
107 This variable is not used at present, but it is defined in hopes that | |
108 a future Emacs interpreter will be able to use it.") | |
109 | |
85834
7400d979a9d9
(cl-cannot-unload): Remove function.
Juanma Barranquero <lekktu@gmail.com>
parents:
85736
diff
changeset
|
110 (defun cl-unload-function () |
7400d979a9d9
(cl-cannot-unload): Remove function.
Juanma Barranquero <lekktu@gmail.com>
parents:
85736
diff
changeset
|
111 "Stop unloading of the Common Lisp extensions." |
7400d979a9d9
(cl-cannot-unload): Remove function.
Juanma Barranquero <lekktu@gmail.com>
parents:
85736
diff
changeset
|
112 (message "Cannot unload the feature `cl'") |
7400d979a9d9
(cl-cannot-unload): Remove function.
Juanma Barranquero <lekktu@gmail.com>
parents:
85736
diff
changeset
|
113 ;; stop standard unloading! |
7400d979a9d9
(cl-cannot-unload): Remove function.
Juanma Barranquero <lekktu@gmail.com>
parents:
85736
diff
changeset
|
114 t) |
4355 | 115 |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
116 ;;; Generalized variables. |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
117 ;; These macros are defined here so that they |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
118 ;; can safely be used in .emacs files. |
4355 | 119 |
120 (defmacro incf (place &optional x) | |
28824
add63b27c709
Doc fixes; mainly avoid duplicating arg
Dave Love <fx@gnu.org>
parents:
28038
diff
changeset
|
121 "Increment PLACE by X (1 by default). |
4355 | 122 PLACE may be a symbol, or any generalized variable allowed by `setf'. |
123 The return value is the incremented value of PLACE." | |
124 (if (symbolp place) | |
125 (list 'setq place (if x (list '+ place x) (list '1+ place))) | |
126 (list 'callf '+ place (or x 1)))) | |
127 | |
128 (defmacro decf (place &optional x) | |
28824
add63b27c709
Doc fixes; mainly avoid duplicating arg
Dave Love <fx@gnu.org>
parents:
28038
diff
changeset
|
129 "Decrement PLACE by X (1 by default). |
4355 | 130 PLACE may be a symbol, or any generalized variable allowed by `setf'. |
131 The return value is the decremented value of PLACE." | |
132 (if (symbolp place) | |
133 (list 'setq place (if x (list '- place x) (list '1- place))) | |
134 (list 'callf '- place (or x 1)))) | |
135 | |
96708
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
136 ;; Autoloaded, but we haven't loaded cl-loaddefs yet. |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
137 (declare-function cl-do-pop "cl-macs" (place)) |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
138 |
4355 | 139 (defmacro pop (place) |
28824
add63b27c709
Doc fixes; mainly avoid duplicating arg
Dave Love <fx@gnu.org>
parents:
28038
diff
changeset
|
140 "Remove and return the head of the list stored in PLACE. |
4355 | 141 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more |
142 careful about evaluating each argument only once and in the right order. | |
143 PLACE may be a symbol, or any generalized variable allowed by `setf'." | |
144 (if (symbolp place) | |
145 (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) | |
146 (cl-do-pop place))) | |
147 | |
148 (defmacro push (x place) | |
28824
add63b27c709
Doc fixes; mainly avoid duplicating arg
Dave Love <fx@gnu.org>
parents:
28038
diff
changeset
|
149 "Insert X at the head of the list stored in PLACE. |
4355 | 150 Analogous to (setf PLACE (cons X PLACE)), though more careful about |
151 evaluating each argument only once and in the right order. PLACE may | |
152 be a symbol, or any generalized variable allowed by `setf'." | |
153 (if (symbolp place) (list 'setq place (list 'cons x place)) | |
154 (list 'callf2 'cons x place))) | |
155 | |
156 (defmacro pushnew (x place &rest keys) | |
157 "(pushnew X PLACE): insert X at the head of the list if not already there. | |
158 Like (push X PLACE), except that the list is unmodified if X is `eql' to | |
159 an element already on the list. | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
160 \nKeywords supported: :test :test-not :key |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
161 \n(fn X PLACE [KEYWORD VALUE]...)" |
72785
a384943e84d7
(pushnew): Use add-to-list when convenient.
Richard M. Stallman <rms@gnu.org>
parents:
68648
diff
changeset
|
162 (if (symbolp place) |
a384943e84d7
(pushnew): Use add-to-list when convenient.
Richard M. Stallman <rms@gnu.org>
parents:
68648
diff
changeset
|
163 (if (null keys) |
73227
79c3587798b4
(pushnew-internal): Remove defvar.
Kim F. Storm <storm@cua.dk>
parents:
73030
diff
changeset
|
164 `(let ((x ,x)) |
79c3587798b4
(pushnew-internal): Remove defvar.
Kim F. Storm <storm@cua.dk>
parents:
73030
diff
changeset
|
165 (if (memql x ,place) ,place (setq ,place (cons x ,place)))) |
72785
a384943e84d7
(pushnew): Use add-to-list when convenient.
Richard M. Stallman <rms@gnu.org>
parents:
68648
diff
changeset
|
166 (list 'setq place (list* 'adjoin x place keys))) |
4355 | 167 (list* 'callf2 'adjoin x place keys))) |
168 | |
169 (defun cl-set-elt (seq n val) | |
170 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) | |
171 | |
94877
0b1b2b6fee44
(cl-set-nthcdr): Make it a defsubst so that
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94655
diff
changeset
|
172 (defsubst cl-set-nthcdr (n list x) |
4355 | 173 (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) |
174 | |
175 (defun cl-set-buffer-substring (start end val) | |
176 (save-excursion (delete-region start end) | |
177 (goto-char start) | |
178 (insert val) | |
179 val)) | |
180 | |
181 (defun cl-set-substring (str start end val) | |
182 (if end (if (< end 0) (incf end (length str))) | |
183 (setq end (length str))) | |
46356
35f0290a4079
(cl-set-substring): Fix thinko.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46325
diff
changeset
|
184 (if (< start 0) (incf start (length str))) |
4355 | 185 (concat (and (> start 0) (substring str 0 start)) |
186 val | |
187 (and (< end (length str)) (substring str end)))) | |
188 | |
189 | |
190 ;;; Control structures. | |
191 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
192 ;; These macros are so simple and so often-used that it's better to have |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
193 ;; them all the time than to load them from cl-macs.el. |
4355 | 194 |
195 (defun cl-map-extents (&rest cl-args) | |
26939
672e75118c0f
Remove Emacs 18 compatibility code. Prepend `cl-' to autoload names
Dave Love <fx@gnu.org>
parents:
24790
diff
changeset
|
196 (apply 'cl-map-overlays cl-args)) |
4355 | 197 |
198 | |
199 ;;; Blocks and exits. | |
200 | |
201 (defalias 'cl-block-wrapper 'identity) | |
202 (defalias 'cl-block-throw 'throw) | |
203 | |
204 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
205 ;;; Multiple values. |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
206 ;; True multiple values are not supported, or even |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
207 ;; simulated. Instead, multiple-value-bind and friends simply expect |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
208 ;; the target form to return the values as a list. |
4355 | 209 |
41109
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
210 (defsubst values (&rest values) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
211 "Return multiple values, Common Lisp style. |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
212 The arguments of `values' are the values |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
213 that the containing function should return." |
46027
38072df535c8
(values): Simplify definition.
Richard M. Stallman <rms@gnu.org>
parents:
45739
diff
changeset
|
214 values) |
41109
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
215 |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
216 (defsubst values-list (list) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
217 "Return multiple values, Common Lisp style, taken from a list. |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
218 LIST specifies the list of values |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
219 that the containing function should return." |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
220 list) |
4355 | 221 |
41109
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
222 (defsubst multiple-value-list (expression) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
223 "Return a list of the multiple values produced by EXPRESSION. |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
224 This handles multiple values in Common Lisp style, but it does not |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
225 work right when EXPRESSION calls an ordinary Emacs Lisp function |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
226 that returns just one value." |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
227 expression) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
228 |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
229 (defsubst multiple-value-apply (function expression) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
230 "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them. |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
231 This handles multiple values in Common Lisp style, but it does not work |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
232 right when EXPRESSION calls an ordinary Emacs Lisp function that returns just |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
233 one value." |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
234 (apply function expression)) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
235 |
48462
b9d1a3c5291e
(multiple-value-call): Add docstring.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46356
diff
changeset
|
236 (defalias 'multiple-value-call 'apply |
b9d1a3c5291e
(multiple-value-call): Add docstring.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46356
diff
changeset
|
237 "Apply FUNCTION to ARGUMENTS, taking multiple values into account. |
b9d1a3c5291e
(multiple-value-call): Add docstring.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46356
diff
changeset
|
238 This implementation only handles the case where there is only one argument.") |
46325
606fc43dc51e
(multiple-value-call): Add alias.
Richard M. Stallman <rms@gnu.org>
parents:
46027
diff
changeset
|
239 |
41109
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
240 (defsubst nth-value (n expression) |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
241 "Evaluate EXPRESSION to get multiple values and return the Nth one. |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
242 This handles multiple values in Common Lisp style, but it does not work |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
243 right when EXPRESSION calls an ordinary Emacs Lisp function that returns just |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
244 one value." |
0bcf2d7f0112
(values, values-list, multiple-value-list, multiple-value-apply, nth-value):
Richard M. Stallman <rms@gnu.org>
parents:
39630
diff
changeset
|
245 (nth n expression)) |
4355 | 246 |
247 ;;; Macros. | |
248 | |
104730
7ddfb0bcf0a2
(cl-macro-environment): Don't define it here.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104035
diff
changeset
|
249 (defvar cl-macro-environment) |
4355 | 250 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand) |
251 (defalias 'macroexpand 'cl-macroexpand))) | |
252 | |
253 (defun cl-macroexpand (cl-macro &optional cl-env) | |
9769
6a9124f418db
(cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
254 "Return result of expanding macros at top level of FORM. |
6a9124f418db
(cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
255 If FORM is not a macro call, it is returned unchanged. |
6a9124f418db
(cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
256 Otherwise, the macro is expanded and the expansion is considered |
6a9124f418db
(cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
257 in place of FORM. When a non-macro-call results, it is returned. |
6a9124f418db
(cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents:
7942
diff
changeset
|
258 |
30998 | 259 The second optional arg ENVIRONMENT specifies an environment of macro |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
260 definitions to shadow the loaded ones for use in file byte-compilation. |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
261 \n(fn FORM &optional ENVIRONMENT)" |
4355 | 262 (let ((cl-macro-environment cl-env)) |
263 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) | |
264 (and (symbolp cl-macro) | |
265 (cdr (assq (symbol-name cl-macro) cl-env)))) | |
266 (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) | |
267 cl-macro)) | |
268 | |
269 | |
270 ;;; Declarations. | |
271 | |
272 (defvar cl-compiling-file nil) | |
273 (defun cl-compiling-file () | |
274 (or cl-compiling-file | |
104035
2a920253454b
(cl-compiling-file): Update for the name-change `outbuffer' to
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
275 (and (boundp 'bytecomp-outbuffer) |
2a920253454b
(cl-compiling-file): Update for the name-change `outbuffer' to
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
276 (bufferp (symbol-value 'bytecomp-outbuffer)) |
2a920253454b
(cl-compiling-file): Update for the name-change `outbuffer' to
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
277 (equal (buffer-name (symbol-value 'bytecomp-outbuffer)) |
4355 | 278 " *Compiler Output*")))) |
279 | |
280 (defvar cl-proclaims-deferred nil) | |
281 | |
282 (defun proclaim (spec) | |
283 (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) | |
284 (push spec cl-proclaims-deferred)) | |
285 nil) | |
286 | |
287 (defmacro declaim (&rest specs) | |
288 (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x)))) | |
289 specs))) | |
290 (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) | |
291 (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when | |
292 | |
293 | |
294 ;;; Symbols. | |
295 | |
296 (defun cl-random-time () | |
297 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) | |
298 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) | |
299 v)) | |
300 | |
301 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) | |
302 | |
303 | |
304 ;;; Numbers. | |
305 | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
306 (defun floatp-safe (object) |
62424
ecbd5b866b1d
(eql, floatp-safe, plusp, minusp, oddp, evenp, list*): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
57519
diff
changeset
|
307 "Return t if OBJECT is a floating point number. |
4355 | 308 On Emacs versions that lack floating-point support, this function |
309 always returns nil." | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
310 (and (numberp object) (not (integerp object)))) |
4355 | 311 |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
312 (defun plusp (number) |
62424
ecbd5b866b1d
(eql, floatp-safe, plusp, minusp, oddp, evenp, list*): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
57519
diff
changeset
|
313 "Return t if NUMBER is positive." |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
314 (> number 0)) |
4355 | 315 |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
316 (defun minusp (number) |
62424
ecbd5b866b1d
(eql, floatp-safe, plusp, minusp, oddp, evenp, list*): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
57519
diff
changeset
|
317 "Return t if NUMBER is negative." |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
318 (< number 0)) |
4355 | 319 |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
320 (defun oddp (integer) |
62424
ecbd5b866b1d
(eql, floatp-safe, plusp, minusp, oddp, evenp, list*): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
57519
diff
changeset
|
321 "Return t if INTEGER is odd." |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
322 (eq (logand integer 1) 1)) |
4355 | 323 |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
324 (defun evenp (integer) |
62424
ecbd5b866b1d
(eql, floatp-safe, plusp, minusp, oddp, evenp, list*): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
57519
diff
changeset
|
325 "Return t if INTEGER is even." |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
326 (eq (logand integer 1) 0)) |
4355 | 327 |
328 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) | |
329 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
330 ;; The following are actually set by cl-float-limits. |
4355 | 331 (defconst most-positive-float nil) |
332 (defconst most-negative-float nil) | |
333 (defconst least-positive-float nil) | |
334 (defconst least-negative-float nil) | |
335 (defconst least-positive-normalized-float nil) | |
336 (defconst least-negative-normalized-float nil) | |
337 (defconst float-epsilon nil) | |
338 (defconst float-negative-epsilon nil) | |
339 | |
340 | |
341 ;;; Sequence functions. | |
342 | |
343 (defalias 'copy-seq 'copy-sequence) | |
344 | |
96708
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
345 (declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs)) |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
346 |
4355 | 347 (defun mapcar* (cl-func cl-x &rest cl-rest) |
348 "Apply FUNCTION to each element of SEQ, and make a list of the results. | |
349 If there are several SEQs, FUNCTION is called with that many arguments, | |
350 and mapping stops as soon as the shortest list runs out. With just one | |
351 SEQ, this is like `mapcar'. With several, it is like the Common Lisp | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
352 `mapcar' function extended to arbitrary sequence types. |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
353 \n(fn FUNCTION SEQ...)" |
4355 | 354 (if cl-rest |
355 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) | |
356 (cl-mapcar-many cl-func (cons cl-x cl-rest)) | |
357 (let ((cl-res nil) (cl-y (car cl-rest))) | |
358 (while (and cl-x cl-y) | |
359 (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) | |
360 (nreverse cl-res))) | |
361 (mapcar cl-func cl-x))) | |
362 | |
41776
2682c3f36a6a
(svref): New alias.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41109
diff
changeset
|
363 (defalias 'svref 'aref) |
4355 | 364 |
365 ;;; List functions. | |
366 | |
367 (defalias 'first 'car) | |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
368 (defalias 'second 'cadr) |
4355 | 369 (defalias 'rest 'cdr) |
370 (defalias 'endp 'null) | |
371 | |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
372 (defun third (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
373 "Return the third element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
374 (car (cdr (cdr x)))) |
4355 | 375 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
376 (defun fourth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
377 "Return the fourth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
378 (nth 3 x)) |
4355 | 379 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
380 (defun fifth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
381 "Return the fifth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
382 (nth 4 x)) |
4355 | 383 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
384 (defun sixth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
385 "Return the sixth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
386 (nth 5 x)) |
4355 | 387 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
388 (defun seventh (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
389 "Return the seventh element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
390 (nth 6 x)) |
4355 | 391 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
392 (defun eighth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
393 "Return the eighth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
394 (nth 7 x)) |
4355 | 395 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
396 (defun ninth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
397 "Return the ninth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
398 (nth 8 x)) |
4355 | 399 |
30617
5e28cf8a757a
(third...tenth): Undo change of 2000-08-05.
Gerd Moellmann <gerd@gnu.org>
parents:
30613
diff
changeset
|
400 (defun tenth (x) |
34027
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
401 "Return the tenth element of the list X." |
5fc589b932e9
(third...tenth): Really undo change of 2000-08-05.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30998
diff
changeset
|
402 (nth 9 x)) |
4355 | 403 |
404 (defun caaar (x) | |
405 "Return the `car' of the `car' of the `car' of X." | |
406 (car (car (car x)))) | |
407 | |
408 (defun caadr (x) | |
409 "Return the `car' of the `car' of the `cdr' of X." | |
410 (car (car (cdr x)))) | |
411 | |
412 (defun cadar (x) | |
413 "Return the `car' of the `cdr' of the `car' of X." | |
414 (car (cdr (car x)))) | |
415 | |
416 (defun caddr (x) | |
417 "Return the `car' of the `cdr' of the `cdr' of X." | |
418 (car (cdr (cdr x)))) | |
419 | |
420 (defun cdaar (x) | |
421 "Return the `cdr' of the `car' of the `car' of X." | |
422 (cdr (car (car x)))) | |
423 | |
424 (defun cdadr (x) | |
425 "Return the `cdr' of the `car' of the `cdr' of X." | |
426 (cdr (car (cdr x)))) | |
427 | |
428 (defun cddar (x) | |
429 "Return the `cdr' of the `cdr' of the `car' of X." | |
430 (cdr (cdr (car x)))) | |
431 | |
432 (defun cdddr (x) | |
433 "Return the `cdr' of the `cdr' of the `cdr' of X." | |
434 (cdr (cdr (cdr x)))) | |
435 | |
436 (defun caaaar (x) | |
437 "Return the `car' of the `car' of the `car' of the `car' of X." | |
438 (car (car (car (car x))))) | |
439 | |
440 (defun caaadr (x) | |
441 "Return the `car' of the `car' of the `car' of the `cdr' of X." | |
442 (car (car (car (cdr x))))) | |
443 | |
444 (defun caadar (x) | |
445 "Return the `car' of the `car' of the `cdr' of the `car' of X." | |
446 (car (car (cdr (car x))))) | |
447 | |
448 (defun caaddr (x) | |
449 "Return the `car' of the `car' of the `cdr' of the `cdr' of X." | |
450 (car (car (cdr (cdr x))))) | |
451 | |
452 (defun cadaar (x) | |
453 "Return the `car' of the `cdr' of the `car' of the `car' of X." | |
454 (car (cdr (car (car x))))) | |
455 | |
456 (defun cadadr (x) | |
457 "Return the `car' of the `cdr' of the `car' of the `cdr' of X." | |
458 (car (cdr (car (cdr x))))) | |
459 | |
460 (defun caddar (x) | |
461 "Return the `car' of the `cdr' of the `cdr' of the `car' of X." | |
462 (car (cdr (cdr (car x))))) | |
463 | |
464 (defun cadddr (x) | |
465 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." | |
466 (car (cdr (cdr (cdr x))))) | |
467 | |
468 (defun cdaaar (x) | |
469 "Return the `cdr' of the `car' of the `car' of the `car' of X." | |
470 (cdr (car (car (car x))))) | |
471 | |
472 (defun cdaadr (x) | |
473 "Return the `cdr' of the `car' of the `car' of the `cdr' of X." | |
474 (cdr (car (car (cdr x))))) | |
475 | |
476 (defun cdadar (x) | |
477 "Return the `cdr' of the `car' of the `cdr' of the `car' of X." | |
478 (cdr (car (cdr (car x))))) | |
479 | |
480 (defun cdaddr (x) | |
481 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." | |
482 (cdr (car (cdr (cdr x))))) | |
483 | |
484 (defun cddaar (x) | |
485 "Return the `cdr' of the `cdr' of the `car' of the `car' of X." | |
486 (cdr (cdr (car (car x))))) | |
487 | |
488 (defun cddadr (x) | |
489 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." | |
490 (cdr (cdr (car (cdr x))))) | |
491 | |
492 (defun cdddar (x) | |
493 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." | |
494 (cdr (cdr (cdr (car x))))) | |
495 | |
496 (defun cddddr (x) | |
497 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." | |
498 (cdr (cdr (cdr (cdr x))))) | |
499 | |
19585
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
500 ;;(defun last* (x &optional n) |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
501 ;; "Returns the last link in the list LIST. |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
502 ;;With optional argument N, returns Nth-to-last link (default 1)." |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
503 ;; (if n |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
504 ;; (let ((m 0) (p x)) |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
505 ;; (while (consp p) (incf m) (pop p)) |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
506 ;; (if (<= n 0) p |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
507 ;; (if (< n m) (nthcdr (- m n) x) x))) |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
508 ;; (while (consp (cdr x)) (pop x)) |
3d2741d4fabc
(last*): Definition deleted.
Richard M. Stallman <rms@gnu.org>
parents:
19512
diff
changeset
|
509 ;; x)) |
4355 | 510 |
511 (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
512 "Return a new list with specified ARGs as elements, consed to last ARG. |
4355 | 513 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
514 `(cons A (cons B (cons C D)))'. |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
515 \n(fn ARG...)" |
4355 | 516 (cond ((not rest) arg) |
517 ((not (cdr rest)) (cons arg (car rest))) | |
518 (t (let* ((n (length rest)) | |
519 (copy (copy-sequence rest)) | |
520 (last (nthcdr (- n 2) copy))) | |
521 (setcdr last (car (cdr last))) | |
522 (cons arg copy))))) | |
523 | |
524 (defun ldiff (list sublist) | |
525 "Return a copy of LIST with the tail SUBLIST removed." | |
526 (let ((res nil)) | |
527 (while (and (consp list) (not (eq list sublist))) | |
528 (push (pop list) res)) | |
529 (nreverse res))) | |
530 | |
45739
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
531 (defun copy-list (list) |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
532 "Return a copy of LIST, which may be a dotted list. |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
533 The elements of LIST are not copied, just the list structure itself." |
45739
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
534 (if (consp list) |
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
535 (let ((res nil)) |
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
536 (while (consp list) (push (pop list) res)) |
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
537 (prog1 (nreverse res) (setcdr res list))) |
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
538 (car list))) |
af30a5644ebc
(copy-list): Moved back from subr.el.
Richard M. Stallman <rms@gnu.org>
parents:
45695
diff
changeset
|
539 |
4355 | 540 (defun cl-maclisp-member (item list) |
541 (while (and list (not (equal item (car list)))) (setq list (cdr list))) | |
542 list) | |
543 | |
544 (defalias 'cl-member 'memq) ; for compatibility with old CL package | |
99715
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
545 |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
546 ;; Autoloaded, but we have not loaded cl-loaddefs yet. |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
547 (declare-function floor* "cl-extra" (x &optional y)) |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
548 (declare-function ceiling* "cl-extra" (x &optional y)) |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
549 (declare-function truncate* "cl-extra" (x &optional y)) |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
550 (declare-function round* "cl-extra" (x &optional y)) |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
551 (declare-function mod* "cl-extra" (x y)) |
045d255cc806
(floor*, ceiling*, truncate*, round*, mod*): Declare.
Glenn Morris <rgm@gnu.org>
parents:
96708
diff
changeset
|
552 |
4355 | 553 (defalias 'cl-floor 'floor*) |
554 (defalias 'cl-ceiling 'ceiling*) | |
555 (defalias 'cl-truncate 'truncate*) | |
556 (defalias 'cl-round 'round*) | |
557 (defalias 'cl-mod 'mod*) | |
558 | |
559 (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs | |
560 "Return ITEM consed onto the front of LIST only if it's not already there. | |
561 Otherwise, return LIST unmodified. | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
562 \nKeywords supported: :test :test-not :key |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
563 \n(fn ITEM LIST [KEYWORD VALUE]...)" |
4355 | 564 (cond ((or (equal cl-keys '(:test eq)) |
565 (and (null cl-keys) (not (numberp cl-item)))) | |
566 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) | |
567 ((or (equal cl-keys '(:test equal)) (null cl-keys)) | |
568 (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) | |
569 (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) | |
570 | |
571 (defun subst (cl-new cl-old cl-tree &rest cl-keys) | |
572 "Substitute NEW for OLD everywhere in TREE (non-destructively). | |
573 Return a copy of TREE with all elements `eql' to OLD replaced by NEW. | |
62626
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
574 \nKeywords supported: :test :test-not :key |
970aed705a2a
(pushnew, cl-macroexpand, floatp-safe, plusp, minusp, oddp, evenp, mapcar*,
Juanma Barranquero <lekktu@gmail.com>
parents:
62424
diff
changeset
|
575 \n(fn NEW OLD TREE [KEYWORD VALUE]...)" |
4355 | 576 (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) |
577 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) | |
578 (cl-do-subst cl-new cl-old cl-tree))) | |
579 | |
580 (defun cl-do-subst (cl-new cl-old cl-tree) | |
581 (cond ((eq cl-tree cl-old) cl-new) | |
582 ((consp cl-tree) | |
583 (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) | |
584 (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) | |
585 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) | |
586 cl-tree (cons a d)))) | |
587 (t cl-tree))) | |
588 | |
62642
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
589 (defun acons (key value alist) |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
590 "Add KEY and VALUE to ALIST. |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
591 Return a new list with (cons KEY VALUE) as car and ALIST as cdr." |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
592 (cons (cons key value) alist)) |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
593 |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
594 (defun pairlis (keys values &optional alist) |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
595 "Make an alist from KEYS and VALUES. |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
596 Return a new alist composed by associating KEYS to corresponding VALUES; |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
597 the process stops as soon as KEYS or VALUES run out. |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
598 If ALIST is non-nil, the new pairs are prepended to it." |
59b6666e38f9
(acons, pairlis): Add docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
62630
diff
changeset
|
599 (nconc (mapcar* 'cons keys values) alist)) |
4355 | 600 |
601 | |
602 ;;; Miscellaneous. | |
603 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
604 ;; Define data for indentation and edebug. |
81636
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
605 (dolist (entry |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
606 '(((defun* defmacro*) 2) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
607 ((function*) nil |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
608 (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
609 ((eval-when) 1 (sexp &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
610 ((declare) nil (&rest sexp)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
611 ((the) 1 (sexp &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
612 ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
613 ((block return-from) 1 (sexp &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
614 ((return) nil (&optional form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
615 ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
616 (form &rest form) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
617 &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
618 ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
619 ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
620 ((psetq setf psetf) nil edebug-setq-form) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
621 ((progv) 2 (&rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
622 ((flet labels macrolet) 1 |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
623 ((&rest (sexp sexp &rest form)) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
624 ((symbol-macrolet lexical-let lexical-let*) 1 |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
625 ((&rest &or symbolp (symbolp form)) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
626 ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
627 ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
628 ((incf decf remf pushnew shiftf rotatef) nil (&rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
629 ((letf letf*) 1 ((&rest (&rest form)) &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
630 ((callf destructuring-bind) 2 (sexp form &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
631 ((callf2) 3 (sexp form form &rest form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
632 ((loop) nil (&rest &or symbolp form)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
633 ((ignore-errors) 0 (&rest form)))) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
634 (dolist (func (car entry)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
635 (put func 'lisp-indent-function (nth 1 entry)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
636 (put func 'lisp-indent-hook (nth 1 entry)) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
637 (or (get func 'edebug-form-spec) |
432e796ebb5c
Use cl-loaddefs.el rather than manual autoloads.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
75346
diff
changeset
|
638 (put func 'edebug-form-spec (nth 2 entry))))) |
30613
a262f769fc3d
(first, ..., tenth): Make them macros.
Gerd Moellmann <gerd@gnu.org>
parents:
28824
diff
changeset
|
639 |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
640 ;; Autoload the other portions of the package. |
53595
7ea1b7196d49
*** empty log message ***
Luc Teirlinck <teirllm@auburn.edu>
parents:
53594
diff
changeset
|
641 ;; We want to replace the basic versions of dolist, dotimes, declare below. |
36551
54fe96bd9530
(dotimes, dolist): Undef prior to autoloading
Dave Love <fx@gnu.org>
parents:
34899
diff
changeset
|
642 (fmakunbound 'dolist) |
54fe96bd9530
(dotimes, dolist): Undef prior to autoloading
Dave Love <fx@gnu.org>
parents:
34899
diff
changeset
|
643 (fmakunbound 'dotimes) |
53594
587ca9eaf25e
Add `fmakunbound' for `declare'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
52401
diff
changeset
|
644 (fmakunbound 'declare) |
81805
05153ccde019
Load cl-loaddefs.el quietly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81658
diff
changeset
|
645 (load "cl-loaddefs" nil 'quiet) |
4355 | 646 |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
647 ;; This goes here so that cl-macs can find it if it loads right now. |
4355 | 648 (provide 'cl-19) ; usage: (require 'cl-19 "cl") |
96708
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
649 (provide 'cl) |
4355 | 650 |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
651 ;; Things to do after byte-compiler is loaded. |
4355 | 652 |
653 (defvar cl-hacked-flag nil) | |
654 (defun cl-hack-byte-compiler () | |
96708
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
655 (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form) |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
656 (progn |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
657 (setq cl-hacked-flag t) ; Do it first, to prevent recursion. |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
658 (load "cl-macs" nil t) |
ceb7b0d5c55f
(cl-do-pop, cl-mapcar-many): Declare for compiler.
Glenn Morris <rgm@gnu.org>
parents:
94877
diff
changeset
|
659 (run-hooks 'cl-hack-bytecomp-hook)))) |
4355 | 660 |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
661 ;; Try it now in case the compiler has already been loaded. |
4355 | 662 (cl-hack-byte-compiler) |
663 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
664 ;; Also make a hook in case compiler is loaded after this file. |
27586
5d6eb73b10d0
Use bytecomp-load-hook, not emacs-lisp-mode-hook.
Dave Love <fx@gnu.org>
parents:
27509
diff
changeset
|
665 (add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler) |
4355 | 666 |
667 | |
81658
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
668 ;; The following ensures that packages which expect the old-style cl.el |
3ed52769155f
Set edebug and indentation before loading
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81636
diff
changeset
|
669 ;; will be happy with this one. |
4355 | 670 |
671 (provide 'cl) | |
672 | |
673 (run-hooks 'cl-load-hook) | |
674 | |
85736
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
675 ;; Local variables: |
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
676 ;; byte-compile-dynamic: t |
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
677 ;; byte-compile-warnings: (not cl-functions) |
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
678 ;; End: |
e5bd859d65dd
Move local variables to end of file, and set byte-compile-warnings to
Glenn Morris <rgm@gnu.org>
parents:
82140
diff
changeset
|
679 |
62630
630219b07e90
(eql): Remove. It's a builtin already.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62626
diff
changeset
|
680 ;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851 |
4355 | 681 ;;; cl.el ends here |