From cf4e5178a3e00bd5d46fc609b6591af7ae19833f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 11 Jun 2013 22:16:02 -0400 Subject: [PATCH] * 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'. --- lisp/ChangeLog | 11 +++++++++ lisp/emacs-lisp/cl-loaddefs.el | 11 +++++---- lisp/emacs-lisp/cl-macs.el | 42 +++++++++++++++------------------- lisp/help-fns.el | 21 ++++++++++------- lisp/help-mode.el | 4 ++-- 5 files changed, 52 insertions(+), 37 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ff4c2fb4444..f3ea1419873 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2013-06-12 Stefan Monnier + + * 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 Daniel Hackney diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 33ee7c0bbd2..a06abb03b95 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -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" "80cb53f97b21adb6069c43c38a2e094d") +;;;;;; "cl-macs" "cl-macs.el" "fd824d987086eafec0b1cb2efa8312f4") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -699,9 +699,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where 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 @@ TYPE is a Common Lisp-style type specifier. \(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. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 66ad8e769b5..34957d86796 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -584,7 +584,7 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. 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 @@ OPTION is either a single keyword or (KEYWORD VALUE) where 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 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." (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 @@ and then returning foo." (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 @@ surrounded by (cl-block NAME ...). `(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 diff --git a/lisp/help-fns.el b/lisp/help-fns.el index bdf86016844..86bb67e87c2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -435,14 +435,19 @@ suitable file is found, return nil." (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) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index b5aca1a4445..b56adc2a4a9 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -204,7 +204,7 @@ The format is (FUNCTION ARGS...).") (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 @@ The format is (FUNCTION ARGS...).") (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"))) -- 2.39.2