annotate lisp/emacs-lisp/cl.el @ 16623:b33613b8aadb

(byte-compile-insert-header): If emacs-version ends with a letter, don't check the version number.
author Richard M. Stallman <rms@gnu.org>
date Sat, 07 Dec 1996 20:34:15 +0000
parents a74507d555ba
children 7fe3a413068d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
16057
a74507d555ba Turn on byte-compile-dynamic.
Richard M. Stallman <rms@gnu.org>
parents: 14169
diff changeset
1 ;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Version: 2.02
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 ;; Keywords: extensions
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
12244
ac7375e60931 Update GPL to version 2.
Karl Heuer <kwzh@gnu.org>
parents: 9769
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 ;; any later version.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19 ;; GNU General Public License for more details.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13337
diff changeset
24 ;; Boston, MA 02111-1307, USA.
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
26 ;;; Commentary:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;; These are extensions to Emacs Lisp that provide a degree of
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
29 ;; Common Lisp compatibility, beyond what is already built-in
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
30 ;; in Emacs Lisp.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32 ;; This package was written by Dave Gillespie; it is a complete
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36 ;;
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;; Bug reports, comments, and suggestions are welcome!
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;; This file contains the portions of the Common Lisp extensions
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; package which should always be present.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
43 ;;; Future notes:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;; Once Emacs 19 becomes standard, many things in this package which are
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 ;; messy for reasons of compatibility can be greatly simplified. For now,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;; I prefer to maintain one unified version.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
50 ;;; Change Log:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;; Version 2.02 (30 Jul 93):
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;; * Added "cl-compat.el" file, extra compatibility with old package.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;; * Added `lexical-let' and `lexical-let*'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;; * Added `define-modify-macro', `callf', and `callf2'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 ;; * Added `ignore-errors'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;; * Extended `subseq' to allow negative START and END like `substring'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;; * Added `concat', `vconcat' loop clauses.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;; * Cleaned up a number of compiler warnings.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;; Version 2.01 (7 Jul 93):
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 ;; * Added support for FSF version of Emacs 19.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;; * Added `add-hook' for Emacs 18 users.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
67 ;; * Added `defsubst*' and `symbol-macrolet'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
69 ;; * Added `map', `concatenate', `reduce', `merge'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
70 ;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 ;; * Added destructuring and `&environment' support to `defmacro*'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
73 ;; * Added destructuring to `loop', and added the following clauses:
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
74 ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75 ;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 ;; * Completed support for all keywords in `remove*', `substitute', etc.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ;; * Added `most-positive-float' and company.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; * Fixed hash tables to work with latest Lucid Emacs.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80 ;; * Syntax for `warn' declarations has changed.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 ;; * Improved implementation of `random*'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82 ;; * Moved most sequence functions to a new file, cl-seq.el.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 ;; * Moved `eval-when' into cl-macs.el.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 ;; * Moved `provide' forms down to ends of files.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86 ;; * Changed expansion of `pop' to something that compiles to better code.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 ;; * Changed so that no patch is required for Emacs 19 byte compiler.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88 ;; * Made more things dependent on `optimize' declarations.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 ;; * Added a partial implementation of struct print functions.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 ;; * Miscellaneous minor changes.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92 ;; Version 2.00:
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 ;; * First public release of this package.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95
7942
bc5dccc5375f Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 4355
diff changeset
96 ;;; Code:
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (symbol-value 'epoch::version))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (string-lessp emacs-version "19")) 18)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 ((string-match "Lucid" emacs-version) 'lucid)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 (t 19)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 (or (fboundp 'defalias) (fset 'defalias 'fset))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 (defvar cl-optimize-speed 1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (defvar cl-optimize-safety 1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 ;;; Keywords used in this package.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (defconst :test ':test)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (defconst :test-not ':test-not)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 (defconst :key ':key)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115 (defconst :start ':start)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 (defconst :start1 ':start1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117 (defconst :start2 ':start2)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (defconst :end ':end)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (defconst :end1 ':end1)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 (defconst :end2 ':end2)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (defconst :count ':count)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (defconst :initial-value ':initial-value)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 (defconst :size ':size)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (defconst :from-end ':from-end)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 (defconst :rehash-size ':rehash-size)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 (defconst :rehash-threshold ':rehash-threshold)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 (defconst :allow-other-keys ':allow-other-keys)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 (defvar custom-print-functions nil
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 "This is a list of functions that format user objects for printing.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 Each function is called in turn with three arguments: the object, the
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 stream, and the print level (currently ignored). If it is able to
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 print the object it returns true; otherwise it returns nil and the
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 printer proceeds to the next function on the list.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 This variable is not used at present, but it is defined in hopes that
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 a future Emacs interpreter will be able to use it.")
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 ;;; Predicates.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (defun eql (a b) ; See compiler macro in cl-macs.el
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 "T if the two args are the same Lisp object.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 Floating-point numbers of equal value are `eql', but they may not be `eq'."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 (if (numberp a)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (equal a b)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (eq a b)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 ;;; Generalized variables. These macros are defined here so that they
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 ;;; can safely be used in .emacs files.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (defmacro incf (place &optional x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 "(incf PLACE [X]): increment PLACE by X (1 by default).
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 PLACE may be a symbol, or any generalized variable allowed by `setf'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 The return value is the incremented value of PLACE."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 (if (symbolp place)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (list 'setq place (if x (list '+ place x) (list '1+ place)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (list 'callf '+ place (or x 1))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 (defmacro decf (place &optional x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 "(decf PLACE [X]): decrement PLACE by X (1 by default).
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 PLACE may be a symbol, or any generalized variable allowed by `setf'.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 The return value is the decremented value of PLACE."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (if (symbolp place)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (list 'setq place (if x (list '- place x) (list '1- place)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (list 'callf '- place (or x 1))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 (defmacro pop (place)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 "(pop PLACE): remove and return the head of the list stored in PLACE.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 careful about evaluating each argument only once and in the right order.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 PLACE may be a symbol, or any generalized variable allowed by `setf'."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (if (symbolp place)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 (cl-do-pop place)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
179 (defmacro push (x place)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 "(push X PLACE): insert X at the head of the list stored in PLACE.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 Analogous to (setf PLACE (cons X PLACE)), though more careful about
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 evaluating each argument only once and in the right order. PLACE may
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 be a symbol, or any generalized variable allowed by `setf'."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
184 (if (symbolp place) (list 'setq place (list 'cons x place))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 (list 'callf2 'cons x place)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 (defmacro pushnew (x place &rest keys)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 "(pushnew X PLACE): insert X at the head of the list if not already there.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 Like (push X PLACE), except that the list is unmodified if X is `eql' to
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 an element already on the list.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 Keywords supported: :test :test-not :key"
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 (list* 'callf2 'adjoin x place keys)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 (defun cl-set-elt (seq n val)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 (defun cl-set-nthcdr (n list x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 (defun cl-set-buffer-substring (start end val)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 (save-excursion (delete-region start end)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 (goto-char start)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 (insert val)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 val))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (defun cl-set-substring (str start end val)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 (if end (if (< end 0) (incf end (length str)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 (setq end (length str)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 (if (< start 0) (incf start str))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 (concat (and (> start 0) (substring str 0 start))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
212 val
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 (and (< end (length str)) (substring str end))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 ;;; Control structures.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
217
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 ;;; These macros are so simple and so often-used that it's better to have
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 ;;; them all the time than to load them from cl-macs.el.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 (defmacro when (cond &rest body)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 (list 'if cond (cons 'progn body)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 (defmacro unless (cond &rest body)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
227 (cons 'if (cons cond (cons nil body))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
228
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 (defun cl-map-extents (&rest cl-args)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 (if (fboundp 'map-extents) (apply 'map-extents cl-args))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 ;;; Blocks and exits.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (defalias 'cl-block-wrapper 'identity)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 (defalias 'cl-block-throw 'throw)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
239
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 ;;; Multiple values. True multiple values are not supported, or even
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241 ;;; simulated. Instead, multiple-value-bind and friends simply expect
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 ;;; the target form to return the values as a list.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 (defalias 'values 'list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 (defalias 'values-list 'identity)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 (defalias 'multiple-value-list 'identity)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247 (defalias 'multiple-value-call 'apply) ; only works for one arg
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 (defalias 'nth-value 'nth)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
251 ;;; Macros.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
252
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 (defvar cl-macro-environment nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 (defalias 'macroexpand 'cl-macroexpand)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 (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
258 "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
259 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
260 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
261 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
262
6a9124f418db (cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents: 7942
diff changeset
263 The second optional arg ENVIRONMENT species an environment of macro
6a9124f418db (cl-macroexpand): keep documentation from `macroexpand'.
Richard M. Stallman <rms@gnu.org>
parents: 7942
diff changeset
264 definitions to shadow the loaded ones for use in file byte-compilation."
4355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 (let ((cl-macro-environment cl-env))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 (and (symbolp cl-macro)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 (cdr (assq (symbol-name cl-macro) cl-env))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 cl-macro))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 ;;; Declarations.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 (defvar cl-compiling-file nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 (defun cl-compiling-file ()
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
277 (or cl-compiling-file
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278 (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 (equal (buffer-name (symbol-value 'outbuffer))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280 " *Compiler Output*"))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 (defvar cl-proclaims-deferred nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 (defun proclaim (spec)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 (push spec cl-proclaims-deferred))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 (defmacro declaim (&rest specs)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290 (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 specs)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292 (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 ;;; Symbols.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 (defun cl-random-time ()
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 v))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 ;;; Numbers.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 (defun floatp-safe (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309 "T if OBJECT is a floating point number.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 On Emacs versions that lack floating-point support, this function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 always returns nil."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 (and (numberp x) (not (integerp x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
314 (defun plusp (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
315 "T if NUMBER is positive."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 (> x 0))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
317
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
318 (defun minusp (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 "T if NUMBER is negative."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (< x 0))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 (defun oddp (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 "T if INTEGER is odd."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 (eq (logand x 1) 1))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
326 (defun evenp (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
327 "T if INTEGER is even."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 (eq (logand x 1) 0))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 (defun cl-abs (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 "Return the absolute value of ARG."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 (if (>= x 0) x (- x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 ;;; We use `eval' in case VALBITS differs from compile-time to load-time.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 (defconst most-positive-fixnum (eval '(lsh -1 -1)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 ;;; The following are actually set by cl-float-limits.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342 (defconst most-positive-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 (defconst most-negative-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 (defconst least-positive-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
345 (defconst least-negative-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
346 (defconst least-positive-normalized-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
347 (defconst least-negative-normalized-float nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
348 (defconst float-epsilon nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
349 (defconst float-negative-epsilon nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
350
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 ;;; Sequence functions.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 (defalias 'copy-seq 'copy-sequence)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
356 (defun mapcar* (cl-func cl-x &rest cl-rest)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 "Apply FUNCTION to each element of SEQ, and make a list of the results.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 If there are several SEQs, FUNCTION is called with that many arguments,
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 and mapping stops as soon as the shortest list runs out. With just one
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 SEQ, this is like `mapcar'. With several, it is like the Common Lisp
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 `mapcar' function extended to arbitrary sequence types."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362 (if cl-rest
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 (cl-mapcar-many cl-func (cons cl-x cl-rest))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 (let ((cl-res nil) (cl-y (car cl-rest)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
366 (while (and cl-x cl-y)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 (nreverse cl-res)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
369 (mapcar cl-func cl-x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
371
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
372 ;;; List functions.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (defalias 'first 'car)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
375 (defalias 'rest 'cdr)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 (defalias 'endp 'null)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 (defun second (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 "Return the second element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 (car (cdr x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
381
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 (defun third (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 "Return the third element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384 (car (cdr (cdr x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386 (defun fourth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
387 "Return the fourth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 (nth 3 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 (defun fifth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 "Return the fifth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 (nth 4 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 (defun sixth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 "Return the sixth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 (nth 5 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
397
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 (defun seventh (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 "Return the seventh element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 (nth 6 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402 (defun eighth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 "Return the eighth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
404 (nth 7 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
405
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
406 (defun ninth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 "Return the ninth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 (nth 8 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410 (defun tenth (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 "Return the tenth element of the list LIST."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 (nth 9 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 (defun caar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
415 "Return the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 (car (car x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 (defun cadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 "Return the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 (car (cdr x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 (defun cdar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 "Return the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 (cdr (car x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426 (defun cddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
427 "Return the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
428 (cdr (cdr x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
429
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
430 (defun caaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
431 "Return the `car' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
432 (car (car (car x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
433
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
434 (defun caadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
435 "Return the `car' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
436 (car (car (cdr x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
437
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
438 (defun cadar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
439 "Return the `car' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
440 (car (cdr (car x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
441
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
442 (defun caddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
443 "Return the `car' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
444 (car (cdr (cdr x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
445
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
446 (defun cdaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
447 "Return the `cdr' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
448 (cdr (car (car x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
449
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
450 (defun cdadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
451 "Return the `cdr' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
452 (cdr (car (cdr x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
453
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
454 (defun cddar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
455 "Return the `cdr' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
456 (cdr (cdr (car x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
457
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
458 (defun cdddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
459 "Return the `cdr' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
460 (cdr (cdr (cdr x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
461
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
462 (defun caaaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
463 "Return the `car' of the `car' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
464 (car (car (car (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
465
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
466 (defun caaadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
467 "Return the `car' of the `car' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
468 (car (car (car (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
469
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
470 (defun caadar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
471 "Return the `car' of the `car' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
472 (car (car (cdr (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
473
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
474 (defun caaddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
475 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
476 (car (car (cdr (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
477
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
478 (defun cadaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
479 "Return the `car' of the `cdr' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
480 (car (cdr (car (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
481
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
482 (defun cadadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
483 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
484 (car (cdr (car (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
485
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
486 (defun caddar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
487 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
488 (car (cdr (cdr (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
490 (defun cadddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
491 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
492 (car (cdr (cdr (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
493
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
494 (defun cdaaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
495 "Return the `cdr' of the `car' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496 (cdr (car (car (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498 (defun cdaadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
500 (cdr (car (car (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
501
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 (defun cdadar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 (cdr (car (cdr (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
505
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
506 (defun cdaddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
507 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
508 (cdr (car (cdr (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
509
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
510 (defun cddaar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
511 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
512 (cdr (cdr (car (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
513
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
514 (defun cddadr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
515 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
516 (cdr (cdr (car (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
517
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
518 (defun cdddar (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
519 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
520 (cdr (cdr (cdr (car x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
521
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
522 (defun cddddr (x)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
523 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
524 (cdr (cdr (cdr (cdr x)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
525
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
526 (defun last (x &optional n)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
527 "Returns the last link in the list LIST.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
528 With optional argument N, returns Nth-to-last link (default 1)."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
529 (if n
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
530 (let ((m 0) (p x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
531 (while (consp p) (incf m) (pop p))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
532 (if (<= n 0) p
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
533 (if (< n m) (nthcdr (- m n) x) x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
534 (while (consp (cdr x)) (pop x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
535 x))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
536
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
537 (defun butlast (x &optional n)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
538 "Returns a copy of LIST with the last N elements removed."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
539 (if (and n (<= n 0)) x
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
540 (nbutlast (copy-sequence x) n)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
541
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
542 (defun nbutlast (x &optional n)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
543 "Modifies LIST to remove the last N elements."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
544 (let ((m (length x)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
545 (or n (setq n 1))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
546 (and (< n m)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
547 (progn
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
548 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
549 x))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
550
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
551 (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
552 "Return a new list with specified args as elements, cons'd to last arg.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
553 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
554 `(cons A (cons B (cons C D)))'."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
555 (cond ((not rest) arg)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
556 ((not (cdr rest)) (cons arg (car rest)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
557 (t (let* ((n (length rest))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
558 (copy (copy-sequence rest))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
559 (last (nthcdr (- n 2) copy)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
560 (setcdr last (car (cdr last)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
561 (cons arg copy)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
562
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
563 (defun ldiff (list sublist)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
564 "Return a copy of LIST with the tail SUBLIST removed."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
565 (let ((res nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
566 (while (and (consp list) (not (eq list sublist)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
567 (push (pop list) res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
568 (nreverse res)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
569
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
570 (defun copy-list (list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
571 "Return a copy of a list, which may be a dotted list.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
572 The elements of the list are not copied, just the list structure itself."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
573 (if (consp list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
574 (let ((res nil))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
575 (while (consp list) (push (pop list) res))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
576 (prog1 (nreverse res) (setcdr res list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
577 (car list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
578
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
579 (defun cl-maclisp-member (item list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
580 (while (and list (not (equal item (car list)))) (setq list (cdr list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
581 list)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
582
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
583 ;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
584 (or (and (fboundp 'member) (subrp (symbol-function 'member)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
585 (defalias 'member 'cl-maclisp-member))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
586
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
587 (defalias 'cl-member 'memq) ; for compatibility with old CL package
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588 (defalias 'cl-floor 'floor*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
589 (defalias 'cl-ceiling 'ceiling*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
590 (defalias 'cl-truncate 'truncate*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
591 (defalias 'cl-round 'round*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
592 (defalias 'cl-mod 'mod*)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
593
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
594 (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
595 "Return ITEM consed onto the front of LIST only if it's not already there.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
596 Otherwise, return LIST unmodified.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
597 Keywords supported: :test :test-not :key"
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
598 (cond ((or (equal cl-keys '(:test eq))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
599 (and (null cl-keys) (not (numberp cl-item))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
601 ((or (equal cl-keys '(:test equal)) (null cl-keys))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602 (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
603 (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
604
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
605 (defun subst (cl-new cl-old cl-tree &rest cl-keys)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606 "Substitute NEW for OLD everywhere in TREE (non-destructively).
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
607 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
608 Keywords supported: :test :test-not :key"
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
609 (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
610 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611 (cl-do-subst cl-new cl-old cl-tree)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
613 (defun cl-do-subst (cl-new cl-old cl-tree)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 (cond ((eq cl-tree cl-old) cl-new)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
615 ((consp cl-tree)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616 (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619 cl-tree (cons a d))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
620 (t cl-tree)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 (defun acons (a b c) (cons (cons a b) c))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
623 (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
624
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
625
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
626 ;;; Miscellaneous.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
627
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
628 (put 'cl-assertion-failed 'error-conditions '(error))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
629 (put 'cl-assertion-failed 'error-message "Assertion failed")
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
630
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
631 ;;; This is defined in Emacs 19; define it here for Emacs 18 users.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
632 (defun cl-add-hook (hook func &optional append)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 "Add to hook variable HOOK the function FUNC.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634 FUNC is not added if it already appears on the list stored in HOOK."
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 (let ((old (and (boundp hook) (symbol-value hook))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636 (and (listp old) (not (eq (car old) 'lambda))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637 (setq old (list old)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 (and (not (member func old))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 (set hook (if append (nconc old (list func)) (cons func old))))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640 (or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
643 ;;; Autoload the other portions of the package.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644 (mapcar (function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
645 (lambda (set)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
646 (mapcar (function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
647 (lambda (func)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
648 (autoload func (car set) nil nil (nth 1 set))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
649 (cddr set))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
650 '(("cl-extra" nil
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
651 coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652 cl-map-keymap cl-map-keymap-recursively cl-map-intervals
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
653 cl-map-overlays cl-set-frame-visible-p cl-float-limits
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
654 gcd lcm isqrt expt floor* ceiling* truncate* round*
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
655 mod* rem* signum random* make-random-state random-state-p
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
656 subseq concatenate cl-mapcar-many map some every notany
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
657 notevery revappend nreconc list-length tailp copy-tree get* getf
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659 gethash cl-puthash remhash clrhash maphash hash-table-p
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
660 hash-table-count cl-progv-before cl-prettyexpand
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
661 cl-macroexpand-all)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 ("cl-seq" nil
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
663 reduce fill replace remq remove remove* remove-if remove-if-not
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
664 delete delete* delete-if delete-if-not remove-duplicates
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
665 delete-duplicates substitute substitute-if substitute-if-not
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
666 nsubstitute nsubstitute-if nsubstitute-if-not find find-if
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
667 find-if-not position position-if position-if-not count count-if
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 count-if-not mismatch search sort* stable-sort merge member*
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671 nintersection set-difference nset-difference set-exclusive-or
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673 nsubst-if-not sublis nsublis tree-equal)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 ("cl-macs" nil
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 gensym gentemp typep cl-do-pop get-setf-method
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676 cl-struct-setf-expander compiler-macroexpand cl-compile-time-init)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 ("cl-macs" t
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
678 defun* defmacro* function* destructuring-bind eval-when
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679 eval-when-compile load-time-value case ecase typecase etypecase
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680 block return return-from loop do do* dolist dotimes do-symbols
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681 do-all-symbols psetq progv flet labels macrolet symbol-macrolet
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 lexical-let lexical-let* multiple-value-bind multiple-value-setq
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683 locally the declare define-setf-method defsetf define-modify-macro
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
685 check-type assert ignore-errors define-compiler-macro)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
686
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 ;;; Define data for indentation and edebug.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 (mapcar (function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 (lambda (entry)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
690 (mapcar (function
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
691 (lambda (func)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
692 (put func 'lisp-indent-function (nth 1 entry))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693 (put func 'lisp-indent-hook (nth 1 entry))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 (or (get func 'edebug-form-spec)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 (put func 'edebug-form-spec (nth 2 entry)))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 (car entry))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 '(((defun* defmacro*) 2)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698 ((function*) nil
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700 ((eval-when) 1 (sexp &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701 ((when unless) 1 (&rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
702 ((declare) nil (&rest sexp))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703 ((the) 1 (sexp &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
705 ((block return-from) 1 (sexp &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 ((return) nil (&optional form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
707 ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 (form &rest form)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
709 &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
710 ((dolist dotimes) 1 ((symbolp form &rest form) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
711 ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
712 ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
713 ((psetq setf psetf) nil edebug-setq-form)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
714 ((progv) 2 (&rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715 ((flet labels macrolet) 1
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 ((&rest (sexp sexp &rest form)) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 ((symbol-macrolet lexical-let lexical-let*) 1
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718 ((&rest &or symbolp (symbolp form)) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
720 ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721 ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
722 ((letf letf*) 1 ((&rest (&rest form)) &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
723 ((callf destructuring-bind) 2 (sexp form &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
724 ((callf2) 3 (sexp form form &rest form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
725 ((loop) nil (&rest &or symbolp form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 ((ignore-errors) 0 (&rest form))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
727
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 ;;; This goes here so that cl-macs can find it if it loads right now.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730 (provide 'cl-19) ; usage: (require 'cl-19 "cl")
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 ;;; Things to do after byte-compiler is loaded.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734 ;;; As a side effect, we cause cl-macs to be loaded when compiling, so
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
735 ;;; that the compiler-macros defined there will be present.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
736
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
737 (defvar cl-hacked-flag nil)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
738 (defun cl-hack-byte-compiler ()
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
739 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
740 (progn
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741 (cl-compile-time-init) ; in cl-macs.el
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742 (setq cl-hacked-flag t))))
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
744 ;;; Try it now in case the compiler has already been loaded.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 (cl-hack-byte-compiler)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
747 ;;; Also make a hook in case compiler is loaded after this file.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
748 ;;; The compiler doesn't call any hooks when it loads or runs, but
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
749 ;;; we can take advantage of the fact that emacs-lisp-mode will be
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750 ;;; called when the compiler reads in the file to be compiled.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 ;;; BUG: If the first compilation is `byte-compile' rather than
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 ;;; `byte-compile-file', we lose. Oh, well.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 (add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
754
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
755
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 ;;; The following ensures that packages which expect the old-style cl.el
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
757 ;;; will be happy with this one.
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
758
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
759 (provide 'cl)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761 (provide 'mini-cl) ; for Epoch
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763 (run-hooks 'cl-load-hook)
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764
691a28818487 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
765 ;;; cl.el ends here