mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-02 08:22:22 +00:00
* lisp/emacs-lisp/edebug.el (edebug--handle-&-spec-op <&name>): New method
(edebug--concat-name): New function. (edebug-match-name, edebug-match-cl-generic-method-qualifier) (edebug-match-cl-generic-method-args): Delete functions. * doc/lispref/edebug.texi (Specification List): Document it. * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Use `&name`. (cl-generic--method-qualifier-p): New predicate. (cl-defmethod): Use it and `&name`. * lisp/emacs-lisp/cl-macs.el (cl-defun, cl-iter-defun, cl-flet): * lisp/emacs-lisp/eieio-compat.el (defmethod): * lisp/emacs-lisp/gv.el (gv-define-setter): * lisp/emacs-lisp/ert.el (ert-deftest): Use `&name`. * lisp/erc/erc-backend.el (define-erc-response-handler): Use `declare` and `&name`.
This commit is contained in:
Stefan Monnier
parent
e81cf63be1
commit
2007afd21b
@ -1444,29 +1444,23 @@ Here is a list of additional specifications that may appear only after
|
||||
@code{&define}. See the @code{defun} example.
|
||||
|
||||
@table @code
|
||||
@item &name
|
||||
Extracts the name of the current defining form from the code.
|
||||
It takes the form @code{&name [@var{prestring}] @var{spec}
|
||||
[@var{poststring}] @var{fun} @var{args...}} and means that Edebug will
|
||||
match @var{spec} against the code and then call @var{fun} with the
|
||||
concatenation of the current name, @var{args...}, @var{prestring},
|
||||
the code that matched @code{spec}, and @var{poststring}. If @var{fun}
|
||||
is absent, it defaults to a function that concatenates the arguments
|
||||
(with an @code{@} between the previous name and the new).
|
||||
|
||||
@item name
|
||||
The argument, a symbol, is the name of the defining form.
|
||||
Shorthand for @code{[&name symbolp]}.
|
||||
|
||||
A defining form is not required to have a name field; and it may have
|
||||
multiple name fields.
|
||||
|
||||
@item :name
|
||||
This construct does not actually match an argument. The element
|
||||
following @code{:name} should be a symbol; it is used as an additional
|
||||
name component for the definition. You can use this to add a unique,
|
||||
static component to the name of the definition. It may be used more
|
||||
than once.
|
||||
|
||||
@item :unique
|
||||
This construct is like @code{:name}, but generates unique names. It
|
||||
does not match an argument. The element following @code{:unique}
|
||||
should be a string; it is used as the prefix for an additional name
|
||||
component for the definition. You can use this to add a unique,
|
||||
dynamic component to the name of the definition. This is useful for
|
||||
macros that can define the same symbol multiple times in different
|
||||
scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
|
||||
be used more than once.
|
||||
|
||||
@item arg
|
||||
The argument, a symbol, is the name of an argument of the defining form.
|
||||
However, lambda-list keywords (symbols starting with @samp{&})
|
||||
|
||||
9
etc/NEWS
9
etc/NEWS
@ -936,7 +936,11 @@ To customize obsolete user options, use 'customize-option' or
|
||||
** Edebug
|
||||
|
||||
---
|
||||
*** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
|
||||
*** Obsoletions
|
||||
**** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'.
|
||||
|
||||
+++
|
||||
**** The Edebug spec operator ':name NAME' is obsolete.
|
||||
|
||||
+++
|
||||
*** New function 'def-edebug-elem-spec' to define Edebug spec elements.
|
||||
@ -954,8 +958,7 @@ declared obsolete.
|
||||
**** '&error MSG' unconditionally aborts the current edebug instrumentation.
|
||||
|
||||
+++
|
||||
**** ':unique STRING' appends STRING to the Edebug name of the current
|
||||
definition to (hopefully) make it more unique.
|
||||
**** '&name SPEC FUN' extracts the current name from the code matching SPEC.
|
||||
|
||||
** ElDoc
|
||||
|
||||
|
||||
@ -206,22 +206,29 @@ DEFAULT-BODY, if present, is used as the body of a default method.
|
||||
\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
|
||||
(declare (indent 2) (doc-string 3)
|
||||
(debug
|
||||
(&define [&or name ("setf" name :name setf)] listp
|
||||
lambda-doc
|
||||
(&define [&name sexp] ;Allow (setf ...) additionally to symbols.
|
||||
listp lambda-doc
|
||||
[&rest [&or
|
||||
("declare" &rest sexp)
|
||||
(":argument-precedence-order" &rest sexp)
|
||||
(&define ":method"
|
||||
;; FIXME: The `:unique'
|
||||
;; FIXME: The `gensym'
|
||||
;; construct works around
|
||||
;; Bug#42672. We'd rather want
|
||||
;; names like those generated by
|
||||
;; `cl-defmethod', but that
|
||||
;; requires larger changes to
|
||||
;; Edebug.
|
||||
:unique "cl-generic-:method@"
|
||||
[&rest cl-generic-method-qualifier]
|
||||
cl-generic-method-args lambda-doc
|
||||
[&name "cl-generic-:method@" []]
|
||||
[&name [] gensym] ;Make it unique!
|
||||
[&name
|
||||
[[&rest cl-generic--method-qualifier-p]
|
||||
;; FIXME: We don't actually want the
|
||||
;; argument's names to be considered
|
||||
;; part of the name of the defined
|
||||
;; function.
|
||||
listp]] ;Formal args
|
||||
lambda-doc
|
||||
def-body)]]
|
||||
def-body)))
|
||||
(let* ((doc (if (stringp (car-safe options-and-methods))
|
||||
@ -398,6 +405,9 @@ the specializer used will be the one returned by BODY."
|
||||
(let ((combined-doc (buffer-string)))
|
||||
(if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
|
||||
|
||||
(defun cl-generic--method-qualifier-p (x)
|
||||
(not (listp x)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-defmethod (name args &rest body)
|
||||
"Define a new method for generic function NAME.
|
||||
@ -440,15 +450,17 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
|
||||
(declare (doc-string 3) (indent defun)
|
||||
(debug
|
||||
(&define ; this means we are defining something
|
||||
[&or name ("setf" name :name setf)]
|
||||
;; ^^ This is the methods symbol
|
||||
[ &rest cl-generic-method-qualifier ]
|
||||
[&name [sexp ;Allow (setf ...) additionally to symbols.
|
||||
;; Multiple qualifiers are allowed.
|
||||
cl-generic-method-args ; arguments
|
||||
[&rest cl-generic--method-qualifier-p]
|
||||
;; FIXME: We don't actually want the argument's names
|
||||
;; to be considered part of the name of the
|
||||
;; defined function.
|
||||
listp]] ; arguments
|
||||
lambda-doc ; documentation string
|
||||
def-body))) ; part to be debugged
|
||||
(let ((qualifiers nil))
|
||||
(while (not (listp args))
|
||||
(while (cl-generic--method-qualifier-p args)
|
||||
(push args qualifiers)
|
||||
(setq args (pop body)))
|
||||
(when (eq 'setf (car-safe name))
|
||||
|
||||
@ -358,7 +358,7 @@ more details.
|
||||
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
|
||||
(declare (debug
|
||||
;; Same as defun but use cl-lambda-list.
|
||||
(&define [&or name ("setf" :name setf name)]
|
||||
(&define [&name sexp] ;Allow (setf ...) additionally to symbols.
|
||||
cl-lambda-list
|
||||
cl-declarations-or-string
|
||||
[&optional ("interactive" interactive)]
|
||||
@ -376,7 +376,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
|
||||
\(fn NAME ARGLIST [DOCSTRING] BODY...)"
|
||||
(declare (debug
|
||||
;; Same as iter-defun but use cl-lambda-list.
|
||||
(&define [&or name ("setf" :name setf name)]
|
||||
(&define [&name sexp] ;Allow (setf ...) additionally to symbols.
|
||||
cl-lambda-list
|
||||
cl-declarations-or-string
|
||||
[&optional ("interactive" interactive)]
|
||||
@ -2016,8 +2016,9 @@ info node `(cl) Function Bindings' for details.
|
||||
|
||||
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
|
||||
(declare (indent 1)
|
||||
(debug ((&rest [&or (&define name :unique "cl-flet@" form)
|
||||
(&define name :unique "cl-flet@"
|
||||
(debug ((&rest [&or (symbolp form)
|
||||
(&define [&name symbolp "@cl-flet@"]
|
||||
[&name [] gensym] ;Make it unique!
|
||||
cl-lambda-list
|
||||
cl-declarations-or-string
|
||||
[&optional ("interactive" interactive)]
|
||||
|
||||
@ -1748,16 +1748,12 @@ contains a circular object."
|
||||
(dolist (pair '((form . edebug-match-form)
|
||||
(sexp . edebug-match-sexp)
|
||||
(body . edebug-match-body)
|
||||
(name . edebug-match-name)
|
||||
(arg . edebug-match-arg)
|
||||
(def-body . edebug-match-def-body)
|
||||
(def-form . edebug-match-def-form)
|
||||
;; Less frequently used:
|
||||
;; (function . edebug-match-function)
|
||||
(lambda-expr . edebug-match-lambda-expr)
|
||||
(cl-generic-method-qualifier
|
||||
. edebug-match-cl-generic-method-qualifier)
|
||||
(cl-generic-method-args . edebug-match-cl-generic-method-args)
|
||||
(cl-macrolet-expr . edebug-match-cl-macrolet-expr)
|
||||
(cl-macrolet-name . edebug-match-cl-macrolet-name)
|
||||
(cl-macrolet-body . edebug-match-cl-macrolet-body)
|
||||
@ -2056,19 +2052,61 @@ and then matches the rest against the output of (FUN ARGS... HEAD)."
|
||||
)))
|
||||
|
||||
|
||||
(defun edebug-match-name (cursor)
|
||||
;; Set the edebug-def-name bound in edebug-defining-form.
|
||||
(let ((name (edebug-top-element-required cursor "Expected name")))
|
||||
;; Maybe strings and numbers could be used.
|
||||
(if (not (symbolp name))
|
||||
(edebug-no-match cursor "Symbol expected for name of definition"))
|
||||
(setq edebug-def-name
|
||||
(if edebug-def-name
|
||||
;; Construct a new name by appending to previous name.
|
||||
(intern (format "%s@%s" edebug-def-name name))
|
||||
name))
|
||||
(edebug-move-cursor cursor)
|
||||
(list name)))
|
||||
(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs)
|
||||
"Compute the name for `&name SPEC FUN` spec operator.
|
||||
|
||||
The full syntax of that operator is:
|
||||
&name [PRESTRING] SPEC [POSTSTRING] FUN ARGS...
|
||||
|
||||
Extracts the head of the data by matching it against SPEC,
|
||||
and then get the new name to use by calling
|
||||
(FUN ARGS... OLDNAME [PRESTRING] HEAD [POSTSTRING])
|
||||
FUN should return either a string or a symbol.
|
||||
FUN can be missing in which case it defaults to concatenating
|
||||
the new name to the end of the old with an \"@\" char between the two.
|
||||
PRESTRING and POSTSTRING are optional strings that get prepended
|
||||
or appended to the actual name."
|
||||
(pcase-let*
|
||||
((`(,spec ,fun . ,args) specs)
|
||||
(prestrings (when (stringp spec)
|
||||
(prog1 (list spec) (setq spec fun fun (pop args)))))
|
||||
(poststrings (when (stringp fun)
|
||||
(prog1 (list fun) (setq fun (pop args)))))
|
||||
(exps (edebug-cursor-expressions cursor))
|
||||
(instrumented (edebug-match-one-spec cursor spec))
|
||||
(consumed (- (length exps)
|
||||
(length (edebug-cursor-expressions cursor))))
|
||||
(newname (apply (or fun #'edebug--concat-name)
|
||||
`(,@args ,edebug-def-name
|
||||
,@prestrings
|
||||
,@(seq-subseq exps 0 consumed)
|
||||
,@poststrings))))
|
||||
(cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps)))
|
||||
(setq edebug-def-name (if (stringp newname) (intern newname) newname))
|
||||
instrumented))
|
||||
|
||||
(defun edebug--concat-name (oldname &rest newnames)
|
||||
(let ((newname (if (null (cdr newnames))
|
||||
(car newnames)
|
||||
;; Put spaces between each name, but not for the
|
||||
;; leading and trailing strings, if any.
|
||||
(let (beg mid end)
|
||||
(dolist (name newnames)
|
||||
(if (stringp name)
|
||||
(push name (if mid end beg))
|
||||
(when end (setq mid (nconc end mid) end nil))
|
||||
(push name mid)))
|
||||
(apply #'concat `(,@(nreverse beg)
|
||||
,(mapconcat (lambda (x) (format "%s" x))
|
||||
(nreverse mid) " ")
|
||||
,@(nreverse end)))))))
|
||||
(if (null oldname)
|
||||
(if (or (stringp newname) (symbolp newname))
|
||||
newname
|
||||
(format "%s" newname))
|
||||
(format "%s@%s" edebug-def-name newname))))
|
||||
|
||||
(def-edebug-elem-spec 'name '(&name symbolp))
|
||||
|
||||
(cl-defgeneric edebug--handle-:-spec-op (op cursor spec)
|
||||
"Handle :foo spec operators.
|
||||
@ -2094,26 +2132,6 @@ SPEC is the symbol name prefix for `gensym'."
|
||||
suffix)))
|
||||
nil)
|
||||
|
||||
(defun edebug-match-cl-generic-method-qualifier (cursor)
|
||||
"Match a QUALIFIER for `cl-defmethod' at CURSOR."
|
||||
(let ((args (edebug-top-element-required cursor "Expected qualifier")))
|
||||
;; Like in CLOS spec, we support any non-list values.
|
||||
(unless (atom args) (edebug-no-match cursor "Atom expected"))
|
||||
;; Append the arguments to `edebug-def-name' (Bug#42671).
|
||||
(setq edebug-def-name (intern (format "%s %s" edebug-def-name args)))
|
||||
(edebug-move-cursor cursor)
|
||||
(list args)))
|
||||
|
||||
(defun edebug-match-cl-generic-method-args (cursor)
|
||||
(let ((args (edebug-top-element-required cursor "Expected arguments")))
|
||||
(if (not (consp args))
|
||||
(edebug-no-match cursor "List expected"))
|
||||
;; Append the arguments to edebug-def-name.
|
||||
(setq edebug-def-name
|
||||
(intern (format "%s %s" edebug-def-name args)))
|
||||
(edebug-move-cursor cursor)
|
||||
(list args)))
|
||||
|
||||
(defvar edebug--cl-macrolet-defs nil
|
||||
"List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
|
||||
(defvar edebug--current-cl-macrolet-defs nil
|
||||
|
||||
@ -105,7 +105,7 @@ Summary:
|
||||
(declare (doc-string 3) (obsolete cl-defmethod "25.1")
|
||||
(debug
|
||||
(&define ; this means we are defining something
|
||||
[&or name ("setf" name :name setf)]
|
||||
[&name sexp] ;Allow (setf ...) additionally to symbols.
|
||||
;; ^^ This is the methods symbol
|
||||
[ &optional symbolp ] ; this is key :before etc
|
||||
cl-generic-method-args ; arguments
|
||||
|
||||
@ -196,8 +196,8 @@ it has to be wrapped in `(eval (quote ...))'.
|
||||
|
||||
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
|
||||
[:tags \\='(TAG...)] BODY...)"
|
||||
(declare (debug (&define :name test
|
||||
name sexp [&optional stringp]
|
||||
(declare (debug (&define [&name "test@" symbolp]
|
||||
sexp [&optional stringp]
|
||||
[&rest keywordp sexp] def-body))
|
||||
(doc-string 3)
|
||||
(indent 2))
|
||||
|
||||
@ -229,7 +229,8 @@ The first arg in ARGLIST (the one that receives VAL) receives an expression
|
||||
which can do arbitrary things, whereas the other arguments are all guaranteed
|
||||
to be pure and copyable. Example use:
|
||||
(gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
|
||||
(declare (indent 2) (debug (&define name :name gv-setter sexp def-body)))
|
||||
(declare (indent 2)
|
||||
(debug (&define [&name symbolp "@gv-setter"] sexp def-body)))
|
||||
`(gv-define-expander ,name
|
||||
(lambda (do &rest args)
|
||||
(declare-function
|
||||
|
||||
@ -1079,14 +1079,12 @@ Finds hooks by looking in the `erc-server-responses' hash table."
|
||||
(erc-display-message parsed 'notice proc line)))
|
||||
|
||||
|
||||
(put 'define-erc-response-handler 'edebug-form-spec
|
||||
'(&define :name erc-response-handler
|
||||
(name &rest name)
|
||||
&optional sexp sexp def-body))
|
||||
|
||||
(cl-defmacro define-erc-response-handler ((name &rest aliases)
|
||||
&optional extra-fn-doc extra-var-doc
|
||||
&rest fn-body)
|
||||
(declare (debug (&define [&name "erc-response-handler@"
|
||||
(symbolp &rest symbolp)]
|
||||
&optional sexp sexp def-body)))
|
||||
"Define an ERC handler hook/function pair.
|
||||
NAME is the response name as sent by the server (see the IRC RFC for
|
||||
meanings).
|
||||
|
||||
Loading…
Reference in New Issue
Block a user