]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/cl-macs.el
Fixes: debbugs:6594
[gnu-emacs] / lisp / emacs-lisp / cl-macs.el
index f0ac3c562a1cafa70d0ef9fb6ed8eca958d7077d..3e9d7c27258510babed3a58b4ca67f085243a707 100644 (file)
@@ -1,7 +1,7 @@
 ;;; cl-macs.el --- Common Lisp macros
 
-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;;   2009, 2010, 2011  Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Version: 2.02
@@ -230,6 +230,8 @@ It is a list of elements of the form either:
 (defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
 (defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
 
+(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+
 (defun cl-transform-lambda (form bind-block)
   (let* ((args (car form)) (body (cdr form)) (orig-args args)
         (bind-defs nil) (bind-enquote nil)
@@ -430,7 +432,7 @@ It is a list of elements of the form either:
 ;;;###autoload
 (defmacro destructuring-bind (args expr &rest body)
   (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
-        (bind-defs nil) (bind-block 'cl-none))
+        (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
     (cl-do-arglist (or args '(&aux)) expr)
     (append '(progn) bind-inits
            (list (nconc (list 'let* (nreverse bind-lets))
@@ -620,7 +622,7 @@ This is equivalent to `(return-from nil RESULT)'."
 ;;;###autoload
 (defmacro return-from (name &optional result)
   "Return from the block named NAME.
-This jump out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(block NAME ...)' form,
 returning RESULT from that form (or nil if RESULT is omitted).
 This is compatible with Common Lisp, but note that `defun' and
 `defmacro' do not create implicit blocks as they do in Common Lisp."
@@ -1453,7 +1455,7 @@ lexical closures as in Common Lisp.
 (defmacro lexical-let* (bindings &rest body)
   "Like `let*', but lexically scoped.
 The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
+successive bindings within VARLIST, will create lexical closures
 as in Common Lisp.  This is similar to the behavior of `let*' in
 Common Lisp.
 \n(fn VARLIST BODY)"
@@ -2189,11 +2191,21 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
 ;;;###autoload
 (defmacro defstruct (struct &rest descs)
   "Define a struct type.
-This macro defines a new Lisp data type called NAME, which contains data
-stored in SLOTs.  This defines a `make-NAME' constructor, a `copy-NAME'
-copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
+This macro defines a new data type called NAME that stores data
+in SLOTs.  It defines a `make-NAME' constructor, a `copy-NAME'
+copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
+You can use the accessors to set the corresponding slots, via `setf'.
+
+NAME may instead take the form (NAME OPTIONS...), where each
+OPTION is either a single keyword or (KEYWORD VALUE).
+See Info node `(cl)Structures' for a list of valid keywords.
+
+Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
+SLOT-OPTS are keyword-value pairs for that slot.  Currently, only
+one keyword is supported, `:read-only'.  If this has a non-nil
+value, that slot cannot be set via `setf'.
 
-\(fn (NAME OPTIONS...) (SLOT SLOT-OPTS...)...)"
+\(fn NAME SLOTS...)"
   (let* ((name (if (consp struct) (car struct) struct))
         (opts (cdr-safe struct))
         (slots nil)
@@ -2436,6 +2448,7 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
 
 ;;; Types and assertions.
 
+;;;###autoload
 (defmacro deftype (name arglist &rest body)
   "Define NAME as a new data type.
 The type name can then be used in `typecase', `check-type', etc."
@@ -2547,8 +2560,22 @@ and then returning foo."
         (cons (if (memq '&whole args) (delq '&whole args)
                 (cons '--cl-whole-arg-- args)) body))
        (list 'or (list 'get (list 'quote func) '(quote byte-compile))
-             (list 'put (list 'quote func) '(quote byte-compile)
-                   '(quote cl-byte-compile-compiler-macro)))))
+             (list 'progn
+                   (list 'put (list 'quote func) '(quote byte-compile)
+                         '(quote cl-byte-compile-compiler-macro))
+                   ;; This is so that describe-function can locate
+                   ;; the macro definition.
+                   (list 'let
+                         (list (list
+                                'file
+                                (or buffer-file-name
+                                    (and (boundp 'byte-compile-current-file)
+                                         (stringp byte-compile-current-file)
+                                         byte-compile-current-file))))
+                         (list 'if 'file
+                               (list 'put (list 'quote func)
+                                     '(quote compiler-macro-file)
+                                     '(purecopy (file-name-nondirectory file)))))))))
 
 ;;;###autoload
 (defun compiler-macroexpand (form)
@@ -2569,6 +2596,7 @@ and then returning foo."
       (byte-compile-normal-call form)
     (byte-compile-form form)))
 
+;;;###autoload
 (defmacro defsubst* (name args &rest body)
   "Define NAME as a function.
 Like `defun', except the function is automatically declared `inline',