Commit bb3faf5b authored by Stefan Monnier's avatar Stefan Monnier

Use lexical-binding for all of CL, and clean up its namespace.

* lisp/emacs-lisp/cl-lib.el: Use lexical-binding.
(cl-map-extents, cl-maclisp-member): Remove.
(cl--set-elt, cl--set-nthcdr, cl--set-buffer-substring)
(cl--set-substring, cl--block-wrapper, cl--block-throw)
(cl--compiling-file, cl--mapcar-many, cl--do-subst): Use "cl--" prefix.
* lisp/emacs-lisp/cl-extra.el: Use lexical-binding.
(cl--mapcar-many, cl--map-keymap-recursively, cl--map-intervals)
(cl--map-overlays, cl--set-frame-visible-p, cl--progv-save)
(cl--progv-before, cl--progv-after, cl--finite-do, cl--set-getf)
(cl--do-remf, cl--do-prettyprint): Use "cl--" prefix.
* lisp/emacs-lisp/cl-seq.el: Use lexical-binding.
(cl--parsing-keywords, cl--check-key, cl--check-test-nokey)
(cl--check-test, cl--check-match): Use "cl--" prefix and backquotes.
(cl--alist, cl--sublis-rec, cl--nsublis-rec, cl--tree-equal-rec):
* lisp/emacs-lisp/cl-macs.el (cl--lambda-list-keywords): Use "cl--" prefix.
* lisp/edmacro.el (edmacro-mismatch): Simplify to remove dependence on
CL's internals.
parent 3017f87f
2012-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cl-lib.el: Use lexical-binding.
(cl-map-extents, cl-maclisp-member): Remove.
(cl--set-elt, cl--set-nthcdr, cl--set-buffer-substring)
(cl--set-substring, cl--block-wrapper, cl--block-throw)
(cl--compiling-file, cl--mapcar-many, cl--do-subst): Use "cl--" prefix.
* emacs-lisp/cl-extra.el: Use lexical-binding.
(cl--mapcar-many, cl--map-keymap-recursively, cl--map-intervals)
(cl--map-overlays, cl--set-frame-visible-p, cl--progv-save)
(cl--progv-before, cl--progv-after, cl--finite-do, cl--set-getf)
(cl--do-remf, cl--do-prettyprint): Use "cl--" prefix.
* emacs-lisp/cl-seq.el: Use lexical-binding.
(cl--parsing-keywords, cl--check-key, cl--check-test-nokey)
(cl--check-test, cl--check-match): Use "cl--" prefix and backquotes.
(cl--alist, cl--sublis-rec, cl--nsublis-rec, cl--tree-equal-rec):
* emacs-lisp/cl-macs.el (cl--lambda-list-keywords): Use "cl--" prefix.
* edmacro.el (edmacro-mismatch): Simplify to remove dependence on
CL's internals.
2012-06-11 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.2.6-pre.
......
......@@ -594,28 +594,19 @@ doubt, use whitespace."
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorted sequence.
\n(fn SEQ1 SEQ2 START1 END1 START2 END2)"
(let (cl-test cl-test-not cl-key cl-from-end)
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if cl-from-end
(progn
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
(cl-check-match (elt cl-seq1 (1- cl-end1))
(elt cl-seq2 (1- cl-end2))))
(setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
(1- cl-end1)))
(let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
(cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
(cl-check-match (if cl-p1 (car cl-p1)
(aref cl-seq1 cl-start1))
(if cl-p2 (car cl-p2)
(aref cl-seq2 cl-start2))))
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
cl-start1)))))
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
(cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
(eql (if cl-p1 (car cl-p1)
(aref cl-seq1 cl-start1))
(if cl-p2 (car cl-p2)
(aref cl-seq2 cl-start2))))
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
cl-start1)))
(defun edmacro-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
......
......@@ -1399,18 +1399,18 @@ extra args."
;; These aren't all aliases of subrs, so not trivial to
;; avoid hardwiring the list.
(not (memq func
'(cl-block-wrapper cl-block-throw
'(cl--block-wrapper cl--block-throw
multiple-value-call nth-value
copy-seq first second rest endp cl-member
;; These are included in generated code
;; that can't be called except at compile time
;; or unless cl is loaded anyway.
cl-defsubst-expand cl-struct-setf-expander
cl--defsubst-expand cl-struct-setf-expander
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
macroexpand cl-macroexpand-all
cl-compiling-file))))
cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
form)
......
;;; cl-extra.el --- Common Lisp features, part 2
;;; cl-extra.el --- Common Lisp features, part 2 -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc.
......@@ -88,7 +88,7 @@ strings case-insensitively."
;;; Control structures.
;;;###autoload
(defun cl-mapcar-many (cl-func cl-seqs)
(defun cl--mapcar-many (cl-func cl-seqs)
(if (cdr (cdr cl-seqs))
(let* ((cl-res nil)
(cl-n (apply 'min (mapcar 'length cl-seqs)))
......@@ -222,7 +222,7 @@ If so, return the true (non-nil) value returned by PREDICATE.
(not (apply 'cl-every cl-pred cl-seq cl-rest)))
;;;###autoload
(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
(or cl-base
(setq cl-base (copy-sequence [0])))
(map-keymap
......@@ -230,14 +230,14 @@ If so, return the true (non-nil) value returned by PREDICATE.
(lambda (cl-key cl-bind)
(aset cl-base (1- (length cl-base)) cl-key)
(if (keymapp cl-bind)
(cl-map-keymap-recursively
(cl--map-keymap-recursively
cl-func-rec cl-bind
(vconcat cl-base (list 0)))
(funcall cl-func-rec cl-base cl-bind))))
cl-map))
;;;###autoload
(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
(defun cl--map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
(or cl-what (setq cl-what (current-buffer)))
(if (bufferp cl-what)
(let (cl-mark cl-mark2 (cl-next t) cl-next2)
......@@ -265,7 +265,7 @@ If so, return the true (non-nil) value returned by PREDICATE.
(setq cl-start cl-next)))))
;;;###autoload
(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(or cl-buffer (setq cl-buffer (current-buffer)))
(if (fboundp 'overlay-lists)
......@@ -307,30 +307,30 @@ If so, return the true (non-nil) value returned by PREDICATE.
;;; Support for `cl-setf'.
;;;###autoload
(defun cl-set-frame-visible-p (frame val)
(defun cl--set-frame-visible-p (frame val)
(cond ((null val) (make-frame-invisible frame))
((eq val 'icon) (iconify-frame frame))
(t (make-frame-visible frame)))
val)
;;; Support for `cl-progv'.
(defvar cl-progv-save)
(defvar cl--progv-save)
;;;###autoload
(defun cl-progv-before (syms values)
(defun cl--progv-before (syms values)
(while syms
(push (if (boundp (car syms))
(cons (car syms) (symbol-value (car syms)))
(car syms)) cl-progv-save)
(car syms)) cl--progv-save)
(if values
(set (pop syms) (pop values))
(makunbound (pop syms)))))
(defun cl-progv-after ()
(while cl-progv-save
(if (consp (car cl-progv-save))
(set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
(makunbound (car cl-progv-save)))
(pop cl-progv-save)))
(defun cl--progv-after ()
(while cl--progv-save
(if (consp (car cl--progv-save))
(set (car (car cl--progv-save)) (cdr (car cl--progv-save)))
(makunbound (car cl--progv-save)))
(pop cl--progv-save)))
;;; Numbers.
......@@ -469,8 +469,8 @@ If STATE is t, return a new state object seeded from the time of day."
;; Implementation limits.
(defun cl-finite-do (func a b)
(condition-case err
(defun cl--finite-do (func a b)
(condition-case _
(let ((res (funcall func a b))) ; check for IEEE infinity
(and (numberp res) (/= res (/ res 2)) res))
(arith-error nil)))
......@@ -485,25 +485,25 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
(or cl-most-positive-float (not (numberp '2e1))
(let ((x '2e0) y z)
;; Find maximum exponent (first two loops are optimizations)
(while (cl-finite-do '* x x) (setq x (* x x)))
(while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
(while (cl-finite-do '+ x x) (setq x (+ x x)))
(while (cl--finite-do '* x x) (setq x (* x x)))
(while (cl--finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
(while (cl--finite-do '+ x x) (setq x (+ x x)))
(setq z x y (/ x 2))
;; Now cl-fill in 1's in the mantissa.
(while (and (cl-finite-do '+ x y) (/= (+ x y) x))
(while (and (cl--finite-do '+ x y) (/= (+ x y) x))
(setq x (+ x y) y (/ y 2)))
(setq cl-most-positive-float x
cl-most-negative-float (- x))
;; Divide down until mantissa starts rounding.
(setq x (/ x z) y (/ 16 z) x (* x y))
(while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
(while (condition-case _ (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
(arith-error nil))
(setq x (/ x 2) y (/ y 2)))
(setq cl-least-positive-normalized-float y
cl-least-negative-normalized-float (- y))
;; Divide down until value underflows to zero.
(setq x (/ 1 z) y x)
(while (condition-case err (> (/ x 2) 0) (arith-error nil))
(while (condition-case _ (> (/ x 2) 0) (arith-error nil))
(setq x (/ x 2)))
(setq cl-least-positive-float x
cl-least-negative-float (- x))
......@@ -612,13 +612,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(if plist (car (cdr plist)) def))))
;;;###autoload
(defun cl-set-getf (plist tag val)
(defun cl--set-getf (plist tag val)
(let ((p plist))
(while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
(if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist))))
;;;###autoload
(defun cl-do-remf (plist tag)
(defun cl--do-remf (plist tag)
(let ((p (cdr plist)))
(while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
(and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
......@@ -630,7 +630,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(let ((plist (symbol-plist sym)))
(if (and plist (eq tag (car plist)))
(progn (setplist sym (cdr (cdr plist))) t)
(cl-do-remf plist tag))))
(cl--do-remf plist tag))))
;;; Some debugging aids.
......@@ -646,15 +646,15 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(forward-sexp)
(delete-char 1))
(goto-char (1+ pt))
(cl-do-prettyprint)))
(cl--do-prettyprint)))
(defun cl-do-prettyprint ()
(defun cl--do-prettyprint ()
(skip-chars-forward " ")
(if (looking-at "(")
(let ((skip (or (looking-at "((") (looking-at "(prog")
(looking-at "(unwind-protect ")
(looking-at "(function (")
(looking-at "(cl-block-wrapper ")))
(looking-at "(cl--block-wrapper ")))
(two (or (looking-at "(defun ") (looking-at "(defmacro ")))
(let (or (looking-at "(let\\*? ") (looking-at "(while ")))
(set (looking-at "(p?set[qf] ")))
......@@ -664,21 +664,21 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(and (>= (current-column) 78) (progn (backward-sexp) t))))
(let ((nl t))
(forward-char 1)
(cl-do-prettyprint)
(or skip (looking-at ")") (cl-do-prettyprint))
(or (not two) (looking-at ")") (cl-do-prettyprint))
(cl--do-prettyprint)
(or skip (looking-at ")") (cl--do-prettyprint))
(or (not two) (looking-at ")") (cl--do-prettyprint))
(while (not (looking-at ")"))
(if set (setq nl (not nl)))
(if nl (insert "\n"))
(lisp-indent-line)
(cl-do-prettyprint))
(cl--do-prettyprint))
(forward-char 1))))
(forward-sexp)))
;;;###autoload
(defun cl-prettyexpand (form &optional full)
(message "Expanding...")
(let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
(let ((cl--compiling-file full)
(byte-compile-macro-environment nil))
(setq form (macroexpand-all form
(and (not full) '((cl-block) (cl-eval-when)))))
......
;;; cl-lib.el --- Common Lisp extensions for Emacs
;;; cl-lib.el --- Common Lisp extensions for Emacs -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
......@@ -114,7 +114,7 @@ a future Emacs interpreter will be able to use it.")
(defun cl-unload-function ()
"Stop unloading of the Common Lisp extensions."
(message "Cannot unload the feature `cl'")
;; stop standard unloading!
;; Stop standard unloading!
t)
;;; Generalized variables.
......@@ -185,19 +185,19 @@ an element already on the list.
(list 'setq place (cl-list* 'cl-adjoin x place keys)))
(cl-list* 'cl-callf2 'cl-adjoin x place keys)))
(defun cl-set-elt (seq n val)
(defun cl--set-elt (seq n val)
(if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
(defsubst cl-set-nthcdr (n list x)
(defsubst cl--set-nthcdr (n list x)
(if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
(defun cl-set-buffer-substring (start end val)
(defun cl--set-buffer-substring (start end val)
(save-excursion (delete-region start end)
(goto-char start)
(insert val)
val))
(defun cl-set-substring (str start end val)
(defun cl--set-substring (str start end val)
(if end (if (< end 0) (cl-incf end (length str)))
(setq end (length str)))
(if (< start 0) (cl-incf start (length str)))
......@@ -206,19 +206,10 @@ an element already on the list.
(and (< end (length str)) (substring str end))))
;;; Control structures.
;; These macros are so simple and so often-used that it's better to have
;; them all the time than to load them from cl-macs.el.
(defun cl-map-extents (&rest cl-args)
(apply 'cl-map-overlays cl-args))
;;; Blocks and exits.
(defalias 'cl-block-wrapper 'identity)
(defalias 'cl-block-throw 'throw)
(defalias 'cl--block-wrapper 'identity)
(defalias 'cl--block-throw 'throw)
;;; Multiple values.
......@@ -269,9 +260,9 @@ one value."
;;; Declarations.
(defvar cl-compiling-file nil)
(defun cl-compiling-file ()
(or cl-compiling-file
(defvar cl--compiling-file nil)
(defun cl--compiling-file ()
(or cl--compiling-file
(and (boundp 'byte-compile--outbuffer)
(bufferp (symbol-value 'byte-compile--outbuffer))
(equal (buffer-name (symbol-value 'byte-compile--outbuffer))
......@@ -287,7 +278,7 @@ one value."
(defmacro cl-declaim (&rest specs)
(let ((body (mapcar (function (lambda (x) (list 'cl-proclaim (list 'quote x))))
specs)))
(if (cl-compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body)
(if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body)
(cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when
......@@ -378,7 +369,7 @@ Call `cl-float-limits' to set this.")
(defalias 'cl-copy-seq 'copy-sequence)
(declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs))
(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
(defun cl-mapcar (cl-func cl-x &rest cl-rest)
"Apply FUNCTION to each element of SEQ, and make a list of the results.
......@@ -389,7 +380,7 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
\n(fn FUNCTION SEQ...)"
(if cl-rest
(if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
(cl-mapcar-many cl-func (cons cl-x cl-rest))
(cl--mapcar-many cl-func (cons cl-x cl-rest))
(let ((cl-res nil) (cl-y (car cl-rest)))
(while (and cl-x cl-y)
(push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
......@@ -575,10 +566,6 @@ The elements of LIST are not copied, just the list structure itself."
(prog1 (nreverse res) (setcdr res list)))
(car list)))
(defun cl-maclisp-member (item list)
(while (and list (not (equal item (car list)))) (setq list (cdr list)))
list)
;; Autoloaded, but we have not loaded cl-loaddefs yet.
(declare-function cl-floor "cl-extra" (x &optional y))
(declare-function cl-ceiling "cl-extra" (x &optional y))
......@@ -607,13 +594,13 @@ Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
(if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
(apply 'cl-sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
(cl-do-subst cl-new cl-old cl-tree)))
(cl--do-subst cl-new cl-old cl-tree)))
(defun cl-do-subst (cl-new cl-old cl-tree)
(defun cl--do-subst (cl-new cl-old cl-tree)
(cond ((eq cl-tree cl-old) cl-new)
((consp cl-tree)
(let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
(d (cl-do-subst cl-new cl-old (cdr cl-tree))))
(let ((a (cl--do-subst cl-new cl-old (car cl-tree)))
(d (cl--do-subst cl-new cl-old (cdr cl-tree))))
(if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
cl-tree (cons a d))))
(t cl-tree)))
......
......@@ -3,15 +3,15 @@
;;; Code:
;;;### (autoloads (cl-prettyexpand cl-remprop cl-do-remf cl-set-getf
;;;### (autoloads (cl-prettyexpand cl-remprop cl--do-remf cl--set-getf
;;;;;; cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend
;;;;;; cl-concatenate cl-subseq cl-float-limits cl-random-state-p
;;;;;; cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round
;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl-progv-before
;;;;;; cl-set-frame-visible-p cl-map-overlays cl-map-intervals cl-map-keymap-recursively
;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
;;;;;; cl-mapl cl-maplist cl-map cl-mapcar-many cl-equalp cl-coerce)
;;;;;; "cl-extra" "cl-extra.el" "6661c504c379dfde0c37a0f8e2ba6568")
;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--progv-before
;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals
;;;;;; cl--map-keymap-recursively cl-notevery cl-notany cl-every
;;;;;; cl-some cl-mapcon cl-mapcan cl-mapl cl-maplist cl-map cl--mapcar-many
;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "1f486111e93d119ceb6e95c434e3fd4b")
;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\
......@@ -28,7 +28,7 @@ strings case-insensitively.
\(fn X Y)" nil nil)
(autoload 'cl-mapcar-many "cl-extra" "\
(autoload 'cl--mapcar-many "cl-extra" "\
\(fn CL-FUNC CL-SEQS)" nil nil)
......@@ -82,27 +82,27 @@ Return true if PREDICATE is false of some element of SEQ or SEQs.
\(fn PREDICATE SEQ...)" nil nil)
(autoload 'cl-map-keymap-recursively "cl-extra" "\
(autoload 'cl--map-keymap-recursively "cl-extra" "\
\(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil)
(autoload 'cl-map-intervals "cl-extra" "\
(autoload 'cl--map-intervals "cl-extra" "\
\(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil)
(autoload 'cl-map-overlays "cl-extra" "\
(autoload 'cl--map-overlays "cl-extra" "\
\(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil)
(autoload 'cl-set-frame-visible-p "cl-extra" "\
(autoload 'cl--set-frame-visible-p "cl-extra" "\
\(fn FRAME VAL)" nil nil)
(autoload 'cl-progv-before "cl-extra" "\
(autoload 'cl--progv-before "cl-extra" "\
\(fn SYMS VALUES)" nil nil)
......@@ -232,12 +232,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
\(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil)
(autoload 'cl-set-getf "cl-extra" "\
(autoload 'cl--set-getf "cl-extra" "\
\(fn PLIST TAG VAL)" nil nil)
(autoload 'cl-do-remf "cl-extra" "\
(autoload 'cl--do-remf "cl-extra" "\
\(fn PLIST TAG)" nil nil)
......@@ -265,7 +265,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9eb287dd2a8d20f1c6459a9d095fa335")
;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "a8ede90b4a2ce9015d4b63254b4678a2")
;;; Generated autoloads from cl-macs.el
(autoload 'cl-gensym "cl-macs" "\
......@@ -791,7 +791,7 @@ surrounded by (cl-block NAME ...).
;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if
;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not
;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove
;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "8877479cb008b43a94098f3e6ec85d91")
;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "b444601641dcbd14a23ca5182bc80ffa")
;;; Generated autoloads from cl-seq.el
(autoload 'cl-reduce "cl-seq" "\
......
This diff is collapsed.
This diff is collapsed.
......@@ -337,6 +337,7 @@ The two cases that are handled are:
- closure-conversion of lambda expressions for `lexical-let'.
- renaming of F when it's a function defined via `cl-labels' or `labels'."
(require 'cl-macs)
(declare-function cl--expr-contains-any "cl-macs" (x y))
(cond
;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
;; *after* handling `function', but we want to stop macroexpansion from
......@@ -460,7 +461,7 @@ go back to their previous definitions, or lack thereof).
(let ((func `(cl-function
(lambda ,(cadr x)
(cl-block ,(car x) ,@(cddr x))))))
(when (cl-compiling-file)
(when (cl--compiling-file)
;; Bug#411. It would be nice to fix this.
(and (get (car x) 'byte-compile)
(error "Byte-compiling a redefinition of `%s' \
......@@ -532,6 +533,11 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard.
(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.2")
(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.2")
(defun cl-maclisp-member (item list)
(declare (obsolete member "24.2"))
(while (and list (not (equal item (car list)))) (setq list (cdr list)))
list)
;; FIXME: More candidates: define-modify-macro, define-setf-expander.
(provide 'cl)
......
......@@ -510,7 +510,7 @@ suitable file is found, return nil."
(unless (looking-back "\n\n")
(terpri)))))
;; Note that list* etc do not get this property until
;; cl-hack-byte-compiler runs, after bytecomp is loaded.
;; cl--hack-byte-compiler runs, after bytecomp is loaded.
(when (and (symbolp function)
(eq (get function 'byte-compile)
'cl-byte-compile-compiler-macro))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment