]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/cl-macs.el
Add 2010 to copyright years.
[gnu-emacs] / lisp / emacs-lisp / cl-macs.el
index f0ac3c562a1cafa70d0ef9fb6ed8eca958d7077d..29bb752dbf776a3b644d0fd5a5836eb550f54f9e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cl-macs.el --- Common Lisp macros
 
-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
@@ -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)
@@ -2436,6 +2438,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 +2550,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)