mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 12:21:25 -08:00
* 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'.
This commit is contained in:
Stefan Monnier
parent
9ddf23f075
commit
cf4e5178a3
5 changed files with 52 additions and 37 deletions
|
|
@ -1,3 +1,14 @@
|
|||
2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <monnier@iro.umontreal.ca>
|
||||
Daniel Hackney <dan@haxney.org>
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue