;;; cl.el --- Common Lisp extensions for GNU Emacs Lisp;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.;; Author: Dave Gillespie <daveg@synaptics.com>;; Maintainer: XEmacs Development Team;; Version: 2.02;; Keywords: extensions, dumped, lisp;; This file is part of XEmacs.;; XEmacs is free software; you can redistribute it and/or modify it;; under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; XEmacs is distributed in the hope that it will be useful, but;; WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU;; General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with XEmacs; see the file COPYING. If not, write to the Free;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA;; 02111-1307, USA.;;; Synched up with: FSF 19.34.;;; Commentary:;; This file is dumped with XEmacs.;; These are extensions to Emacs Lisp that provide a degree of;; Common Lisp compatibility, beyond what is already built-in;; in Emacs Lisp.;;;; This package was written by Dave Gillespie; it is a complete;; rewrite of Cesar Quiroz's original cl.el package of December 1986.;;;; This package works with Emacs 18, Emacs 19, and XEmacs/Lucid Emacs 19.;;;; Bug reports, comments, and suggestions are welcome!;; This file contains the portions of the Common Lisp extensions;; package which should always be present.;;; Future notes:;; Once Emacs 19 becomes standard, many things in this package which are;; messy for reasons of compatibility can be greatly simplified. For now,;; I prefer to maintain one unified version.;;; Change Log:;; Version 2.02 (30 Jul 93):;; * Added "cl-compat.el" file, extra compatibility with old package.;; * Added `lexical-let' and `lexical-let*'.;; * Added `define-modify-macro', `callf', and `callf2'.;; * Added `ignore-errors'.;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.;; * Merged `*gentemp-counter*' into `*gensym-counter*'.;; * Extended `subseq' to allow negative START and END like `substring'.;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses.;; * Added `concat', `vconcat' loop clauses.;; * Cleaned up a number of compiler warnings.;; Version 2.01 (7 Jul 93):;; * Added support for FSF version of Emacs 19.;; * Added `add-hook' for Emacs 18 users.;; * Added `defsubst*' and `symbol-macrolet'.;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.;; * Added `map', `concatenate', `reduce', `merge'.;; * Added `revappend', `nreconc', `tailp', `tree-equal'.;; * Added `assert', `check-type', `typecase', `typep', and `deftype'.;; * Added destructuring and `&environment' support to `defmacro*'.;; * Added destructuring to `loop', and added the following clauses:;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.;; * Renamed `delete' to `delete*' and `remove' to `remove*'.;; * Completed support for all keywords in `remove*', `substitute', etc.;; * Added `most-positive-float' and company.;; * Fixed hash tables to work with latest Lucid Emacs.;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.;; * Syntax for `warn' declarations has changed.;; * Improved implementation of `random*'.;; * Moved most sequence functions to a new file, cl-seq.el.;; * Moved `eval-when' into cl-macs.el.;; * Moved `pushnew' and `adjoin' to cl.el for most common cases.;; * Moved `provide' forms down to ends of files.;; * Changed expansion of `pop' to something that compiles to better code.;; * Changed so that no patch is required for Emacs 19 byte compiler.;; * Made more things dependent on `optimize' declarations.;; * Added a partial implementation of struct print functions.;; * Miscellaneous minor changes.;; Version 2.00:;; * First public release of this package.;;; Code:(defvarcl-emacs-type(cond((or(and(fboundp'epoch::version)(symbol-value'epoch::version))(string-lesspemacs-version"19"))18)((string-match"XEmacs"emacs-version)'lucid)(t19)))(or(fboundp'defalias)(fset'defalias'fset))(defvarcl-optimize-speed1)(defvarcl-optimize-safety1);;; Keywords used in this package.;;; XEmacs - keywords are done in Fintern().;;;;;; (defconst :test ':test);;; (defconst :test-not ':test-not);;; (defconst :key ':key);;; (defconst :start ':start);;; (defconst :start1 ':start1);;; (defconst :start2 ':start2);;; (defconst :end ':end);;; (defconst :end1 ':end1);;; (defconst :end2 ':end2);;; (defconst :count ':count);;; (defconst :initial-value ':initial-value);;; (defconst :size ':size);;; (defconst :from-end ':from-end);;; (defconst :rehash-size ':rehash-size);;; (defconst :rehash-threshold ':rehash-threshold);;; (defconst :allow-other-keys ':allow-other-keys)(defvarcustom-print-functionsnil"This is a list of functions that format user objects for printing.Each function is called in turn with three arguments: the object, thestream, and the print level (currently ignored). If it is able toprint the object it returns true; otherwise it returns nil and theprinter proceeds to the next function on the list.This variable is not used at present, but it is defined in hopes thata future Emacs interpreter will be able to use it.");;; Predicates.(defuneql(ab); See compiler macro in cl-macs.el"Return t if the two args are the same Lisp object.Floating-point numbers of equal value are `eql', but they may not be `eq'."(if(floatpa)(equalab)(eqab)));;; Generalized variables. These macros are defined here so that they;;; can safely be used in .emacs files.(defmacroincf(place&optionalx)"(incf PLACE [X]): increment PLACE by X (1 by default).PLACE may be a symbol, or any generalized variable allowed by `setf'.The return value is the incremented value of PLACE."(if(symbolpplace)(list'setqplace(ifx(list'+placex)(list'1+place)));; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this;; is OK.(list'callf'+place(orx1))))(defmacrodecf(place&optionalx)"(decf PLACE [X]): decrement PLACE by X (1 by default).PLACE may be a symbol, or any generalized variable allowed by `setf'.The return value is the decremented value of PLACE."(if(symbolpplace)(list'setqplace(ifx(list'-placex)(list'1-place)))(list'callf'-place(orx1))))(defmacropop(place)"(pop PLACE): remove and return the head of the list stored in PLACE.Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though morecareful about evaluating each argument only once and in the right order.PLACE may be a symbol, or any generalized variable allowed by `setf'."(if(symbolpplace)`(car(prog1,place(setq,place(cdr,place))))(cl-do-popplace)))(defmacropush(xplace)"(push X PLACE): insert X at the head of the list stored in PLACE.Analogous to (setf PLACE (cons X PLACE)), though more careful aboutevaluating each argument only once and in the right order. PLACE maybe a symbol, or any generalized variable allowed by `setf'."(if(symbolpplace)`(setq,place(cons,x,place))(list'callf2'consxplace)))(defmacropushnew(xplace&restkeys)"(pushnew X PLACE): insert X at the head of the list if not already there.Like (push X PLACE), except that the list is unmodified if X is `eql' toan element already on the list.Keywords supported: :test :test-not :key"(if(symbolpplace)(list'setqplace(list*'adjoinxplacekeys))(list*'callf2'adjoinxplacekeys)))(defuncl-set-elt(seqnval)(if(listpseq)(setcar(nthcdrnseq)val)(asetseqnval)))(defuncl-set-nthcdr(nlistx)(if(<=n0)x(setcdr(nthcdr(1-n)list)x)list))(defuncl-set-buffer-substring(startendval)(save-excursion(delete-regionstartend)(goto-charstart)(insertval)val))(defuncl-set-substring(strstartendval)(ifend(if(<end0)(incfend(lengthstr)))(setqend(lengthstr)))(if(<start0)(incfstartstr))(concat(and(>start0)(substringstr0start))val(and(<end(lengthstr))(substringstrend))));;; Control structures.;; The macros `when' and `unless' are so useful that we want them to;; ALWAYS be available. So they've been moved from cl.el to eval.c.;; Note: FSF Emacs moved them to subr.el in FSF 20.(defuncl-map-extents(&restcl-args);; XEmacs: This used to check for overlays first, but that's wrong;; because of the new compatibility library. *duh*(cond((fboundp'map-extents)(apply'map-extentscl-args))((fboundp'next-overlay-at)(apply'cl-map-overlayscl-args))));;; Blocks and exits.(defalias'cl-block-wrapper'identity)(defalias'cl-block-throw'throw);;; Multiple values. True multiple values are not supported, or even;;; simulated. Instead, multiple-value-bind and friends simply expect;;; the target form to return the values as a list.(defalias'values'list)(defalias'values-list'identity)(defalias'multiple-value-list'identity)(defalias'multiple-value-call'apply); only works for one arg(defalias'nth-value'nth);;; Macros.(defvarcl-macro-environmentnil);; XEmacs: we renamed the internal function to macroexpand-internal;; to avoid doc-file problems.(defvarcl-old-macroexpand(prog1(symbol-function'macroexpand-internal)(defalias'macroexpand'cl-macroexpand)))(defuncl-macroexpand(cl-macro&optionalcl-env)"Return result of expanding macros at top level of FORM.If FORM is not a macro call, it is returned unchanged.Otherwise, the macro is expanded and the expansion is consideredin place of FORM. When a non-macro-call results, it is returned.The second optional arg ENVIRONMENT species an environment of macrodefinitions to shadow the loaded ones for use in file byte-compilation."(let((cl-macro-environmentcl-env))(while(progn(setqcl-macro(funcallcl-old-macroexpandcl-macrocl-env))(and(symbolpcl-macro)(cdr(assq(symbol-namecl-macro)cl-env))))(setqcl-macro(cadr(assq(symbol-namecl-macro)cl-env))))cl-macro));;; Declarations.(defvarcl-compiling-filenil)(defuncl-compiling-file()(orcl-compiling-file;; XEmacs change; (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer)); (equal (buffer-name (symbol-value 'outbuffer)); " *Compiler Output*"))(and(boundp'byte-compile-outbuffer)(bufferp(symbol-value'byte-compile-outbuffer))(equal(buffer-name(symbol-value'byte-compile-outbuffer))" *Compiler Output*"))))(defvarcl-proclaims-deferrednil)(defunproclaim(spec)(if(fboundp'cl-do-proclaim)(cl-do-proclaimspect)(pushspeccl-proclaims-deferred))nil)(defmacrodeclaim(&restspecs)(let((body(mapcar(function(lambda(x)(list'proclaim(list'quotex))))specs)))(if(cl-compiling-file)(list*'eval-when'(compileloadeval)body)(cons'prognbody)))); avoid loading cl-macs.el for eval-when;;; Symbols.(defuncl-random-time()(let*((time(copy-sequence(current-time-string)))(i(lengthtime))(v0))(while(>=(decfi)0)(setqv(+(*v3)(areftimei))))v))(defvar*gensym-counter*(*(logand(cl-random-time)1023)100))(defungensym(&optionalarg)"Generate a new uninterned symbol.The name is made by appending a number to PREFIX, default \"G\"."(let((prefix(if(stringparg)arg"G"))(num(if(integerparg)arg(prog1*gensym-counter*(setq*gensym-counter*(1+*gensym-counter*))))))(make-symbol(format"%s%d"prefixnum))))(defungentemp(&optionalarg)"Generate a new interned symbol with a unique name.The name is made by appending a number to PREFIX, default \"G\"."(let((prefix(if(stringparg)arg"G"))name)(while(intern-soft(setqname(format"%s%d"prefix*gensym-counter*)))(setq*gensym-counter*(1+*gensym-counter*)))(internname)));;; Numbers.(defunfloatp-safe(x)"Return t if OBJECT is a floating point number.On Emacs versions that lack floating-point support, this functionalways returns nil.";;(and (numberp x) (not (integerp x)));; XEmacs: use floatp. XEmacs is always compiled with;; floating-point, anyway.(floatpx))(defunplusp(x)"Return t if NUMBER is positive."(>x0))(defunminusp(x)"Return t if NUMBER is negative."(<x0))(defunoddp(x)"Return t if INTEGER is odd."(eq(logandx1)1))(defunevenp(x)"Return t if INTEGER is even."(eq(logandx1)0))(defuncl-abs(x)"Return the absolute value of ARG."(if(>=x0)x(-x)))(or(fboundp'abs)(defalias'abs'cl-abs)); This is built-in to Emacs 19(defvar*random-state*(vector'cl-random-state-tag-130(cl-random-time)));;; We use `eval' in case VALBITS differs from compile-time to load-time.(defconstmost-positive-fixnum(eval'(lsh-1-1))"The integer closest in value to positive infinity.")(defconstmost-negative-fixnum(eval'(--1(lsh-1-1)))"The integer closest in value to negative infinity.");;; The following are set by code in cl-extra.el(defconstmost-positive-floatnil"The float closest in value to positive infinity.")(defconstmost-negative-floatnil"The float closest in value to negative infinity.")(defconstleast-positive-floatnil"The positive float closest in value to 0.")(defconstleast-negative-floatnil"The negative float closest in value to 0.")(defconstleast-positive-normalized-floatnil)(defconstleast-negative-normalized-floatnil)(defconstfloat-epsilonnil)(defconstfloat-negative-epsilonnil);;; Sequence functions.(defalias'copy-seq'copy-sequence)(defunmapcar*(cl-funccl-x&restcl-rest)"Apply FUNCTION to each element of SEQ, and make a list of the results.If there are several SEQs, FUNCTION is called with that many arguments,and mapping stops as soon as the shortest list runs out. With just oneSEQ, this is like `mapcar'. With several, it is like the Common Lisp`mapcar' function extended to arbitrary sequence types."(ifcl-rest(if(or(cdrcl-rest)(nlistpcl-x)(nlistp(carcl-rest)))(cl-mapcar-manycl-func(conscl-xcl-rest))(let((cl-resnil)(cl-y(carcl-rest)))(while(andcl-xcl-y)(push(funcallcl-func(popcl-x)(popcl-y))cl-res))(nreversecl-res)))(mapcarcl-funccl-x)));;; List functions.;; These functions are made known to the byte-compiler by cl-macs.el;; and turned into efficient car and cdr bytecodes.(defalias'first'car)(defalias'rest'cdr)(defalias'endp'null)(defunsecond(x)"Return the second element of the list LIST."(car(cdrx)))(defunthird(x)"Return the third element of the list LIST."(car(cdr(cdrx))))(defunfourth(x)"Return the fourth element of the list LIST."(nth3x))(defunfifth(x)"Return the fifth element of the list LIST."(nth4x))(defunsixth(x)"Return the sixth element of the list LIST."(nth5x))(defunseventh(x)"Return the seventh element of the list LIST."(nth6x))(defuneighth(x)"Return the eighth element of the list LIST."(nth7x))(defunninth(x)"Return the ninth element of the list LIST."(nth8x))(defuntenth(x)"Return the tenth element of the list LIST."(nth9x))(defuncaar(x)"Return the `car' of the `car' of X."(car(carx)))(defuncadr(x)"Return the `car' of the `cdr' of X."(car(cdrx)))(defuncdar(x)"Return the `cdr' of the `car' of X."(cdr(carx)))(defuncddr(x)"Return the `cdr' of the `cdr' of X."(cdr(cdrx)))(defuncaaar(x)"Return the `car' of the `car' of the `car' of X."(car(car(carx))))(defuncaadr(x)"Return the `car' of the `car' of the `cdr' of X."(car(car(cdrx))))(defuncadar(x)"Return the `car' of the `cdr' of the `car' of X."(car(cdr(carx))))(defuncaddr(x)"Return the `car' of the `cdr' of the `cdr' of X."(car(cdr(cdrx))))(defuncdaar(x)"Return the `cdr' of the `car' of the `car' of X."(cdr(car(carx))))(defuncdadr(x)"Return the `cdr' of the `car' of the `cdr' of X."(cdr(car(cdrx))))(defuncddar(x)"Return the `cdr' of the `cdr' of the `car' of X."(cdr(cdr(carx))))(defuncdddr(x)"Return the `cdr' of the `cdr' of the `cdr' of X."(cdr(cdr(cdrx))))(defuncaaaar(x)"Return the `car' of the `car' of the `car' of the `car' of X."(car(car(car(carx)))))(defuncaaadr(x)"Return the `car' of the `car' of the `car' of the `cdr' of X."(car(car(car(cdrx)))))(defuncaadar(x)"Return the `car' of the `car' of the `cdr' of the `car' of X."(car(car(cdr(carx)))))(defuncaaddr(x)"Return the `car' of the `car' of the `cdr' of the `cdr' of X."(car(car(cdr(cdrx)))))(defuncadaar(x)"Return the `car' of the `cdr' of the `car' of the `car' of X."(car(cdr(car(carx)))))(defuncadadr(x)"Return the `car' of the `cdr' of the `car' of the `cdr' of X."(car(cdr(car(cdrx)))))(defuncaddar(x)"Return the `car' of the `cdr' of the `cdr' of the `car' of X."(car(cdr(cdr(carx)))))(defuncadddr(x)"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."(car(cdr(cdr(cdrx)))))(defuncdaaar(x)"Return the `cdr' of the `car' of the `car' of the `car' of X."(cdr(car(car(carx)))))(defuncdaadr(x)"Return the `cdr' of the `car' of the `car' of the `cdr' of X."(cdr(car(car(cdrx)))))(defuncdadar(x)"Return the `cdr' of the `car' of the `cdr' of the `car' of X."(cdr(car(cdr(carx)))))(defuncdaddr(x)"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."(cdr(car(cdr(cdrx)))))(defuncddaar(x)"Return the `cdr' of the `cdr' of the `car' of the `car' of X."(cdr(cdr(car(carx)))))(defuncddadr(x)"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."(cdr(cdr(car(cdrx)))))(defuncdddar(x)"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."(cdr(cdr(cdr(carx)))))(defuncddddr(x)"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."(cdr(cdr(cdr(cdrx)))));;; `last' is implemented as a C primitive, as of 1998-11;(defun last (x &optional n); "Return the last link in the list LIST.;With optional argument N, return Nth-to-last link (default 1)."; (if n; (let ((m 0) (p x)); (while (consp p) (incf m) (pop p)); (if (<= n 0) p; (if (< n m) (nthcdr (- m n) x) x))); (while (consp (cdr x)) (pop x)); x));;; `butlast' is implemented as a C primitive, as of 1998-11;;; `nbutlast' is implemented as a C primitive, as of 1998-11;(defun butlast (x &optional n); "Return a copy of LIST with the last N elements removed."; (if (and n (<= n 0)) x; (nbutlast (copy-sequence x) n)));(defun nbutlast (x &optional n); "Modify LIST to remove the last N elements."; (let ((m (length x))); (or n (setq n 1)); (and (< n m); (progn; (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)); x))))(defunlist*(arg&restrest); See compiler macro in cl-macs.el"Return a new list with specified args as elements, cons'd to last arg.Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to`(cons A (cons B (cons C D)))'."(cond((notrest)arg)((not(cdrrest))(consarg(carrest)))(t(let*((n(lengthrest))(copy(copy-sequencerest))(last(nthcdr(-n2)copy)))(setcdrlast(car(cdrlast)))(consargcopy)))))(defunldiff(listsublist)"Return a copy of LIST with the tail SUBLIST removed."(let((resnil))(while(and(consplist)(not(eqlistsublist)))(push(poplist)res))(nreverseres)));;; `copy-list' is implemented as a C primitive, as of 1998-11;(defun copy-list (list); "Return a copy of a list, which may be a dotted list.;The elements of the list are not copied, just the list structure itself."; (if (consp list); (let ((res nil)); (while (consp list) (push (pop list) res)); (prog1 (nreverse res) (setcdr res list))); (car list)))(defuncl-maclisp-member(itemlist)(while(andlist(not(equalitem(carlist))))(setqlist(cdrlist)))list);;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users.(or(and(fboundp'member)(subrp(symbol-function'member)))(defalias'member'cl-maclisp-member))(defalias'cl-member'memq); for compatibility with old CL package(defalias'cl-floor'floor*)(defalias'cl-ceiling'ceiling*)(defalias'cl-truncate'truncate*)(defalias'cl-round'round*)(defalias'cl-mod'mod*)(defunadjoin(cl-itemcl-list&restcl-keys); See compiler macro in cl-macs"Return ITEM consed onto the front of LIST only if it's not already there.Otherwise, return LIST unmodified.Keywords supported: :test :test-not :key"(cond((or(equalcl-keys'(:testeq))(and(nullcl-keys)(not(numberpcl-item))))(if(memqcl-itemcl-list)cl-list(conscl-itemcl-list)))((or(equalcl-keys'(:testequal))(nullcl-keys))(if(membercl-itemcl-list)cl-list(conscl-itemcl-list)))(t(apply'cl-adjoincl-itemcl-listcl-keys))))(defunsubst(cl-newcl-oldcl-tree&restcl-keys)"Substitute NEW for OLD everywhere in TREE (non-destructively).Return a copy of TREE with all elements `eql' to OLD replaced by NEW.Keywords supported: :test :test-not :key"(if(orcl-keys(and(numberpcl-old)(not(integerpcl-old))))(apply'sublis(list(conscl-oldcl-new))cl-treecl-keys)(cl-do-substcl-newcl-oldcl-tree)))(defuncl-do-subst(cl-newcl-oldcl-tree)(cond((eqcl-treecl-old)cl-new)((conspcl-tree)(let((a(cl-do-substcl-newcl-old(carcl-tree)))(d(cl-do-substcl-newcl-old(cdrcl-tree))))(if(and(eqa(carcl-tree))(eqd(cdrcl-tree)))cl-tree(consad))))(tcl-tree)))(defunacons(abc)"Return a new alist created by adding (KEY . VALUE) to ALIST."(cons(consab)c))(defunpairlis(ab&optionalc)(nconc(mapcar*'consab)c));;; Miscellaneous.;; XEmacs change(define-error'cl-assertion-failed"Assertion failed");;; This is defined in Emacs 19; define it here for Emacs 18 users.(defuncl-add-hook(hookfunc&optionalappend)"Add to hook variable HOOK the function FUNC.FUNC is not added if it already appears on the list stored in HOOK."(let((old(and(boundphook)(symbol-valuehook))))(and(listpold)(not(eq(carold)'lambda))(setqold(listold)))(and(not(memberfuncold))(sethook(ifappend(nconcold(listfunc))(consfuncold))))))(or(fboundp'add-hook)(defalias'add-hook'cl-add-hook));; XEmacs change;(load "cl-defs");;; Define data for indentation and edebug.(mapcar#'(lambda(entry)(mapcar#'(lambda(func)(putfunc'lisp-indent-function(nth1entry))(putfunc'lisp-indent-hook(nth1entry))(or(getfunc'edebug-form-spec)(putfunc'edebug-form-spec(nth2entry))))(carentry)))'(((defun*defmacro*)defun)((function*)nil(&orsymbolp([&optional'macro]'lambda(&restsexp)&restform)))((eval-when)1(sexp&restform))((whenunless)1(&restform))((declare)nil(&restsexp))((the)1(sexp&restform))((caseecasetypecaseetypecase)1(form&rest(sexp&restform)))((blockreturn-from)1(sexp&restform))((return)nil(&optionalform))((dodo*)2((&rest&orsymbolp(symbolp&optionalformform))(form&restform)&restform))((dolistdotimes)1((symbolpform&restform)&restform))((do-symbols)1((symbolpform&optionalformform)&restform))((do-all-symbols)1((symbolpform&optionalform)&restform))((psetqsetfpsetf)niledebug-setq-form)((progv)2(&restform))((fletlabelsmacrolet)1((&rest(sexpsexp&restform))&restform))((symbol-macroletlexical-letlexical-let*)1((&rest&orsymbolp(symbolpform))&restform))((multiple-value-bind)2((&restsymbolp)&restform))((multiple-value-setq)1((&restsymbolp)&restform))((incfdecfremfpoppushpushnewshiftfrotatef)nil(&restform))((letfletf*)1((&rest(&restform))&restform))((callfdestructuring-bind)2(sexpform&restform))((callf2)3(sexpformform&restform))((loop)defun(&rest&orsymbolpform))((ignore-errors)0(&restform))));;; This goes here so that cl-macs can find it if it loads right now.(provide'cl-19); usage: (require 'cl-19 "cl");;; Things to do after byte-compiler is loaded.;;; As a side effect, we cause cl-macs to be loaded when compiling, so;;; that the compiler-macros defined there will be present.(defvarcl-hacked-flagnil)(defuncl-hack-byte-compiler()(if(and(notcl-hacked-flag)(fboundp'byte-compile-file-form))(progn(when(not(fboundp'cl-compile-time-init))(load"cl-macs"nilt))(cl-compile-time-init); in cl-macs.el(setqcl-hacked-flagt))));;; Try it now in case the compiler has already been loaded.(cl-hack-byte-compiler);;; Also make a hook in case compiler is loaded after this file.;;; The compiler doesn't call any hooks when it loads or runs, but;;; we can take advantage of the fact that emacs-lisp-mode will be;;; called when the compiler reads in the file to be compiled.;;; BUG: If the first compilation is `byte-compile' rather than;;; `byte-compile-file', we lose. Oh, well.(add-hook'emacs-lisp-mode-hook'cl-hack-byte-compiler);;; The following ensures that packages which expect the old-style cl.el;;; will be happy with this one.(provide'cl)(provide'mini-cl); for Epoch(run-hooks'cl-load-hook);;; cl.el ends here