annotate lisp/cl.el @ 1315:70921960b980

[xemacs-hg @ 2003-02-20 08:19:28 by ben] check in makefile fixes et al Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory into src/. Simplify the dependencies -- everything in src/ is dependent on the single entry `src' in MAKE_SUBDIRS. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. mule/mule-msw-init.el: Removed. Delete this file. mule/mule-win32-init.el: New file, with stuff from mule-msw-init.el -- not just for MS Windows native, boys and girls! bytecomp.el: Change code inserted to catch trying to load a Mule-only .elc file in a non-Mule XEmacs. Formerly you got the rather cryptic "The required feature `mule' cannot be provided". Now you get "Loading this file requires Mule support". finder.el: Remove dependency on which directory this function is invoked from. update-elc.el: Don't mess around with ../src/BYTECOMPILE_CHANGE. Now that Makefile.in.in and xemacs.mak are in sync, both of them use NEEDTODUMP and the other one isn't used. dumped-lisp.el: Rewrite in terms of `list' and `nconc' instead of assemble-list, so we can have arbitrary forms, not just `when-feature'. very-early-lisp.el: Nuke this file. finder-inf.el, packages.el, update-elc.el, update-elc-2.el, loadup.el, make-docfile.el: Eliminate references to very-early-lisp. msw-glyphs.el: Comment clarification. xemacs.mak: Add macros DO_TEMACS, DO_XEMACS, and a few others; this macro section is now completely in sync with src/Makefile.in.in. Copy check-features, load-shadows, and rebuilding finder-inf.el from src/Makefile.in.in. The main build/dump/recompile process is now synchronized with src/Makefile.in.in. Change `WARNING' to `NOTE' and `error checking' to `error-checking' TO avoid tripping faux warnings and errors in the VC++ IDE. Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory from top-level Makefile.in.in to here. Simplify the dependencies. Rearrange into logical subsections. Synchronize the main compile/dump/build-elcs section with xemacs.mak, which is already clean and in good working order. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. Add additional levels of macros \(e.g. DO_TEMACS, DO_XEMACS, TEMACS_BATCH, XEMACS_BATCH, XEMACS_BATCH_PACKAGES) to factor out duplicated stuff. Clean up handling of "HEAP_IN_DATA" (Cygwin) so it doesn't need to ignore the return value from dumping. Add .NO_PARALLEL since various aspects of building and dumping must be serialized but do not always have dependencies between them (this is impossible in some cases). Everything related to src/ now gets built in one pass in this directory by just running `make' (except the Makefiles themselves and config.h, paths.h, Emacs.ad.h, and other generated .h files). console.c: Update list of possibly valid console types. emacs.c: Rationalize the specifying and handling of the type of the first frame. This was originally prompted by a workspace in which I got GTK to compile under C++ and in the process fixed it so it could coexist with X in the same build -- hence, a combined TTY/X/MS-Windows/GTK build is now possible under Cygwin. (However, you can't simultaneously *display* more than one kind of device connection -- but getting that to work is not that difficult. Perhaps a project for a bored grad student. I (ben) would do it but don't see the use.) To make sense of this, I added new switches that can be used to specifically indicate the window system: -x [aka --use-x], -tty \[aka --use-tty], -msw [aka --use-ms-windows], -gtk [aka --use-gtk], and -gnome [aka --use-gnome, same as --use-gtk]. -nw continues as an alias for -tty. When none have been given, XEmacs checks for other parameters implying particular device types (-t -> tty, -display -> x [or should it have same treatment as DISPLAY below?]), and has ad-hoc logic afterwards: if env var DISPLAY is set, use x (or gtk? perhaps should check whether gnome is running), else MS Windows if it exsits, else TTY if it exists, else stream, and you must be running in batch mode. This also fixes an existing bug whereby compiling with no x, no mswin, no tty, when running non- interactively (e.g. to dump) I get "sorry, must have TTY support". emacs.c: Turn on Vstack_trace_on_error so that errors are debuggable even when occurring extremely early in reinitialization. emacs.c: Try to make sure that the user can see message output under Windows (i.e. it doesn't just disappear right away) regardless of when it occurs, e.g. in the middle of creating the first frame. emacs.c: Define new function `emacs-run-status', indicating whether XEmacs is noninteractive or interactive, whether raw, post-dump/pdump-load or run-temacs, whether we are dumping, whether pdump is in effect. event-stream.c: It's "mommas are fat", not "momas are fat". Fix other typo. event-stream.c: Conditionalize in_menu_callback check on HAVE_MENUBARS, because it won't exist on w/o menubar support, lisp.h: More hackery on RETURN_NOT_REACHED. Cygwin v3.2 DOES complain here if RETURN_NOT_REACHED() is blank, as it is for GCC 2.5+. So make it blank only for GCC 2.5 through 2.999999999999999. Declare Vstack_trace_on_error. profile.c: Need to include "profile.h" to fix warnings. sheap.c: Don't fatal() when need to rerun Make, just stderr_out() and exit(0). That way we can distinguish between a dumping failing expectedly (due to lack of stack space, triggering another dump) and unexpectedly, in which case, we want to stop building. (or go on, if -K is given) syntax.c, syntax.h: Use ints where they belong, and enum syntaxcode's where they belong, and fix warnings thereby. syntax.h: Fix crash caused by an edge condition in the syntax-cache macros. text.h: Spacing fixes. xmotif.h: New file, to get around shadowing warnings. EmacsManager.c, event-Xt.c, glyphs-x.c, gui-x.c, input-method-motif.c, xmmanagerp.h, xmprimitivep.h: Include xmotif.h. alloc.c: Conditionalize in_malloc on ERROR_CHECK_MALLOC. config.h.in, file-coding.h, fileio.c, getloadavg.c, select-x.c, signal.c, sysdep.c, sysfile.h, systime.h, text.c, unicode.c: Eliminate HAVE_WIN32_CODING_SYSTEMS, use WIN32_ANY instead. Replace defined (WIN32_NATIVE) || defined (CYGWIN) with WIN32_ANY. lisp.h: More futile attempts to walk and chew gum at the same time when dealing with subr's that don't return.
author ben
date Thu, 20 Feb 2003 08:19:44 +0000
parents 023b83f4e54b
children 9c872f33ecbe
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 446
diff changeset
1 ;;; cl.el --- Common Lisp extensions for XEmacs Lisp
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Dave Gillespie <daveg@synaptics.com>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Version: 2.02
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: extensions, dumped, lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: FSF 19.34.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; These are extensions to Emacs Lisp that provide a degree of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; Common Lisp compatibility, beyond what is already built-in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; in Emacs Lisp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; This package was written by Dave Gillespie; it is a complete
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; This package works with Emacs 18, Emacs 19, and XEmacs/Lucid Emacs 19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; Bug reports, comments, and suggestions are welcome!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; This file contains the portions of the Common Lisp extensions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; package which should always be present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;;; Future notes:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; Once Emacs 19 becomes standard, many things in this package which are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; messy for reasons of compatibility can be greatly simplified. For now,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; I prefer to maintain one unified version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;;; Change Log:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; Version 2.02 (30 Jul 93):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; * Added "cl-compat.el" file, extra compatibility with old package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; * Added `lexical-let' and `lexical-let*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; * Added `define-modify-macro', `callf', and `callf2'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;; * Added `ignore-errors'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; * Merged `*gentemp-counter*' into `*gensym-counter*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; * Extended `subseq' to allow negative START and END like `substring'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; * Added `concat', `vconcat' loop clauses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;; * Cleaned up a number of compiler warnings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; Version 2.01 (7 Jul 93):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; * Added support for FSF version of Emacs 19.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 ;; * Added `add-hook' for Emacs 18 users.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;; * Added `defsubst*' and `symbol-macrolet'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;; * Added `map', `concatenate', `reduce', `merge'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; * Added `revappend', `nreconc', `tailp', `tree-equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; * Added destructuring and `&environment' support to `defmacro*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; * Added destructuring to `loop', and added the following clauses:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; * Renamed `delete' to `delete*' and `remove' to `remove*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; * Completed support for all keywords in `remove*', `substitute', etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;; * Added `most-positive-float' and company.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; * Fixed hash tables to work with latest Lucid Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; * Syntax for `warn' declarations has changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; * Improved implementation of `random*'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; * Moved most sequence functions to a new file, cl-seq.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;; * Moved `eval-when' into cl-macs.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;; * Moved `provide' forms down to ends of files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; * Changed expansion of `pop' to something that compiles to better code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;; * Changed so that no patch is required for Emacs 19 byte compiler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;; * Made more things dependent on `optimize' declarations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;; * Added a partial implementation of struct print functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;; * Miscellaneous minor changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;; Version 2.00:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ;; * First public release of this package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (symbol-value 'epoch::version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (string-lessp emacs-version "19")) 18)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 ((string-match "XEmacs" emacs-version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 'lucid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (t 19)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (or (fboundp 'defalias) (fset 'defalias 'fset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 (defvar cl-optimize-speed 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 (defvar cl-optimize-safety 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 ;;; Keywords used in this package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 ;;; XEmacs - keywords are done in Fintern().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 ;;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 ;;; (defconst :test ':test)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 ;;; (defconst :test-not ':test-not)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ;;; (defconst :key ':key)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 ;;; (defconst :start ':start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 ;;; (defconst :start1 ':start1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 ;;; (defconst :start2 ':start2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 ;;; (defconst :end ':end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 ;;; (defconst :end1 ':end1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 ;;; (defconst :end2 ':end2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 ;;; (defconst :count ':count)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 ;;; (defconst :initial-value ':initial-value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 ;;; (defconst :size ':size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 ;;; (defconst :from-end ':from-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 ;;; (defconst :rehash-size ':rehash-size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 ;;; (defconst :rehash-threshold ':rehash-threshold)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 ;;; (defconst :allow-other-keys ':allow-other-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (defvar custom-print-functions nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 "This is a list of functions that format user objects for printing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Each function is called in turn with three arguments: the object, the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 stream, and the print level (currently ignored). If it is able to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 print the object it returns true; otherwise it returns nil and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 printer proceeds to the next function on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 This variable is not used at present, but it is defined in hopes that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 a future Emacs interpreter will be able to use it.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 ;;; Predicates.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (defun eql (a b) ; See compiler macro in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 "Return t if the two args are the same Lisp object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Floating-point numbers of equal value are `eql', but they may not be `eq'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (if (floatp a)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (equal a b)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (eq a b)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 ;;; Generalized variables. These macros are defined here so that they
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 ;;; can safely be used in .emacs files.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (defmacro incf (place &optional x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 "(incf PLACE [X]): increment PLACE by X (1 by default).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 PLACE may be a symbol, or any generalized variable allowed by `setf'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 The return value is the incremented value of PLACE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (list 'setq place (if x (list '+ place x) (list '1+ place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 ;; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 ;; is OK.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 (list 'callf '+ place (or x 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (defmacro decf (place &optional x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 "(decf PLACE [X]): decrement PLACE by X (1 by default).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 PLACE may be a symbol, or any generalized variable allowed by `setf'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 The return value is the decremented value of PLACE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (list 'setq place (if x (list '- place x) (list '1- place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 (list 'callf '- place (or x 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (defmacro pop (place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 "(pop PLACE): remove and return the head of the list stored in PLACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 careful about evaluating each argument only once and in the right order.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 PLACE may be a symbol, or any generalized variable allowed by `setf'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 (if (symbolp place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 `(car (prog1 ,place (setq ,place (cdr ,place))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 (cl-do-pop place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 (defmacro push (x place)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 "(push X PLACE): insert X at the head of the list stored in PLACE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Analogous to (setf PLACE (cons X PLACE)), though more careful about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 evaluating each argument only once and in the right order. PLACE may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 be a symbol, or any generalized variable allowed by `setf'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 (if (symbolp place) `(setq ,place (cons ,x ,place))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 (list 'callf2 'cons x place)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 (defmacro pushnew (x place &rest keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 "(pushnew X PLACE): insert X at the head of the list if not already there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 Like (push X PLACE), except that the list is unmodified if X is `eql' to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 an element already on the list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (list* 'callf2 'adjoin x place keys)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 (defun cl-set-elt (seq n val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 (defun cl-set-nthcdr (n list x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 (defun cl-set-buffer-substring (start end val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 (save-excursion (delete-region start end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 (goto-char start)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 (insert val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 (defun cl-set-substring (str start end val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 (if end (if (< end 0) (incf end (length str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 (setq end (length str)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 (if (< start 0) (incf start str))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 (concat (and (> start 0) (substring str 0 start))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 (and (< end (length str)) (substring str end))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 ;;; Control structures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 ;; The macros `when' and `unless' are so useful that we want them to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 ;; ALWAYS be available. So they've been moved from cl.el to eval.c.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 ;; Note: FSF Emacs moved them to subr.el in FSF 20.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 (defun cl-map-extents (&rest cl-args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 ;; XEmacs: This used to check for overlays first, but that's wrong
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 ;; because of the new compatibility library. *duh*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 (cond ((fboundp 'map-extents)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 (apply 'map-extents cl-args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 ((fboundp 'next-overlay-at)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 (apply 'cl-map-overlays cl-args))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ;;; Blocks and exits.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 (defalias 'cl-block-wrapper 'identity)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 (defalias 'cl-block-throw 'throw)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 ;;; Multiple values. True multiple values are not supported, or even
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ;;; simulated. Instead, multiple-value-bind and friends simply expect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ;;; the target form to return the values as a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 (defalias 'values 'list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 (defalias 'values-list 'identity)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 (defalias 'multiple-value-list 'identity)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 (defalias 'multiple-value-call 'apply) ; only works for one arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (defalias 'nth-value 'nth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 ;;; Macros.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 (defvar cl-macro-environment nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 ;; XEmacs: we renamed the internal function to macroexpand-internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 ;; to avoid doc-file problems.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand-internal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 (defalias 'macroexpand 'cl-macroexpand)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (defun cl-macroexpand (cl-macro &optional cl-env)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 "Return result of expanding macros at top level of FORM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 If FORM is not a macro call, it is returned unchanged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 Otherwise, the macro is expanded and the expansion is considered
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 in place of FORM. When a non-macro-call results, it is returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
272 The second optional arg ENVIRONMENT specifies an environment of macro
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 definitions to shadow the loaded ones for use in file byte-compilation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (let ((cl-macro-environment cl-env))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (and (symbolp cl-macro)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (cdr (assq (symbol-name cl-macro) cl-env))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 cl-macro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 ;;; Declarations.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (defvar cl-compiling-file nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (defun cl-compiling-file ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (or cl-compiling-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 ; (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 ; (equal (buffer-name (symbol-value 'outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 ; " *Compiler Output*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (and (boundp 'byte-compile-outbuffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (bufferp (symbol-value 'byte-compile-outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (equal (buffer-name (symbol-value 'byte-compile-outbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 " *Compiler Output*"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (defvar cl-proclaims-deferred nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (defun proclaim (spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (push spec cl-proclaims-deferred))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (defmacro declaim (&rest specs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 specs)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 ;;; Symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (defun cl-random-time ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 v))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
320 (defun gensym (&optional arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
321 "Generate a new uninterned symbol.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
322 The name is made by appending a number to PREFIX, default \"G\"."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
323 (let ((prefix (if (stringp arg) arg "G"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
324 (num (if (integerp arg) arg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
325 (prog1 *gensym-counter*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
326 (setq *gensym-counter* (1+ *gensym-counter*))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
327 (make-symbol (format "%s%d" prefix num))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
328
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
329 (defun gentemp (&optional arg)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
330 "Generate a new interned symbol with a unique name.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
331 The name is made by appending a number to PREFIX, default \"G\"."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
332 (let ((prefix (if (stringp arg) arg "G"))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
333 name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
334 (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
335 (setq *gensym-counter* (1+ *gensym-counter*)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
336 (intern name)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 ;;; Numbers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
340 (defun floatp-safe (object)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
341 "Return t if OBJECT is a floating point number."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
342 (floatp object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
344 (defun plusp (number)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 "Return t if NUMBER is positive."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
346 (> number 0))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
347
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
348 (defun minusp (number)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
349 "Return t if NUMBER is negative."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
350 (< number 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
352 (defun oddp (integer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 "Return t if INTEGER is odd."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
354 (eq (logand integer 1) 1))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
356 (defun evenp (integer)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 "Return t if INTEGER is even."
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
358 (eq (logand integer 1) 0))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
360 (defun cl-abs (number)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
361 "Return the absolute value of NUMBER."
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
362 (if (>= number 0) number (- number)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 ;;; We use `eval' in case VALBITS differs from compile-time to load-time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (defconst most-positive-fixnum (eval '(lsh -1 -1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 "The integer closest in value to positive infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "The integer closest in value to negative infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 ;;; The following are set by code in cl-extra.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (defconst most-positive-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 "The float closest in value to positive infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 (defconst most-negative-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 "The float closest in value to negative infinity.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (defconst least-positive-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 "The positive float closest in value to 0.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (defconst least-negative-float nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 "The negative float closest in value to 0.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (defconst least-positive-normalized-float nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (defconst least-negative-normalized-float nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (defconst float-epsilon nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (defconst float-negative-epsilon nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 ;;; Sequence functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (defalias 'copy-seq 'copy-sequence)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (defun mapcar* (cl-func cl-x &rest cl-rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 "Apply FUNCTION to each element of SEQ, and make a list of the results.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 If there are several SEQs, FUNCTION is called with that many arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 and mapping stops as soon as the shortest list runs out. With just one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 SEQ, this is like `mapcar'. With several, it is like the Common Lisp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 `mapcar' function extended to arbitrary sequence types."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (if cl-rest
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (cl-mapcar-many cl-func (cons cl-x cl-rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (let ((cl-res nil) (cl-y (car cl-rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (while (and cl-x cl-y)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (nreverse cl-res)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (mapcar cl-func cl-x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 ;;; List functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;; These functions are made known to the byte-compiler by cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 ;; and turned into efficient car and cdr bytecodes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (defalias 'first 'car)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (defalias 'rest 'cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (defalias 'endp 'null)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (defun second (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 "Return the second element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (car (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (defun third (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 "Return the third element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (car (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (defun fourth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 "Return the fourth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (nth 3 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (defun fifth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 "Return the fifth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (nth 4 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (defun sixth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 "Return the sixth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (nth 5 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (defun seventh (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 "Return the seventh element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (nth 6 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (defun eighth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "Return the eighth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (nth 7 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (defun ninth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 "Return the ninth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (nth 8 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (defun tenth (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 "Return the tenth element of the list LIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (nth 9 x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (defun caar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 "Return the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (car (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (defun cadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 "Return the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (car (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 (defun cdar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 "Return the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (cdr (car x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (defun cddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 "Return the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (cdr (cdr x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (defun caaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 "Return the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (car (car (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (defun caadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 "Return the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (car (car (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (defun cadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 "Return the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (car (cdr (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defun caddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "Return the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (car (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 (defun cdaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 "Return the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (cdr (car (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (defun cdadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 "Return the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (cdr (car (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (defun cddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 "Return the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (cdr (cdr (car x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (defun cdddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 "Return the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (cdr (cdr (cdr x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (defun caaaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 "Return the `car' of the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (car (car (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (defun caaadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 "Return the `car' of the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (car (car (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (defun caadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 "Return the `car' of the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (car (car (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (defun caaddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (car (car (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 (defun cadaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 "Return the `car' of the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 (car (cdr (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 (defun cadadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (car (cdr (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (defun caddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (car (cdr (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (defun cadddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 (car (cdr (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (defun cdaaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 "Return the `cdr' of the `car' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 (cdr (car (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (defun cdaadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 (cdr (car (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (defun cdadar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (cdr (car (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (defun cdaddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (cdr (car (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (defun cddaar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (cdr (cdr (car (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (defun cddadr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (cdr (cdr (car (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 (defun cdddar (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (cdr (cdr (cdr (car x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (defun cddddr (x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (cdr (cdr (cdr (cdr x)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 ;;; `last' is implemented as a C primitive, as of 1998-11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 ;(defun last (x &optional n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 ; "Return the last link in the list LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 ;With optional argument N, return Nth-to-last link (default 1)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 ; (if n
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 ; (let ((m 0) (p x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 ; (while (consp p) (incf m) (pop p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 ; (if (<= n 0) p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 ; (if (< n m) (nthcdr (- m n) x) x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 ; (while (consp (cdr x)) (pop x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 ; x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 ;;; `butlast' is implemented as a C primitive, as of 1998-11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 ;;; `nbutlast' is implemented as a C primitive, as of 1998-11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 ;(defun butlast (x &optional n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 ; "Return a copy of LIST with the last N elements removed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ; (if (and n (<= n 0)) x
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ; (nbutlast (copy-sequence x) n)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 ;(defun nbutlast (x &optional n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 ; "Modify LIST to remove the last N elements."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 ; (let ((m (length x)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 ; (or n (setq n 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 ; (and (< n m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 ; (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 ; (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 ; x))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 "Return a new list with specified args as elements, cons'd to last arg.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 `(cons A (cons B (cons C D)))'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 (cond ((not rest) arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 ((not (cdr rest)) (cons arg (car rest)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 (t (let* ((n (length rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 (copy (copy-sequence rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (last (nthcdr (- n 2) copy)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (setcdr last (car (cdr last)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (cons arg copy)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (defun ldiff (list sublist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 "Return a copy of LIST with the tail SUBLIST removed."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (let ((res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (while (and (consp list) (not (eq list sublist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (push (pop list) res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (nreverse res)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 ;;; `copy-list' is implemented as a C primitive, as of 1998-11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ;(defun copy-list (list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 ; "Return a copy of a list, which may be a dotted list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 ;The elements of the list are not copied, just the list structure itself."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ; (if (consp list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 ; (let ((res nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 ; (while (consp list) (push (pop list) res))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 ; (prog1 (nreverse res) (setcdr res list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 ; (car list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 (defun cl-maclisp-member (item list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (while (and list (not (equal item (car list)))) (setq list (cdr list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 ;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (or (and (fboundp 'member) (subrp (symbol-function 'member)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 (defalias 'member 'cl-maclisp-member))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (defalias 'cl-member 'memq) ; for compatibility with old CL package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (defalias 'cl-floor 'floor*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 (defalias 'cl-ceiling 'ceiling*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (defalias 'cl-truncate 'truncate*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 (defalias 'cl-round 'round*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (defalias 'cl-mod 'mod*)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 "Return ITEM consed onto the front of LIST only if it's not already there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 Otherwise, return LIST unmodified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (cond ((or (equal cl-keys '(:test eq))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (and (null cl-keys) (not (numberp cl-item))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 ((or (equal cl-keys '(:test equal)) (null cl-keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (t (apply 'cl-adjoin cl-item cl-list cl-keys))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (defun subst (cl-new cl-old cl-tree &rest cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 "Substitute NEW for OLD everywhere in TREE (non-destructively).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 Keywords supported: :test :test-not :key"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 (cl-do-subst cl-new cl-old cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (defun cl-do-subst (cl-new cl-old cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (cond ((eq cl-tree cl-old) cl-new)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 ((consp cl-tree)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 cl-tree (cons a d))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (t cl-tree)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 (defun acons (a b c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 "Return a new alist created by adding (KEY . VALUE) to ALIST."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (cons (cons a b) c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 ;;; Miscellaneous.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (define-error 'cl-assertion-failed "Assertion failed")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 ;;; This is defined in Emacs 19; define it here for Emacs 18 users.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 (defun cl-add-hook (hook func &optional append)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 "Add to hook variable HOOK the function FUNC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 FUNC is not added if it already appears on the list stored in HOOK."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (let ((old (and (boundp hook) (symbol-value hook))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (and (listp old) (not (eq (car old) 'lambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (setq old (list old)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (and (not (member func old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (set hook (if append (nconc old (list func)) (cons func old))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 (or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 ;; XEmacs change
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 ;(load "cl-defs")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 ;;; Define data for indentation and edebug.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 #'(lambda (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 #'(lambda (func)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (put func 'lisp-indent-function (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 (put func 'lisp-indent-hook (nth 1 entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 (or (get func 'edebug-form-spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 (put func 'edebug-form-spec (nth 2 entry))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 (car entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 '(((defun* defmacro*) defun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 ((function*) nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 ((eval-when) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 ((when unless) 1 (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 ((declare) nil (&rest sexp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 ((the) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 ((block return-from) 1 (sexp &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 ((return) nil (&optional form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 (form &rest form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 ((dolist dotimes) 1 ((symbolp form &rest form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 ((psetq setf psetf) nil edebug-setq-form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 ((progv) 2 (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 ((flet labels macrolet) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 ((&rest (sexp sexp &rest form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 ((symbol-macrolet lexical-let lexical-let*) 1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 ((&rest &or symbolp (symbolp form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 ((letf letf*) 1 ((&rest (&rest form)) &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 ((callf destructuring-bind) 2 (sexp form &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 ((callf2) 3 (sexp form form &rest form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 ((loop) defun (&rest &or symbolp form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 ((ignore-errors) 0 (&rest form))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 ;;; This goes here so that cl-macs can find it if it loads right now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (provide 'cl-19) ; usage: (require 'cl-19 "cl")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 ;;; Things to do after byte-compiler is loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 ;;; As a side effect, we cause cl-macs to be loaded when compiling, so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 ;;; that the compiler-macros defined there will be present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (defvar cl-hacked-flag nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (defun cl-hack-byte-compiler ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 (progn
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
748 (when (not (fboundp 'cl-compile-time-init))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
749 (load "cl-macs" nil t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (cl-compile-time-init) ; in cl-macs.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (setq cl-hacked-flag t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 ;;; Try it now in case the compiler has already been loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (cl-hack-byte-compiler)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 ;;; Also make a hook in case compiler is loaded after this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 ;;; The compiler doesn't call any hooks when it loads or runs, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 ;;; we can take advantage of the fact that emacs-lisp-mode will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 ;;; called when the compiler reads in the file to be compiled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 ;;; BUG: If the first compilation is `byte-compile' rather than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 ;;; `byte-compile-file', we lose. Oh, well.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 ;;; The following ensures that packages which expect the old-style cl.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 ;;; will be happy with this one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (provide 'cl)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (provide 'mini-cl) ; for Epoch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (run-hooks 'cl-load-hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 ;;; cl.el ends here