Commit 338bfefa authored by Stefan Monnier's avatar Stefan Monnier

Further cleanup of the "cl-" namespace. Fit CL in 80 columns.

* lisp/emacs-lisp/cl-macs.el (cl--pop2, cl--optimize-safety)
(cl--optimize-speed, cl--not-toplevel, cl--parse-loop-clause)
(cl--expand-do-loop, cl--proclaim-history, cl--declare-stack)
(cl--do-proclaim, cl--proclaims-deferred): Rename from the "cl-" prefix.
(cl-progv): Don't rely on dynamic scoping to find the body.
* lisp/emacs-lisp/cl-lib.el (cl--optimize-speed, cl--optimize-safety)
(cl--proclaims-deferred): Rename from the "cl-" prefix.
(cl-declaim): Use backquotes.
* lisp/emacs-lisp/cl-extra.el (cl-make-random-state, cl-random-state-p):
Use "cl--" prefix for the object's tag.
parent 1812c724
2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca>
Further cleanup of the "cl-" namespace. Fit CL in 80 columns.
* emacs-lisp/cl-macs.el (cl--pop2, cl--optimize-safety)
(cl--optimize-speed, cl--not-toplevel, cl--parse-loop-clause)
(cl--expand-do-loop, cl--proclaim-history, cl--declare-stack)
(cl--do-proclaim, cl--proclaims-deferred): Rename from the "cl-" prefix.
(cl-progv): Don't rely on dynamic scoping to find the body.
* emacs-lisp/cl-lib.el (cl--optimize-speed, cl--optimize-safety)
(cl--proclaims-deferred): Rename from the "cl-" prefix.
(cl-declaim): Use backquotes.
* emacs-lisp/cl-extra.el (cl-make-random-state, cl-random-state-p):
Use "cl--" prefix for the object's tag.
* ses.el: Use advice-add/remove.
(ses--advice-copy-region-as-kill, ses--advice-yank): New functions.
(copy-region-as-kill, yank): Use advice-add.
......
......@@ -51,7 +51,8 @@ TYPE is a Common Lisp type specifier.
((eq type 'string) (if (stringp x) x (concat x)))
((eq type 'array) (if (arrayp x) x (vconcat x)))
((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type))
((and (eq type 'character) (symbolp x))
(cl-coerce (symbol-name x) type))
((eq type 'float) (float x))
((cl-typep x type) x)
(t (error "Can't coerce %s to type %s" x type))))
......@@ -69,7 +70,7 @@ strings case-insensitively."
((stringp x)
(and (stringp y) (= (length x) (length y))
(or (string-equal x y)
(string-equal (downcase x) (downcase y))))) ; lazy but simple!
(string-equal (downcase x) (downcase y))))) ;Lazy but simple!
((numberp x)
(and (numberp y) (= x y)))
((consp x)
......@@ -439,14 +440,14 @@ Optional second arg STATE is a random-state object."
If STATE is t, return a new state object seeded from the time of day."
(cond ((null state) (cl-make-random-state cl--random-state))
((vectorp state) (copy-tree state t))
((integerp state) (vector 'cl-random-state-tag -1 30 state))
((integerp state) (vector 'cl--random-state-tag -1 30 state))
(t (cl-make-random-state (cl--random-time)))))
;;;###autoload
(defun cl-random-state-p (object)
"Return t if OBJECT is a random-state object."
(and (vectorp object) (= (length object) 4)
(eq (aref object 0) 'cl-random-state-tag)))
(eq (aref object 0) 'cl--random-state-tag)))
;; Implementation limits.
......
......@@ -93,8 +93,8 @@
(require 'macroexp)
(defvar cl-optimize-speed 1)
(defvar cl-optimize-safety 1)
(defvar cl--optimize-speed 1)
(defvar cl--optimize-safety 1)
;;;###autoload
(define-obsolete-variable-alias
......@@ -248,23 +248,21 @@ one value.
(equal (buffer-name (symbol-value 'byte-compile--outbuffer))
" *Compiler Output*"))))
(defvar cl-proclaims-deferred nil)
(defvar cl--proclaims-deferred nil)
(defun cl-proclaim (spec)
"Record a global declaration specified by SPEC."
(if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
(push spec cl-proclaims-deferred))
(if (fboundp 'cl--do-proclaim) (cl--do-proclaim spec t)
(push spec cl--proclaims-deferred))
nil)
(defmacro cl-declaim (&rest specs)
"Like `cl-proclaim', but takes any number of unevaluated, unquoted arguments.
Puts `(cl-eval-when (compile load eval) ...)' around the declarations
so that they are registered at compile-time as well as run-time."
(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)
(cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when
(let ((body (mapcar (lambda (x) `(cl-proclaim ',x) specs))))
(if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body)
`(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when.
;;; Symbols.
......@@ -301,7 +299,8 @@ always returns nil."
"Return t if INTEGER is even."
(eq (logand integer 1) 0))
(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl--random-time)))
(defvar cl--random-state
(vector 'cl--random-state-tag -1 30 (cl--random-time)))
(defconst cl-most-positive-float nil
"The largest value that a Lisp float can hold.
......
......@@ -11,7 +11,7 @@
;;;;;; 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-mapc cl-maplist cl-map cl--mapcar-many cl-equalp
;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "8e9fee941c465ac0fee9b92a92d64154")
;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "3ee58411735a01dd1e1d3964fdcfae70")
;;; Generated autoloads from cl-extra.el
(autoload 'cl-coerce "cl-extra" "\
......@@ -224,7 +224,7 @@ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
(put 'cl-get 'compiler-macro #'cl--compiler-macro-get)
(eval-and-compile (put 'cl-get 'compiler-macro #'cl--compiler-macro-get))
(autoload 'cl-getf "cl-extra" "\
Search PROPLIST for property PROPNAME; return its value or DEFAULT.
......@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
;;;;;; 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--compiler-macro-cXXr cl--compiler-macro-list*)
;;;;;; "cl-macs" "cl-macs.el" "3dd5e153133b2752fd52e45792c46dfe")
;;;;;; "cl-macs" "cl-macs.el" "5df0692d7c4bffb2cc353f802d94f796")
;;; Generated autoloads from cl-macs.el
(autoload 'cl--compiler-macro-list* "cl-macs" "\
......@@ -759,7 +759,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" "4c1e1191e82dc8d5449a5ec4d59efc10")
;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "697d04e7ae0a9b9c15eea705b359b1bb")
;;; Generated autoloads from cl-seq.el
(autoload 'cl-reduce "cl-seq" "\
......@@ -1020,7 +1020,7 @@ Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
(put 'cl-member 'compiler-macro #'cl--compiler-macro-member)
(eval-and-compile (put 'cl-member 'compiler-macro #'cl--compiler-macro-member))
(autoload 'cl-member-if "cl-seq" "\
Find the first item satisfying PREDICATE in LIST.
......@@ -1050,7 +1050,7 @@ Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)
(eval-and-compile (put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc))
(autoload 'cl-assoc-if "cl-seq" "\
Find the first item whose car satisfies PREDICATE in LIST.
......
This diff is collapsed.
......@@ -105,6 +105,9 @@
(eq (not (funcall cl-test ,x ,y)) cl-test-not)
(eql ,x ,y)))
;; Yuck! These vars are set/bound by cl--parsing-keywords to match :if :test
;; and :key keyword args, and they are also accessed (sometimes) via dynamic
;; scoping (and some of those accesses are from macro-expanded code).
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
......@@ -333,7 +336,8 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(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)
......@@ -776,7 +780,8 @@ to avoid corrupting the original LIST1 and LIST2.
(setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
(while cl-list2
(if (or cl-keys (numberp (car cl-list2)))
(setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
(setq cl-list1
(apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
(or (memq (car cl-list2) cl-list1)
(push (car cl-list2) cl-list1)))
(pop cl-list2))
......
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