]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/cl.el
Escape ` and ' in doc
[gnu-emacs] / lisp / emacs-lisp / cl.el
index fc09ff004e14e9e84283121836fb8d16e8a9a7ad..ba50680e8b9b21f5ca76347a1cba52d011a1de3f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cl.el --- Compatibility aliases for the old CL library.  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: extensions
@@ -29,6 +29,7 @@
 
 (require 'cl-lib)
 (require 'macroexp)
+(require 'gv)
 
 ;; (defun cl--rename ()
 ;;   (let ((vdefs ())
@@ -85,7 +86,7 @@
 
 (defun cl-unload-function ()
   "Stop unloading of the Common Lisp extensions."
-  (message "Cannot unload the feature `cl'")
+  (message "Cannot unload the feature ‘cl’")
   ;; Stop standard unloading!
   t)
 
@@ -341,6 +342,8 @@ The two cases that are handled are:
 - 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))
+  (declare-function cl--labels-convert "cl-macs" (f))
+  (defvar cl--labels-convert-cache)
   (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
@@ -373,13 +376,7 @@ The two cases that are handled are:
           (setq cl--function-convert-cache (cons newf res))
           res))))
    (t
-    (let ((found (assq f macroexpand-all-environment)))
-      (if (and found (ignore-errors
-                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
-          (cadr (cl-caddr (cl-cadddr found)))
-        (let ((res `(function ,f)))
-          (setq cl--function-convert-cache (cons f res))
-          res))))))
+    (cl--labels-convert f))))
 
 (defmacro lexical-let (bindings &rest body)
   "Like `let', but lexically scoped.
@@ -400,7 +397,7 @@ lexical closures as in Common Lisp.
          (macroexpand-all
            `(cl-symbol-macrolet
                 ,(mapcar (lambda (x)
-                           `(,(car x) (symbol-value ,(cl-caddr x))))
+                           `(,(car x) (symbol-value ,(nth 2 x))))
                          vars)
               ,@body)
           (cons (cons 'function #'cl--function-convert)
@@ -413,20 +410,20 @@ lexical closures as in Common Lisp.
         ;; dynamic scoping, since with lexical scoping we'd need
         ;; (let ((foo <val>)) ...foo...).
        `(progn
-           ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
-           (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+           ,@(mapcar (lambda (x) `(defvar ,(nth 2 x))) vars)
+           (let ,(mapcar (lambda (x) (list (nth 2 x) (nth 1 x))) vars)
            ,(cl-sublis (mapcar (lambda (x)
-                              (cons (cl-caddr x)
-                                    `',(cl-caddr x)))
+                              (cons (nth 2 x)
+                                    `',(nth 2 x)))
                             vars)
                     ebody)))
       `(let ,(mapcar (lambda (x)
-                       (list (cl-caddr x)
+                       (list (nth 2 x)
                              `(make-symbol ,(format "--%s--" (car x)))))
                      vars)
          (setf ,@(apply #'append
                         (mapcar (lambda (x)
-                                  (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+                                  (list `(symbol-value ,(nth 2 x)) (nth 1 x)))
                                 vars)))
          ,ebody))))
 
@@ -462,15 +459,15 @@ definitions, or lack thereof).
              (if (or (and (fboundp (car x))
                           (eq (car-safe (symbol-function (car x))) 'macro))
                      (cdr (assq (car x) macroexpand-all-environment)))
-                 (error "Use `labels', not `flet', to rebind macro names"))
+                 (error "Use ‘labels’, not ‘flet’, to rebind macro names"))
              (let ((func `(cl-function
                            (lambda ,(cadr x)
                              (cl-block ,(car x) ,@(cddr x))))))
                (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' \
-will not work - use `labels' instead" (symbol-name (car x))))
+                      (error "Byte-compiling a redefinition of ‘%s’ \
+will not work - use ‘labels’ instead" (symbol-name (car x))))
                  ;; FIXME This affects the rest of the file, when it
                  ;; should be restricted to the flet body.
                  (and (boundp 'byte-compile-function-environment)
@@ -571,7 +568,7 @@ may be bound to temporary variables which are introduced
 automatically to preserve proper execution order of the arguments.
 For example:
 
-  (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+  (defsetf nth (n x) (v) \\=`(setcar (nthcdr ,n ,x) ,v))
 
 You can replace this form with `gv-define-setter'.
 
@@ -629,6 +626,8 @@ You can replace this form with `gv-define-setter'.
 ;;     ...the rest, and build the 5-tuple))
 (make-obsolete 'get-setf-method 'gv-letplace "24.3")
 
+(declare-function cl--arglist-args "cl-macs" (args))
+
 (defmacro define-modify-macro (name arglist func &optional doc)
   "Define a `setf'-like modify macro.
 If NAME is called, it combines its PLACE argument with the other
@@ -642,6 +641,7 @@ You can replace this macro with `gv-letplace'."
                      symbolp &optional stringp)))
   (if (memq '&key arglist)
       (error "&key not allowed in define-modify-macro"))
+  (require 'cl-macs)                    ;For cl--arglist-args.
   (let ((place (make-symbol "--cl-place--")))
     `(cl-defmacro ,name (,place ,@arglist)
        ,doc