(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`.
@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{&})
** 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.
**** '&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
\(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))
(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.
(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 ]
- ;; Multiple qualifiers are allowed.
- cl-generic-method-args ; arguments
+ [&name [sexp ;Allow (setf ...) additionally to symbols.
+ ;; Multiple qualifiers are allowed.
+ [&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))
\(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)]
\(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)]
\(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)]
(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)
)))
-(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.
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
(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
\(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))
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
(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)
+ &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).
projects / emacs.git / commitdiff