[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108560: Use lexical-binding for a
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/emacs-24 r108560: Use lexical-binding for all of CL, and clean up its namespace. |
|
Date: |
Fri, 02 Nov 2012 02:19:08 -0000 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 108560
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2012-06-11 11:52:50 -0400
message:
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.
modified:
lisp/ChangeLog
lisp/edmacro.el
lisp/emacs-lisp/bytecomp.el
lisp/emacs-lisp/cl-extra.el
lisp/emacs-lisp/cl-lib.el
lisp/emacs-lisp/cl-loaddefs.el
lisp/emacs-lisp/cl-macs.el
lisp/emacs-lisp/cl-seq.el
lisp/emacs-lisp/cl.el
lisp/help-fns.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-06-11 10:30:07 +0000
+++ b/lisp/ChangeLog 2012-06-11 15:52:50 +0000
@@ -1,3 +1,23 @@
+2012-06-11 Stefan Monnier <address@hidden>
+
+ * 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 <address@hidden>
Sync with Tramp 2.2.6-pre.
=== modified file 'lisp/edmacro.el'
--- a/lisp/edmacro.el 2012-01-19 07:21:25 +0000
+++ b/lisp/edmacro.el 2012-06-11 15:52:50 +0000
@@ -594,28 +594,19 @@
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.
=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el 2012-06-10 13:28:26 +0000
+++ b/lisp/emacs-lisp/bytecomp.el 2012-06-11 15:52:50 +0000
@@ -1399,18 +1399,18 @@
;; 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)
=== modified file 'lisp/emacs-lisp/cl-extra.el'
--- a/lisp/emacs-lisp/cl-extra.el 2012-06-09 02:26:47 +0000
+++ b/lisp/emacs-lisp/cl-extra.el 2012-06-11 15:52:50 +0000
@@ -1,4 +1,4 @@
-;;; 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 @@
;;; 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 @@
(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 @@
(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 @@
(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 @@
;;; 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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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)))))
=== modified file 'lisp/emacs-lisp/cl-lib.el'
--- a/lisp/emacs-lisp/cl-lib.el 2012-06-10 13:28:26 +0000
+++ b/lisp/emacs-lisp/cl-lib.el 2012-06-11 15:52:50 +0000
@@ -1,4 +1,4 @@
-;;; 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 @@
(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 @@
(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 @@
(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 @@
;;; 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 @@
(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 @@
(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 @@
\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 @@
(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 @@
\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)))
=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el 2012-06-09 02:26:47 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el 2012-06-11 15:52:50 +0000
@@ -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 @@
\(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 @@
\(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 @@
\(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 @@
;;;;;; 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 @@
;;;;;; 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" "\
=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el 2012-06-09 02:26:47 +0000
+++ b/lisp/emacs-lisp/cl-macs.el 2012-06-11 15:52:50 +0000
@@ -203,6 +203,65 @@
(def-edebug-spec cl-&key-arg
(&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
+(defconst cl--lambda-list-keywords
+ '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
+
+(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
+(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
+
+(defun cl--transform-lambda (form bind-block)
+ (let* ((args (car form)) (body (cdr form)) (orig-args args)
+ (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
+ (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
+ (header nil) (simple-args nil))
+ (while (or (stringp (car body))
+ (memq (car-safe (car body)) '(interactive cl-declare)))
+ (push (pop body) header))
+ (setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
+ (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
+ (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
+ (setq args (delq '&cl-defs (delq cl--bind-defs args))
+ cl--bind-defs (cadr cl--bind-defs)))
+ (if (setq cl--bind-enquote (memq '&cl-quote args))
+ (setq args (delq '&cl-quote args)))
+ (if (memq '&whole args) (error "&whole not currently implemented"))
+ (let* ((p (memq '&environment args)) (v (cadr p))
+ (env-exp 'macroexpand-all-environment))
+ (if p (setq args (nconc (delq (car p) (delq v args))
+ (list '&aux (list v env-exp))))))
+ (while (and args (symbolp (car args))
+ (not (memq (car args) '(nil &rest &body &key &aux)))
+ (not (and (eq (car args) '&optional)
+ (or cl--bind-defs (consp (cadr args))))))
+ (push (pop args) simple-args))
+ (or (eq cl--bind-block 'cl-none)
+ (setq body (list `(cl-block ,cl--bind-block ,@body))))
+ (if (null args)
+ (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
+ (if (memq '&optional simple-args) (push '&optional args))
+ (cl--do-arglist args nil (- (length simple-args)
+ (if (memq '&optional simple-args) 1 0)))
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
+ ,@(nreverse cl--bind-inits)))
+ (nconc (nreverse simple-args)
+ (list '&rest (car (pop cl--bind-lets))))
+ (nconc (let ((hdr (nreverse header)))
+ ;; Macro expansion can take place in the middle of
+ ;; apparently harmless computation, so it should not
+ ;; touch the match-data.
+ (save-match-data
+ (require 'help-fns)
+ (cons (help-add-fundoc-usage
+ (if (stringp (car hdr)) (pop hdr))
+ (format "%S"
+ (cons 'fn
+ (cl--make-usage-args orig-args))))
+ hdr)))
+ (list `(let* ,cl--bind-lets
+ ,@(nreverse cl--bind-forms)
+ ,@body)))))))
+
;;;###autoload
(defmacro cl-defun (name args &rest body)
"Define NAME as a function.
@@ -307,12 +366,6 @@
`(progn ,@(cdr (cdr (car res)))
(put ',func ',prop #'(lambda . ,(cdr res))))))
-(defconst cl-lambda-list-keywords
- '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-
-(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
-(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
-
(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
(defun cl--make-usage-var (x)
@@ -346,62 +399,9 @@
))))
arglist)))
-(defun cl--transform-lambda (form bind-block)
- (let* ((args (car form)) (body (cdr form)) (orig-args args)
- (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
- (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
- (header nil) (simple-args nil))
- (while (or (stringp (car body))
- (memq (car-safe (car body)) '(interactive cl-declare)))
- (push (pop body) header))
- (setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
- (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
- (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
- (setq args (delq '&cl-defs (delq cl--bind-defs args))
- cl--bind-defs (cadr cl--bind-defs)))
- (if (setq cl--bind-enquote (memq '&cl-quote args))
- (setq args (delq '&cl-quote args)))
- (if (memq '&whole args) (error "&whole not currently implemented"))
- (let* ((p (memq '&environment args)) (v (cadr p))
- (env-exp 'macroexpand-all-environment))
- (if p (setq args (nconc (delq (car p) (delq v args))
- (list '&aux (list v env-exp))))))
- (while (and args (symbolp (car args))
- (not (memq (car args) '(nil &rest &body &key &aux)))
- (not (and (eq (car args) '&optional)
- (or cl--bind-defs (consp (cadr args))))))
- (push (pop args) simple-args))
- (or (eq cl--bind-block 'cl-none)
- (setq body (list `(cl-block ,cl--bind-block ,@body))))
- (if (null args)
- (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
- (if (memq '&optional simple-args) (push '&optional args))
- (cl--do-arglist args nil (- (length simple-args)
- (if (memq '&optional simple-args) 1 0)))
- (setq cl--bind-lets (nreverse cl--bind-lets))
- (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
- ,@(nreverse cl--bind-inits)))
- (nconc (nreverse simple-args)
- (list '&rest (car (pop cl--bind-lets))))
- (nconc (let ((hdr (nreverse header)))
- ;; Macro expansion can take place in the middle of
- ;; apparently harmless computation, so it should not
- ;; touch the match-data.
- (save-match-data
- (require 'help-fns)
- (cons (help-add-fundoc-usage
- (if (stringp (car hdr)) (pop hdr))
- (format "%S"
- (cons 'fn
- (cl--make-usage-args orig-args))))
- hdr)))
- (list `(let* ,cl--bind-lets
- ,@(nreverse cl--bind-forms)
- ,@body)))))))
-
(defun cl--do-arglist (args expr &optional num) ; uses bind-*
(if (nlistp args)
- (if (or (memq args cl-lambda-list-keywords) (not (symbolp args)))
+ (if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
(error "Invalid argument name: %s" args)
(push (list args expr) cl--bind-lets))
(setq args (cl-copy-list args))
@@ -410,7 +410,7 @@
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((save-args args)
(restarg (memq '&rest args))
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(keys nil)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
@@ -422,14 +422,14 @@
(push (list (cl-pop2 args) restarg) cl--bind-lets))
(let ((p args))
(setq minarg restarg)
- (while (and p (not (memq (car p) cl-lambda-list-keywords)))
+ (while (and p (not (memq (car p) cl--lambda-list-keywords)))
(or (eq p args) (setq minarg (list 'cdr minarg)))
(setq p (cdr p)))
(if (memq (car p) '(nil &aux))
(setq minarg `(= (length ,restarg)
,(length (cl-ldiff args p)))
exactarg (not (eq args p)))))
- (while (and args (not (memq (car args) cl-lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
restarg)))
(cl--do-arglist
@@ -442,7 +442,7 @@
(length ,restarg)))))))
(setq num (1+ num) laterarg t))
(while (and (eq (car args) '&optional) (pop args))
- (while (and args (not (memq (car args) cl-lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(if (cddr arg) (cl--do-arglist (nth 2 arg) `(and ,restarg t)))
@@ -466,7 +466,7 @@
(+ ,num (length ,restarg)))))
cl--bind-forms)))
(while (and (eq (car args) '&key) (pop args))
- (while (and args (not (memq (car args) cl-lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
(let* ((karg (if (consp (car arg)) (caar arg)
@@ -511,7 +511,7 @@
(car ,var)))))))
(push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
(while (and (eq (car args) '&aux) (pop args))
- (while (and args (not (memq (car args) cl-lambda-list-keywords)))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
(if (consp (car args))
(if (and cl--bind-enquote (cl-cadar args))
(cl--do-arglist (caar args)
@@ -525,7 +525,7 @@
(let ((res nil) (kind nil) arg)
(while (consp args)
(setq arg (pop args))
- (if (memq arg cl-lambda-list-keywords) (setq kind arg)
+ (if (memq arg cl--lambda-list-keywords) (setq kind arg)
(if (eq arg '&cl-defs) (pop args)
(and (consp arg) kind (setq arg (car arg)))
(and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
@@ -557,7 +557,7 @@
\(fn (WHEN...) BODY...)"
(declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
- (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
+ (if (and (fboundp 'cl--compiling-file) (cl--compiling-file)
(not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge
(let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
(cl-not-toplevel t))
@@ -586,7 +586,7 @@
"Like `progn', but evaluates the body at load time.
The result of the body appears to the compiler as a quoted constant."
(declare (debug (form &optional sexp)))
- (if (cl-compiling-file)
+ (if (cl--compiling-file)
(let* ((temp (cl-gentemp "--cl-load-time--"))
(set `(set ',temp ,form)))
(if (and (fboundp 'byte-compile-file-form-defmumble)
@@ -700,7 +700,7 @@
called from BODY."
(declare (indent 1) (debug (symbolp body)))
(if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body)
- `(cl-block-wrapper
+ `(cl--block-wrapper
(catch ',(intern (format "--cl-block-%s--" name))
,@body))))
@@ -720,7 +720,7 @@
`defmacro' do not create implicit blocks as they do in Common Lisp."
(declare (indent 1) (debug (symbolp &optional form)))
(let ((name2 (intern (format "--cl-block-%s--" name))))
- `(cl-block-throw ',name2 ,result)))
+ `(cl--block-throw ',name2 ,result)))
;;; The "cl-loop" macro.
@@ -1151,7 +1151,7 @@
((eq (car cl--loop-args) 'to) (setq to (cl-pop2
cl--loop-args)))
(t (setq buf (cl-pop2 cl--loop-args)))))
(setq cl--loop-map-form
- `(cl-map-extents
+ `(cl--map-overlays
(lambda (,var ,(make-symbol "--cl-var--"))
(progn . --cl-map) nil)
,buf ,from ,to))))
@@ -1170,7 +1170,7 @@
(setq var1 (car var) var2 (cdr var))
(push (list var `(cons ,var1 ,var2)) loop-for-sets))
(setq cl--loop-map-form
- `(cl-map-intervals
+ `(cl--map-intervals
(lambda (,var1 ,var2) . --cl-map)
,buf ,prop ,from ,to))))
@@ -1188,7 +1188,7 @@
(setq var (prog1 other (setq other var))))
(setq cl--loop-map-form
`(,(if (memq word '(key-seq key-seqs))
- 'cl-map-keymap-recursively 'map-keymap)
+ 'cl--map-keymap-recursively 'map-keymap)
(lambda (,var ,other) . --cl-map) ,cl-map))))
((memq word '(frame frames screen screens))
@@ -1606,10 +1606,10 @@
BODY forms are executed and their result is returned. This is much like
a `let' form, except that the list of symbols can be computed at run-time."
(declare (indent 2) (debug (form form body)))
- `(let ((cl-progv-save nil))
+ `(let ((cl--progv-save nil))
(unwind-protect
- (progn (cl-progv-before ,symbols ,values) ,@body)
- (cl-progv-after))))
+ (progn (cl--progv-before ,symbols ,values) ,@body)
+ (cl--progv-after))))
(defvar cl--labels-convert-cache nil)
@@ -1868,7 +1868,7 @@
will turn off byte-compile warnings in the function.
See Info node `(cl)Declarations' for details."
- (if (cl-compiling-file)
+ (if (cl--compiling-file)
(while specs
(if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
(cl-do-proclaim (pop specs) nil)))
@@ -2028,7 +2028,7 @@
(cl-defsetf buffer-name rename-buffer t)
(cl-defsetf buffer-string () (store)
`(progn (erase-buffer) (insert ,store)))
-(cl-defsetf buffer-substring cl-set-buffer-substring)
+(cl-defsetf buffer-substring cl--set-buffer-substring)
(cl-defsetf current-buffer set-buffer)
(cl-defsetf current-case-table set-case-table)
(cl-defsetf current-column move-to-column t)
@@ -2050,7 +2050,7 @@
(cl-defsetf file-modes set-file-modes t)
(cl-defsetf frame-height set-screen-height t)
(cl-defsetf frame-parameters modify-frame-parameters t)
-(cl-defsetf frame-visible-p cl-set-frame-visible-p)
+(cl-defsetf frame-visible-p cl--set-frame-visible-p)
(cl-defsetf frame-width set-screen-width t)
(cl-defsetf frame-parameter set-frame-parameter t)
(cl-defsetf terminal-parameter set-terminal-parameter)
@@ -2151,8 +2151,8 @@
(cons n (nth 1 method))
(list store-temp)
`(let ((,(car (nth 2 method))
- (cl-set-nthcdr ,n-temp ,(nth 4 method)
- ,store-temp)))
+ (cl--set-nthcdr ,n-temp ,(nth 4 method)
+ ,store-temp)))
,(nth 3 method) ,store-temp)
`(nthcdr ,n-temp ,(nth 4 method)))))
@@ -2165,7 +2165,7 @@
(append (nth 1 method) (list tag def))
(list store-temp)
`(let ((,(car (nth 2 method))
- (cl-set-getf ,(nth 4 method) ,tag-temp ,store-temp)))
+ (cl--set-getf ,(nth 4 method) ,tag-temp ,store-temp)))
,(nth 3 method) ,store-temp)
`(cl-getf ,(nth 4 method) ,tag-temp ,def-temp))))
@@ -2178,8 +2178,8 @@
(append (nth 1 method) (list from to))
(list store-temp)
`(let ((,(car (nth 2 method))
- (cl-set-substring ,(nth 4 method)
- ,from-temp ,to-temp ,store-temp)))
+ (cl--set-substring ,(nth 4 method)
+ ,from-temp ,to-temp ,store-temp)))
,(nth 3 method) ,store-temp)
`(substring ,(nth 4 method) ,from-temp ,to-temp))))
@@ -2325,7 +2325,7 @@
(if (eq ,ttag (car ,tval))
(progn ,(cl-setf-do-store (nth 1 method) `(cddr ,tval))
t)
- `(cl-do-remf ,tval ,ttag)))))
+ `(cl--do-remf ,tval ,ttag)))))
;;;###autoload
(defmacro cl-shiftf (place &rest args)
@@ -2549,7 +2549,7 @@
(copier (intern (format "copy-%s" name)))
(predicate (intern (format "%s-p" name)))
(print-func nil) (print-auto nil)
- (safety (if (cl-compiling-file) cl-optimize-safety 3))
+ (safety (if (cl--compiling-file) cl-optimize-safety 3))
(include nil)
(tag (intern (format "cl-struct-%s" name)))
(tag-symbol (intern (format "cl-struct-%s-tags" name)))
@@ -2835,7 +2835,7 @@
"Verify that FORM is of type TYPE; signal an error if not.
STRING is an optional description of the desired type."
(declare (debug (place cl-type-spec &optional stringp)))
- (and (or (not (cl-compiling-file))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let* ((temp (if (cl--simple-expr-p form 3)
form (make-symbol "--cl-var--")))
@@ -2854,7 +2854,7 @@
They are not evaluated unless the assertion fails. If STRING is
omitted, a default message listing FORM itself is used."
(declare (debug (form &rest form)))
- (and (or (not (cl-compiling-file))
+ (and (or (not (cl--compiling-file))
(< cl-optimize-speed 3) (= cl-optimize-safety 3))
(let ((sargs (and show-args
(delq nil (mapcar (lambda (x)
@@ -2919,7 +2919,7 @@
(defvar cl--active-block-names nil)
-(cl-define-compiler-macro cl-block-wrapper (cl-form)
+(cl-define-compiler-macro cl--block-wrapper (cl-form)
(let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
(cl--active-block-names (cons cl-entry cl--active-block-names))
(cl-body (macroexpand-all ;Performs compiler-macro expansions.
@@ -2931,7 +2931,7 @@
`(catch ,(nth 1 cl-form) ,@(cdr cl-body))
cl-body)))
-(cl-define-compiler-macro cl-block-throw (cl-tag cl-value)
+(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
(let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names)))
(if cl-found (setcdr cl-found t)))
`(throw ,cl-tag ,cl-value))
@@ -2955,7 +2955,7 @@
,(if (memq '&key args)
`(&whole cl-whole &cl-quote ,@args)
(cons '&cl-quote args))
- (cl-defsubst-expand
+ (cl--defsubst-expand
',argns '(cl-block ,name ,@body)
;; We used to pass `simple' as
;; (not (or unsafe (cl-expr-access-order pbody argns)))
@@ -2966,7 +2966,7 @@
,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
(cl-defun ,name ,args ,@body))))
-(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
+(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs)
(if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
(if (cl--simple-exprs-p argvs) (setq simple t))
(let* ((substs ())
@@ -3059,7 +3059,7 @@
;;; Things that are inline.
(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany
cl-notevery
- cl-set-elt cl-revappend cl-nreconc gethash))
+ cl--set-elt cl-revappend cl-nreconc gethash))
;;; Things that are side-effect-free.
(mapc (lambda (x) (put x 'side-effect-free t))
=== modified file 'lisp/emacs-lisp/cl-seq.el'
--- a/lisp/emacs-lisp/cl-seq.el 2012-06-09 02:26:47 +0000
+++ b/lisp/emacs-lisp/cl-seq.el 2012-06-11 15:52:50 +0000
@@ -1,4 +1,4 @@
-;;; cl-seq.el --- Common Lisp features, part 3
+;;; cl-seq.el --- Common Lisp features, part 3 -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
@@ -43,99 +43,91 @@
(require 'cl-lib)
-;;; Keyword parsing. This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
+;; Keyword parsing.
+;; This is special-cased here so that we can compile
+;; this file independent from cl-macs.
-(defmacro cl-parsing-keywords (kwords other-keys &rest body)
+(defmacro cl--parsing-keywords (kwords other-keys &rest body)
(declare (indent 2) (debug (sexp sexp &rest form)))
- (cons
- 'let*
- (cons (mapcar
- (function
- (lambda (x)
- (let* ((var (if (consp x) (car x) x))
- (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
- 'cl-keys)))))
- (if (eq var :test-not)
- (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
- (if (eq var :if-not)
- (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
- (list (intern
- (format "cl-%s" (substring (symbol-name var) 1)))
- (if (consp x) (list 'or mem (car (cdr x))) mem)))))
- kwords)
- (append
- (and (not (eq other-keys t))
- (list
- (list 'let '((cl-keys-temp cl-keys))
- (list 'while 'cl-keys-temp
- (list 'or (list 'memq '(car cl-keys-temp)
- (list 'quote
- (mapcar
- (function
- (lambda (x)
- (if (consp x)
- (car x) x)))
- (append kwords
- other-keys))))
- '(car (cdr (memq (quote :allow-other-keys)
- cl-keys)))
- '(error "Bad keyword argument %s"
- (car cl-keys-temp)))
- '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
- body))))
-
-(defmacro cl-check-key (x)
- (declare (debug edebug-forms))
- (list 'if 'cl-key (list 'funcall 'cl-key x) x))
-
-(defmacro cl-check-test-nokey (item x)
- (declare (debug edebug-forms))
- (list 'cond
- (list 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test item x))
- 'cl-test-not))
- (list 'cl-if
- (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
- (list 't (list 'if (list 'numberp item)
- (list 'equal item x) (list 'eq item x)))))
-
-(defmacro cl-check-test (item x)
- (declare (debug edebug-forms))
- (list 'cl-check-test-nokey item (list 'cl-check-key x)))
-
-(defmacro cl-check-match (x y)
- (declare (debug edebug-forms))
- (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
- (list 'if 'cl-test
- (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
- (list 'if (list 'numberp x)
- (list 'equal x y) (list 'eq x y))))
+ `(let* ,(mapcar
+ (lambda (x)
+ (let* ((var (if (consp x) (car x) x))
+ (mem `(car (cdr (memq ',var cl-keys)))))
+ (if (eq var :test-not)
+ (setq mem `(and ,mem (setq cl-test ,mem) t)))
+ (if (eq var :if-not)
+ (setq mem `(and ,mem (setq cl-if ,mem) t)))
+ (list (intern
+ (format "cl-%s" (substring (symbol-name var) 1)))
+ (if (consp x) `(or ,mem ,(car (cdr x))) mem))))
+ kwords)
+ ,@(append
+ (and (not (eq other-keys t))
+ (list
+ (list 'let '((cl-keys-temp cl-keys))
+ (list 'while 'cl-keys-temp
+ (list 'or (list 'memq '(car cl-keys-temp)
+ (list 'quote
+ (mapcar
+ (function
+ (lambda (x)
+ (if (consp x)
+ (car x) x)))
+ (append kwords
+ other-keys))))
+ '(car (cdr (memq (quote :allow-other-keys)
+ cl-keys)))
+ '(error "Bad keyword argument %s"
+ (car cl-keys-temp)))
+ '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
+ body)))
+
+(defmacro cl--check-key (x) ;Expects `cl-key' in context of generated code.
+ (declare (debug edebug-forms))
+ `(if cl-key (funcall cl-key ,x) ,x))
+
+(defmacro cl--check-test-nokey (item x) ;cl-test cl-if cl-test-not cl-if-not.
+ (declare (debug edebug-forms))
+ `(cond
+ (cl-test (eq (not (funcall cl-test ,item ,x))
+ cl-test-not))
+ (cl-if (eq (not (funcall cl-if ,x)) cl-if-not))
+ (t (eql ,item ,x))))
+
+(defmacro cl--check-test (item x) ;all of the above.
+ (declare (debug edebug-forms))
+ `(cl--check-test-nokey ,item (cl--check-key ,x)))
+
+(defmacro cl--check-match (x y) ;cl-key cl-test cl-test-not
+ (declare (debug edebug-forms))
+ (setq x `(cl--check-key ,x) y `(cl--check-key ,y))
+ `(if cl-test
+ (eq (not (funcall cl-test ,x ,y)) cl-test-not)
+ (eql ,x ,y)))
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
-
;;;###autoload
(defun cl-reduce (cl-func cl-seq &rest cl-keys)
"Reduce two-argument FUNCTION across SEQ.
\nKeywords supported: :start :end :from-end :initial-value :key
\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
+ (cl--parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
(or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
(setq cl-seq (cl-subseq cl-seq cl-start cl-end))
(if cl-from-end (setq cl-seq (nreverse cl-seq)))
(let ((cl-accum (cond ((memq :initial-value cl-keys) cl-initial-value)
- (cl-seq (cl-check-key (pop cl-seq)))
+ (cl-seq (cl--check-key (pop cl-seq)))
(t (funcall cl-func)))))
(if cl-from-end
(while cl-seq
- (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
+ (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
cl-accum)))
(while cl-seq
(setq cl-accum (funcall cl-func cl-accum
- (cl-check-key (pop cl-seq))))))
+ (cl--check-key (pop cl-seq))))))
cl-accum)))
;;;###autoload
@@ -143,7 +135,7 @@
"Fill the elements of SEQ with ITEM.
\nKeywords supported: :start :end
\n(fn SEQ ITEM [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start 0) :end) ()
+ (cl--parsing-keywords ((:start 0) :end) ()
(if (listp seq)
(let ((p (nthcdr cl-start seq))
(n (if cl-end (- cl-end cl-start) 8000000)))
@@ -164,14 +156,14 @@
SEQ1 is destructively modified, then returned.
\nKeywords supported: :start1 :end1 :start2 :end2
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
+ (cl--parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
(if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
(or (= cl-start1 cl-start2)
(let* ((cl-len (length cl-seq1))
(cl-n (min (- (or cl-end1 cl-len) cl-start1)
(- (or cl-end2 cl-len) cl-start2))))
(while (>= (setq cl-n (1- cl-n)) 0)
- (cl-set-elt cl-seq1 (+ cl-start1 cl-n)
+ (cl--set-elt cl-seq1 (+ cl-start1 cl-n)
(elt cl-seq2 (+ cl-start2 cl-n))))))
(if (listp cl-seq1)
(let ((cl-p1 (nthcdr cl-start1 cl-seq1))
@@ -208,7 +200,7 @@
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
@@ -227,14 +219,14 @@
(setq cl-end (- (or cl-end 8000000) cl-start))
(if (= cl-start 0)
(while (and cl-seq (> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0))))
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
(setq cl-end (1- cl-end)) (cdr cl-seq))))
(while (and cl-p (> cl-end 0)
- (not (cl-check-test cl-item (car cl-p))))
+ (not (cl--check-test cl-item (car cl-p))))
(setq cl-p (cdr cl-p) cl-end (1- cl-end)))
(if (and cl-p (> cl-end 0))
(nconc (cl-ldiff cl-seq cl-p)
@@ -271,7 +263,7 @@
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
(:start 0) :end) ()
(if (<= (or cl-count (setq cl-count 8000000)) 0)
cl-seq
@@ -291,7 +283,7 @@
(progn
(while (and cl-seq
(> cl-end 0)
- (cl-check-test cl-item (car cl-seq))
+ (cl--check-test cl-item (car cl-seq))
(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
(> (setq cl-count (1- cl-count)) 0)))
(setq cl-end (1- cl-end)))
@@ -299,7 +291,7 @@
(if (and (> cl-count 0) (> cl-end 0))
(let ((cl-p (nthcdr cl-start cl-seq)))
(while (and (cdr cl-p) (> cl-end 0))
- (if (cl-check-test cl-item (car (cdr cl-p)))
+ (if (cl--check-test cl-item (car (cdr cl-p)))
(progn
(setcdr cl-p (cdr (cdr cl-p)))
(if (= (setq cl-count (1- cl-count)) 0)
@@ -341,14 +333,14 @@
(defun cl--delete-duplicates (cl-seq cl-keys cl-copy)
(if (listp cl-seq)
- (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
+ (cl--parsing-keywords (:test :test-not :key (:start 0) :end :from-end
:if)
()
(if cl-from-end
(let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (> cl-end 1)
(setq cl-i 0)
- (while (setq cl-i (cl--position (cl-check-key (car cl-p))
+ (while (setq cl-i (cl--position (cl--check-key (car cl-p))
(cdr cl-p) cl-i (1- cl-end)))
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
cl-p (nthcdr cl-start cl-seq) cl-copy nil))
@@ -360,13 +352,13 @@
cl-seq)
(setq cl-end (- (or cl-end (length cl-seq)) cl-start))
(while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
- (cl--position (cl-check-key (car cl-seq))
+ (cl--position (cl--check-key (car cl-seq))
(cdr cl-seq) 0 (1- cl-end)))
(setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
(let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
(while (and (cdr (cdr cl-p)) (> cl-end 1))
- (if (cl--position (cl-check-key (car (cdr cl-p)))
+ (if (cl--position (cl--check-key (car (cdr cl-p)))
(cdr (cdr cl-p)) 0 (1- cl-end))
(progn
(if cl-copy (setq cl-seq (copy-sequence cl-seq)
@@ -386,7 +378,7 @@
to avoid corrupting the original SEQ.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(if (or (eq cl-old cl-new)
(<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
@@ -396,7 +388,7 @@
cl-seq
(setq cl-seq (copy-sequence cl-seq))
(or cl-from-end
- (progn (cl-set-elt cl-seq cl-i cl-new)
+ (progn (cl--set-elt cl-seq cl-i cl-new)
(setq cl-i (1+ cl-i) cl-count (1- cl-count))))
(apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
:start cl-i cl-keys))))))
@@ -425,14 +417,14 @@
This is a destructive function; it reuses the storage of SEQ whenever possible.
\nKeywords supported: :test :test-not :key :count :start :end :from-end
\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+ (cl--parsing-keywords (:test :test-not :key :if :if-not :count
(:start 0) :end :from-end) ()
(or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
(let ((cl-p (nthcdr cl-start cl-seq)))
(setq cl-end (- (or cl-end 8000000) cl-start))
(while (and cl-p (> cl-end 0) (> cl-count 0))
- (if (cl-check-test cl-old (car cl-p))
+ (if (cl--check-test cl-old (car cl-p))
(progn
(setcar cl-p cl-new)
(setq cl-count (1- cl-count))))
@@ -441,12 +433,12 @@
(if cl-from-end
(while (and (< cl-start cl-end) (> cl-count 0))
(setq cl-end (1- cl-end))
- (if (cl-check-test cl-old (elt cl-seq cl-end))
+ (if (cl--check-test cl-old (elt cl-seq cl-end))
(progn
- (cl-set-elt cl-seq cl-end cl-new)
+ (cl--set-elt cl-seq cl-end cl-new)
(setq cl-count (1- cl-count)))))
(while (and (< cl-start cl-end) (> cl-count 0))
- (if (cl-check-test cl-old (aref cl-seq cl-start))
+ (if (cl--check-test cl-old (aref cl-seq cl-start))
(progn
(aset cl-seq cl-start cl-new)
(setq cl-count (1- cl-count))))
@@ -500,7 +492,7 @@
Return the index of the matching item, or nil if not found.
\nKeywords supported: :test :test-not :key :start :end :from-end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not
+ (cl--parsing-keywords (:test :test-not :key :if :if-not
(:start 0) :end :from-end) ()
(cl--position cl-item cl-seq cl-start cl-end cl-from-end)))
@@ -510,7 +502,7 @@
(or cl-end (setq cl-end 8000000))
(let ((cl-res nil))
(while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
- (if (cl-check-test cl-item (car cl-p))
+ (if (cl--check-test cl-item (car cl-p))
(setq cl-res cl-start))
(setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
cl-res))
@@ -518,10 +510,10 @@
(if cl-from-end
(progn
(while (and (>= (setq cl-end (1- cl-end)) cl-start)
- (not (cl-check-test cl-item (aref cl-seq cl-end)))))
+ (not (cl--check-test cl-item (aref cl-seq cl-end)))))
(and (>= cl-end cl-start) cl-end))
(while (and (< cl-start cl-end)
- (not (cl-check-test cl-item (aref cl-seq cl-start))))
+ (not (cl--check-test cl-item (aref cl-seq cl-start))))
(setq cl-start (1+ cl-start)))
(and (< cl-start cl-end) cl-start))))
@@ -546,13 +538,13 @@
"Count the number of occurrences of ITEM in SEQ.
\nKeywords supported: :test :test-not :key :start :end
\n(fn ITEM SEQ [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
(let ((cl-count 0) cl-x)
(or cl-end (setq cl-end (length cl-seq)))
(if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
(while (< cl-start cl-end)
(setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
+ (if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
(setq cl-start (1+ cl-start)))
cl-count)))
@@ -577,14 +569,14 @@
other, the return value indicates the end of the shorter sequence.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2
:from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(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))
+ (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))
@@ -592,7 +584,7 @@
(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)
+ (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))))
@@ -608,14 +600,14 @@
return nil if there are no matches.
\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2
:from-end
\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :from-end
+ (cl--parsing-keywords (:test :test-not :key :from-end
(:start1 0) :end1 (:start2 0) :end2) ()
(or cl-end1 (setq cl-end1 (length cl-seq1)))
(or cl-end2 (setq cl-end2 (length cl-seq2)))
(if (>= cl-start1 cl-end1)
(if cl-from-end cl-end2 cl-start2)
(let* ((cl-len (- cl-end1 cl-start1))
- (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
+ (cl-first (cl--check-key (elt cl-seq1 cl-start1)))
(cl-if nil) cl-pos)
(setq cl-end2 (- cl-end2 (1- cl-len)))
(while (and (< cl-start2 cl-end2)
@@ -636,7 +628,7 @@
\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
(if (nlistp cl-seq)
(cl-replace cl-seq (apply 'cl-sort (append cl-seq nil) cl-pred cl-keys))
- (cl-parsing-keywords (:key) ()
+ (cl--parsing-keywords (:key) ()
(if (memq cl-key '(nil identity))
(sort cl-seq cl-pred)
(sort cl-seq (function (lambda (cl-x cl-y)
@@ -660,16 +652,15 @@
\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
(or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
(or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
- (cl-parsing-keywords (:key) ()
+ (cl--parsing-keywords (:key) ()
(let ((cl-res nil))
(while (and cl-seq1 cl-seq2)
- (if (funcall cl-pred (cl-check-key (car cl-seq2))
- (cl-check-key (car cl-seq1)))
+ (if (funcall cl-pred (cl--check-key (car cl-seq2))
+ (cl--check-key (car cl-seq1)))
(push (pop cl-seq2) cl-res)
(push (pop cl-seq1) cl-res)))
(cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
-;;; See compiler macro in cl-macs.el
;;;###autoload
(defun cl-member (cl-item cl-list &rest cl-keys)
"Find the first occurrence of ITEM in LIST.
@@ -678,8 +669,8 @@
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(declare (compiler-macro cl--compiler-macro-member))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (while (and cl-list (not (cl--check-test cl-item (car cl-list))))
(setq cl-list (cdr cl-list)))
cl-list)
(if (and (numberp cl-item) (not (integerp cl-item)))
@@ -705,12 +696,11 @@
;;;###autoload
(defun cl--adjoin (cl-item cl-list &rest cl-keys)
- (if (cl-parsing-keywords (:key) t
- (apply 'cl-member (cl-check-key cl-item) cl-list cl-keys))
+ (if (cl--parsing-keywords (:key) t
+ (apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
cl-list
(cons cl-item cl-list)))
-;;; See compiler macro in cl-macs.el
;;;###autoload
(defun cl-assoc (cl-item cl-alist &rest cl-keys)
"Find the first item whose car matches ITEM in LIST.
@@ -718,10 +708,10 @@
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(declare (compiler-macro cl--compiler-macro-assoc))
(if cl-keys
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (car (car cl-alist))))))
+ (not (cl--check-test cl-item (car (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(if (and (numberp cl-item) (not (integerp cl-item)))
@@ -749,10 +739,10 @@
\nKeywords supported: :test :test-not :key
\n(fn ITEM LIST [KEYWORD VALUE]...)"
(if (or cl-keys (numberp cl-item))
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
(while (and cl-alist
(or (not (consp (car cl-alist)))
- (not (cl-check-test cl-item (cdr (car cl-alist))))))
+ (not (cl--check-test cl-item (cdr (car cl-alist))))))
(setq cl-alist (cdr cl-alist)))
(and cl-alist (car cl-alist)))
(rassq cl-item cl-alist)))
@@ -813,13 +803,13 @@
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(and cl-list1 cl-list2
(if (equal cl-list1 cl-list2) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(or (>= (length cl-list1) (length cl-list2))
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (if (or cl-keys (numberp (car cl-list2)))
- (apply 'cl-member (cl-check-key (car cl-list2))
+ (apply 'cl-member (cl--check-key (car cl-list2))
cl-list1 cl-keys)
(memq (car cl-list2) cl-list1))
(push (car cl-list2) cl-res))
@@ -845,11 +835,11 @@
\nKeywords supported: :test :test-not :key
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(if (or (null cl-list1) (null cl-list2)) cl-list1
- (cl-parsing-keywords (:key) (:test :test-not)
+ (cl--parsing-keywords (:key) (:test :test-not)
(let ((cl-res nil))
(while cl-list1
(or (if (or cl-keys (numberp (car cl-list1)))
- (apply 'cl-member (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys)
(memq (car cl-list1) cl-list2))
(push (car cl-list1) cl-res))
@@ -901,9 +891,9 @@
\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
(cond ((null cl-list1) t) ((null cl-list2) nil)
((equal cl-list1 cl-list2) t)
- (t (cl-parsing-keywords (:key) (:test :test-not)
+ (t (cl--parsing-keywords (:key) (:test :test-not)
(while (and cl-list1
- (apply 'cl-member (cl-check-key (car cl-list1))
+ (apply 'cl-member (cl--check-key (car cl-list1))
cl-list2 cl-keys))
(pop cl-list1))
(null cl-list1)))))
@@ -949,24 +939,26 @@
\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
(apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+(defvar cl--alist)
+
;;;###autoload
(defun cl-sublis (cl-alist cl-tree &rest cl-keys)
"Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (cl-sublis-rec cl-tree)))
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl--alist cl-alist))
+ (cl--sublis-rec cl-tree))))
-(defvar cl-alist)
-(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if*
- (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+(defun cl--sublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
+ (let ((cl-temp (cl--check-key cl-tree)) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (cdr (car cl-p))
(if (consp cl-tree)
- (let ((cl-a (cl-sublis-rec (car cl-tree)))
- (cl-d (cl-sublis-rec (cdr cl-tree))))
+ (let ((cl-a (cl--sublis-rec (car cl-tree)))
+ (cl-d (cl--sublis-rec (cdr cl-tree))))
(if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
cl-tree
(cons cl-a cl-d)))
@@ -978,20 +970,21 @@
Any matching element of TREE is changed via a call to `setcar'.
\nKeywords supported: :test :test-not :key
\n(fn ALIST TREE [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
- (let ((cl-hold (list cl-tree)))
- (cl-nsublis-rec cl-hold)
+ (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+ (let ((cl-hold (list cl-tree))
+ (cl--alist cl-alist))
+ (cl--nsublis-rec cl-hold)
(car cl-hold))))
-(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if*
+(defun cl--nsublis-rec (cl-tree) ;Uses cl--alist cl-key/test*/if*.
(while (consp cl-tree)
- (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (let ((cl-temp (cl--check-key (car cl-tree))) (cl-p cl--alist))
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p (setcar cl-tree (cdr (car cl-p)))
- (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
- (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
- (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
+ (if (consp (car cl-tree)) (cl--nsublis-rec (car cl-tree))))
+ (setq cl-temp (cl--check-key (cdr cl-tree)) cl-p cl--alist)
+ (while (and cl-p (not (cl--check-test-nokey (car (car cl-p)) cl-temp)))
(setq cl-p (cdr cl-p)))
(if cl-p
(progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
@@ -1003,14 +996,14 @@
Atoms are compared by `eql'; cons cells are compared recursively.
\nKeywords supported: :test :test-not :key
\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
- (cl-parsing-keywords (:test :test-not :key) ()
- (cl-tree-equal-rec cl-x cl-y)))
+ (cl--parsing-keywords (:test :test-not :key) ()
+ (cl--tree-equal-rec cl-x cl-y)))
-(defun cl-tree-equal-rec (cl-x cl-y)
+(defun cl--tree-equal-rec (cl-x cl-y) ;Uses cl-key/test*.
(while (and (consp cl-x) (consp cl-y)
- (cl-tree-equal-rec (car cl-x) (car cl-y)))
+ (cl--tree-equal-rec (car cl-x) (car cl-y)))
(setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
- (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
+ (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
(run-hooks 'cl-seq-load-hook)
=== modified file 'lisp/emacs-lisp/cl.el'
--- a/lisp/emacs-lisp/cl.el 2012-06-08 02:54:35 +0000
+++ b/lisp/emacs-lisp/cl.el 2012-06-11 15:52:50 +0000
@@ -337,6 +337,7 @@
- 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 @@
(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 @@
(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)
=== modified file 'lisp/help-fns.el'
--- a/lisp/help-fns.el 2012-02-26 09:24:13 +0000
+++ b/lisp/help-fns.el 2012-06-11 15:52:50 +0000
@@ -510,7 +510,7 @@
(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))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/emacs-24 r108560: Use lexical-binding for all of CL, and clean up its namespace.,
Stefan Monnier <=