[Emacs-diffs] trunk r112937: * lisp/help-fns.el (help-fns--compiler-macro): If the handler function is

[Stefan Monnier]

------------------------------------------------------------
revno: 112937
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-06-11 22:16:02 -0400
message:
  * lisp/help-fns.el (help-fns--compiler-macro): If the handler function is
  named, then put a link to it.
  * lisp/help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names.
  * lisp/emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function.
  (cl-typep): Use it.
  (cl-eval-when): Simplify debug spec.
  (cl-define-compiler-macro): Use eval-and-compile.  Give a name to the
  compiler-macro function instead of setting `compiler-macro-file'.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/cl-loaddefs.el 
clloaddefs.el-20091113204419-o5vbwnq5f7feedwu-5075
  lisp/emacs-lisp/cl-macs.el     clmacs.el-20091113204419-o5vbwnq5f7feedwu-612
  lisp/help-fns.el               helpfns.el-20091113204419-o5vbwnq5f7feedwu-2354
  lisp/help-mode.el              
helpmode.el-20091113204419-o5vbwnq5f7feedwu-2249

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-06-12 00:49:33 +0000
+++ b/lisp/ChangeLog    2013-06-12 02:16:02 +0000
@@ -1,4 +1,15 @@
 2013-06-12  Stefan Monnier  <address@hidden>
+
+       * help-fns.el (help-fns--compiler-macro): If the handler function is
+       named, then put a link to it.
+       * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names.
+       * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function.
+       (cl-typep): Use it.
+       (cl-eval-when): Simplify debug spec.
+       (cl-define-compiler-macro): Use eval-and-compile.  Give a name to the
+       compiler-macro function instead of setting `compiler-macro-file'.
+
+2013-06-12  Stefan Monnier  <address@hidden>
            Daniel Hackney  <address@hidden>
 
        First part of Daniel Hackney's patch to package.el.

=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el    2013-06-05 02:35:40 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el    2013-06-12 02:16:02 +0000
@@ -267,7 +267,7 @@
 ;;;;;;  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" "80cb53f97b21adb6069c43c38a2e094d")
+;;;;;;  "cl-macs" "cl-macs.el" "fd824d987086eafec0b1cb2efa8312f4")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl--compiler-macro-list* "cl-macs" "\
@@ -699,9 +699,10 @@
 KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
 :type, :named, :initial-offset, :print-function, or :include.
 
-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
+Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
+SDEFAULT is the default value of that slot and SOPTIONS 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 SLOTS...)" nil t)
@@ -724,6 +725,8 @@
 
 \(fn OBJECT TYPE)" nil nil)
 
+(eval-and-compile (put 'cl-typep 'compiler-macro #'cl--compiler-macro-typep))
+
 (autoload 'cl-check-type "cl-macs" "\
 Verify that FORM is of type TYPE; signal an error if not.
 STRING is an optional description of the desired type.

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2013-06-05 02:35:40 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2013-06-12 02:16:02 +0000
@@ -584,7 +584,7 @@
 If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
 
 \(fn (WHEN...) BODY...)"
-  (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
+  (declare (indent 1) (debug (sexp body)))
   (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)))
@@ -2276,9 +2276,10 @@
 KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
 :type, :named, :initial-offset, :print-function, or :include.
 
-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
+Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
+SDEFAULT is the default value of that slot and SOPTIONS 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 SLOTS...)"
@@ -2574,9 +2575,16 @@
 (defun cl-typep (object type)   ; See compiler macro below.
   "Check that OBJECT is of type TYPE.
 TYPE is a Common Lisp-style type specifier."
+  (declare (compiler-macro cl--compiler-macro-typep))
   (let ((cl--object object)) ;; Yuck!!
     (eval (cl--make-type-test 'cl--object type))))
 
+(defun cl--compiler-macro-typep (form val type)
+  (if (macroexp-const-p type)
+      (macroexp-let2 macroexp-copyable-p temp val
+        (cl--make-type-test temp (cl--const-expr-val type)))
+    form))
+
 ;;;###autoload
 (defmacro cl-check-type (form type &optional string)
   "Verify that FORM is of type TYPE; signal an error if not.
@@ -2635,19 +2643,13 @@
   (let ((p args) (res nil))
     (while (consp p) (push (pop p) res))
     (setq args (nconc (nreverse res) (and p (list '&rest p)))))
-  `(cl-eval-when (compile load eval)
-     (put ',func 'compiler-macro
-          (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args)
-                             (cons '_cl-whole-arg args))
-                         ,@body)))
-     ;; This is so that describe-function can locate
-     ;; the macro definition.
-     (let ((file ,(or buffer-file-name
-                      (and (boundp 'byte-compile-current-file)
-                           (stringp byte-compile-current-file)
-                           byte-compile-current-file))))
-       (if file (put ',func 'compiler-macro-file
-                     (purecopy (file-name-nondirectory file)))))))
+  (let ((fname (make-symbol (concat (symbol-name func) "--cmacro"))))
+    `(eval-and-compile
+       ;; Name the compiler-macro function, so that `symbol-file' can find it.
+       (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
+                           (cons '_cl-whole-arg args))
+         ,@body)
+       (put ',func 'compiler-macro #',fname))))
 
 ;;;###autoload
 (defun cl-compiler-macroexpand (form)
@@ -2773,12 +2775,6 @@
       `(cl-getf (symbol-plist ,sym) ,prop ,def)
     `(get ,sym ,prop)))
 
-(cl-define-compiler-macro cl-typep (&whole form val type)
-  (if (macroexp-const-p type)
-      (macroexp-let2 macroexp-copyable-p temp val
-        (cl--make-type-test temp (cl--const-expr-val type)))
-    form))
-
 (dolist (y '(cl-first cl-second cl-third cl-fourth
              cl-fifth cl-sixth cl-seventh
              cl-eighth cl-ninth cl-tenth

=== modified file 'lisp/help-fns.el'
--- a/lisp/help-fns.el  2013-02-14 08:05:26 +0000
+++ b/lisp/help-fns.el  2013-06-12 02:16:02 +0000
@@ -435,14 +435,19 @@
   (let ((handler (function-get function 'compiler-macro)))
     (when handler
       (insert "\nThis function has a compiler macro")
-      (let ((lib (get function 'compiler-macro-file)))
-        ;; FIXME: rather than look at the compiler-macro-file property,
-        ;; just look at `handler' itself.
-        (when (stringp lib)
-          (insert (format " in `%s'" lib))
-          (save-excursion
-            (re-search-backward "`\\([^`']+\\)'" nil t)
-            (help-xref-button 1 'help-function-cmacro function lib))))
+      (if (symbolp handler)
+          (progn
+            (insert (format " `%s'" handler))
+            (save-excursion
+              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function handler)))
+        ;; FIXME: Obsolete since 24.4.
+        (let ((lib (get function 'compiler-macro-file)))
+          (when (stringp lib)
+            (insert (format " in `%s'" lib))
+            (save-excursion
+              (re-search-backward "`\\([^`']+\\)'" nil t)
+              (help-xref-button 1 'help-function-cmacro function lib)))))
       (insert ".\n"))))
 
 (defun help-fns--signature (function doc real-def real-function)

=== modified file 'lisp/help-mode.el'
--- a/lisp/help-mode.el 2013-01-11 23:08:55 +0000
+++ b/lisp/help-mode.el 2013-06-12 02:16:02 +0000
@@ -204,7 +204,7 @@
                       (message "Unable to find location in file"))))
   'help-echo (purecopy "mouse-2, RET: find function's definition"))
 
-(define-button-type 'help-function-cmacro
+(define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4.
   :supertype 'help-xref
   'help-function (lambda (fun file)
                   (setq file (locate-library file t))
@@ -213,7 +213,7 @@
                         (pop-to-buffer (find-file-noselect file))
                         (goto-char (point-min))
                         (if (re-search-forward
-                             (format "^[ \t]*(define-compiler-macro[ \t]+%s"
+                             (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ 
\t]+%s"
                                      (regexp-quote (symbol-name fun))) nil t)
                             (forward-line 0)
                           (message "Unable to find location in file")))